plots 0.1.1.0 → 0.1.1.1
raw patch · 22 files changed
+1270/−1418 lines, 22 filesdep +diagramsdep +geometrydep −diagrams-coredep −diagrams-libdep ~containers
Dependencies added: diagrams, geometry
Dependencies removed: diagrams-core, diagrams-lib
Dependency ranges changed: containers
Files
- plots.cabal +5/−5
- src/Diagrams/Coordinates/Polar.hs +2/−2
- src/Plots.hs +2/−2
- src/Plots/Axis.hs +121/−100
- src/Plots/Axis/ColourBar.hs +55/−58
- src/Plots/Axis/Grid.hs +42/−40
- src/Plots/Axis/Labels.hs +66/−46
- src/Plots/Axis/Line.hs +17/−13
- src/Plots/Axis/Render.hs +130/−71
- src/Plots/Axis/Scale.hs +39/−45
- src/Plots/Axis/Ticks.hs +47/−40
- src/Plots/Axis/Title.hs +32/−23
- src/Plots/Legend.hs +35/−33
- src/Plots/Name.hs +32/−32
- src/Plots/Style.hs +86/−63
- src/Plots/Types.hs +137/−137
- src/Plots/Types/Bar.hs +84/−102
- src/Plots/Types/HeatMap.hs +100/−71
- src/Plots/Types/Histogram.hs +53/−59
- src/Plots/Types/Line.hs +55/−54
- src/Plots/Types/Pie.hs +0/−308
- src/Plots/Types/Scatter.hs +130/−114
plots.cabal view
@@ -1,5 +1,5 @@ name: plots-version: 0.1.1.0+version: 0.1.1.1 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@@ -50,10 +50,10 @@ base >= 4.7 && < 5.0, adjunctions, colour,- containers >= 0.3 && < 0.6,+ containers >= 0.3 && < 0.7, data-default >= 0.5 && < 0.8,- diagrams-core >= 1.3 && < 1.5,- diagrams-lib >= 1.3 && < 1.5,+ diagrams >= 2.0 && < 2.1,+ geometry, directory, distributive, transformers,
src/Diagrams/Coordinates/Polar.hs view
@@ -48,8 +48,8 @@ import Data.Typeable import GHC.Generics (Generic1) -import Diagrams.Angle-import Diagrams.TwoD.Types+import Geometry.Angle+import Geometry.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,6 +30,7 @@ -- * Predefined axes , r2Axis+ , r3Axis , polarAxis -- ** Base space@@ -101,22 +102,21 @@ -- Single axis --------------------------------------------------------- -- | Render information for a single axis line.-data SingleAxis b v n = SingleAxis--- note the the v is only present for Style v n- { saLabel :: AxisLabel b v n- , saLine :: AxisLine v n- , saTickLabel :: TickLabels b v n- , saScaling :: AxisScaling n- , saGridLines :: GridLines v n- , saTicks :: Ticks v n+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 , saVisible :: Bool } -type instance V (SingleAxis b v n) = v-type instance N (SingleAxis b v n) = n+type instance V (SingleAxis v) = v+type instance N (SingleAxis v) = Double -instance (TypeableFloat n, Renderable (Text n) b)- => Default (SingleAxis b V2 n) where+instance Default (SingleAxis V2) where def = SingleAxis { saLabel = def , saLine = def@@ -127,43 +127,54 @@ , saVisible = True } -instance Functor f => HasTicks f (SingleAxis b v n) where+instance Default (SingleAxis V3) where+ def = SingleAxis+ { saLabel = def+ , saLine = def+ , saTickLabel = def+ , saGridLines = def+ , saTicks = def+ , saScaling = def+ , saVisible = True+ }++instance Functor f => HasTicks f (SingleAxis v) where bothTicks = lens saTicks (\sa ticks -> sa {saTicks = ticks}) -instance Functor f => HasMajorTicks f (SingleAxis b v n) where+instance Functor f => HasMajorTicks f (SingleAxis v) where majorTicks = bothTicks . majorTicks -instance Functor f => HasMinorTicks f (SingleAxis b v n) where+instance Functor f => HasMinorTicks f (SingleAxis v) where minorTicks = bothTicks . minorTicks -instance Functor f => HasAxisLabel f (SingleAxis b v n) b where+instance Functor f => HasAxisLabel f (SingleAxis v) where axisLabel = lens saLabel (\sa l -> sa {saLabel = l}) -instance Functor f => HasTickLabels f (SingleAxis b v n) b where+instance Functor f => HasTickLabels f (SingleAxis v) where tickLabel = lens saTickLabel (\sa tl -> sa {saTickLabel = tl}) -instance Functor f => HasAxisLine f (SingleAxis b v n) where+instance Functor f => HasAxisLine f (SingleAxis v) where axisLine = lens saLine (\sa l -> sa {saLine = l}) -instance Functor f => HasGridLines f (SingleAxis b v n) where+instance Functor f => HasGridLines f (SingleAxis v) where gridLines = lens saGridLines (\sa l -> sa {saGridLines = l}) -instance Functor f => HasMajorGridLines f (SingleAxis b v n) where+instance Functor f => HasMajorGridLines f (SingleAxis v) where majorGridLines = gridLines . majorGridLines -instance Functor f => HasMinorGridLines f (SingleAxis b v n) where+instance Functor f => HasMinorGridLines f (SingleAxis v) where minorGridLines = gridLines . minorGridLines -instance Functor f => HasAxisScaling f (SingleAxis b v n) where+instance Functor f => HasAxisScaling f (SingleAxis v) where axisScaling = lens saScaling (\sa s -> sa {saScaling = s}) -instance HasVisibility (SingleAxis b v n) where+instance HasVisibility (SingleAxis v) where visible = lens saVisible (\sa b -> sa {saVisible = b}) --- singleAxisScale :: Lens' (SingleAxis b v n) AxisScale+-- singleAxisScale :: Lens' (SingleAxis v) AxisScale -- singleAxisScale = lens saScale (\sa s -> sa {saScale = s}) --- singleAxisBound :: Lens' (SingleAxis b v n) (Bound n)+-- singleAxisBound :: Lens' (SingleAxis v) (Bound n) -- singleAxisBound = lens saBounds (\sa b -> sa {saBounds = b}) ------------------------------------------------------------------------@@ -213,36 +224,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 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+data Axis c = Axis+ { _axisStyle :: AxisStyle (BaseSpace c)+ , _colourBar :: ColourBar+ , _colourBarR :: (Double,Double)+ , _legend :: Legend+ , _axisTitle :: Title (BaseSpace c) -- , _axisTitle :: AxisTitle - , _axisPlots :: [DynamicPlot b (BaseSpace c) n]- , _plotModifier :: Endo (StyledPlot b (BaseSpace c) n)+ , _axisPlots :: [DynamicPlot (BaseSpace c)]+ , _plotModifier :: Endo (StyledPlot (BaseSpace c)) -- the v in each axis is only used for the style- , _axes :: c (SingleAxis b (BaseSpace c) n)+ , _axes :: c (SingleAxis (BaseSpace c)) } 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' b c n) (c ('SingleAxis' b v n))+-- 'axes' :: 'Lens'' ('Axis' c) (c ('SingleAxis' v)) -- @ axes :: (v ~ BaseSpace c, v ~ BaseSpace c')- => Lens (Axis b c n)- (Axis b c' n)- (c (SingleAxis b v n))- (c' (SingleAxis b v n))+ => Lens (Axis c)+ (Axis c')+ (c (SingleAxis v))+ (c' (SingleAxis v)) 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 b c n) [DynamicPlot b v n]+axisPlots :: BaseSpace c ~ v => Lens' (Axis c) [DynamicPlot v] axisPlots = lens _axisPlots (\a ps -> a {_axisPlots = ps}) -- | Traversal over the current plots in the axis.@@ -253,7 +264,7 @@ -- @ -- 'finalPlots' . 'connectingLine' .= 'True' -- @-currentPlots :: BaseSpace c ~ v => Traversal' (Axis b c n) (DynamicPlot b v n)+currentPlots :: BaseSpace c ~ v => Traversal' (Axis c) (DynamicPlot v) currentPlots = axisPlots . traversed -- | Setter over the final plot before the axis is rendered.@@ -266,71 +277,74 @@ -- 'finalPlots' . 'connectingLine' .= 'True' -- @ ---finalPlots :: BaseSpace c ~ v => Setter' (Axis b c n) (StyledPlot b v n)+finalPlots :: BaseSpace c ~ v => Setter' (Axis c) (StyledPlot v) 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 b c n) (Endo (StyledPlot b v n))+plotModifier :: BaseSpace c ~ v => Lens' (Axis c) (Endo (StyledPlot v)) plotModifier = lens _plotModifier (\a f -> a {_plotModifier = f}) -- Axis instances ------------------------------------------------------ -type instance V (Axis b v n) = BaseSpace v-type instance N (Axis b v n) = n+type instance V (Axis c) = BaseSpace c+type instance N (Axis c) = Double -instance (Applicative f, Traversable c) => HasTicks f (Axis b c n) where+instance (Applicative f, Traversable c) => HasTicks f (Axis c) where bothTicks = axes . traverse . bothTicks -instance (Applicative f, Traversable c) => HasMajorTicks f (Axis b c n) where+instance (Applicative f, Traversable c) => HasMajorTicks f (Axis c) where majorTicks = axes . traverse . majorTicks -instance (Applicative f, Traversable c) => HasMinorTicks f (Axis b c n) where+instance (Applicative f, Traversable c) => HasMinorTicks f (Axis c) where minorTicks = axes . traverse . minorTicks -instance (Applicative f, Traversable c) => HasGridLines f (Axis b c n) where+instance (Applicative f, Traversable c) => HasGridLines f (Axis c) where gridLines = axes . traverse . gridLines -instance (Applicative f, Traversable c) => HasMajorGridLines f (Axis b c n) where+instance (Applicative f, Traversable c) => HasMajorGridLines f (Axis c) where majorGridLines = axes . traverse . majorGridLines -instance (Applicative f, Traversable c) => HasMinorGridLines f (Axis b c n) where+instance (Applicative f, Traversable c) => HasMinorGridLines f (Axis c) where minorGridLines = axes . traverse . minorGridLines -instance (Applicative f, Traversable c) => HasAxisLabel f (Axis b c n) b where+instance (Applicative f, Traversable c) => HasAxisLine f (Axis c) where+ axisLine = axes . traverse . axisLine++instance (Applicative f, Traversable c) => HasAxisLabel f (Axis c) where axisLabel = axes . traverse . axisLabel -instance (Applicative f, Traversable c) => HasTickLabels f (Axis b c n) b where+instance (Applicative f, Traversable c) => HasTickLabels f (Axis c) where tickLabel = axes . traverse . tickLabel -instance (Applicative f, Traversable c) => HasAxisScaling f (Axis b c n) where+instance (Applicative f, Traversable c) => HasAxisScaling f (Axis c) where axisScaling = axes . traverse . axisScaling -instance Settable f => HasPlotOptions f (Axis b c n) b where+instance Settable f => HasPlotOptions f (Axis c) where plotOptions = finalPlots . plotOptions -instance Settable f => HasPlotStyle f (Axis b c n) b where+instance Settable f => HasPlotStyle f (Axis c) where plotStyle = finalPlots . plotStyle -instance HasLegend (Axis b c n) b where+instance HasLegend (Axis c) where legend = lens _legend (\a l -> a {_legend = l}) -instance HasTitle (Axis b c n) b where+instance HasTitle (Axis c) where title = lens _axisTitle (\a t -> a {_axisTitle = t}) -- | The size used for the rendered axis.-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+axisSize :: HasLinearMap c => Lens' (Axis c) (SizeSpec c Double)+axisSize = axes . column renderSize . iso mkSizeSpec getSpec -- | The range used for the colour bar limits. This is automatically set -- when using 'heatMap' or 'heatMap''-colourBarRange :: Lens' (Axis b v n) (n,n)+colourBarRange :: Lens' (Axis v) (Double,Double) colourBarRange = lens _colourBarR (\a r -> a {_colourBarR = r}) -instance HasAxisStyle (Axis b v n) b where+instance HasAxisStyle (Axis v) where axisStyle = lens _axisStyle (\a sty -> a {_axisStyle = sty}) -instance HasColourBar (Axis b v n) b where+instance HasColourBar (Axis v) where colourBar = lens _colourBar (\a cb -> a {_colourBar = cb}) -- Axis functions ------------------------------------------------------@@ -338,11 +352,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 n a, 'Plotable' a b)@:+-- with constraints @('InSpace' v a, 'Plotable' a b)@: -- -- @--- 'addPlotable' :: a -> 'PlotState' a b -> 'AxisState' b v n--- 'addPlotable'' :: a -> 'AxisState' b v n+-- 'addPlotable' :: a -> 'PlotState' a b -> 'AxisState' v+-- 'addPlotable'' :: a -> 'AxisState' v -- @ -- -- The last argument is a 'PlotState' so you can use @do@ notation to@@ -363,23 +377,23 @@ -- | Add a 'Plotable' 'Plot' to an 'Axis'. addPlot- :: (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'+ :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p)+ => Plot p -- ^ 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) n p, MonadState (Axis b c n) m, Plotable p b)+ :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p, HasLinearMap (BaseSpace c)) => p -- ^ the raw plot- -> State (Plot p b) () -- ^ changes to the plot+ -> State (Plot p) () -- ^ 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 v) n p, MonadState (Axis b v n) m, Plotable p b)+ :: (InSpace (BaseSpace c) Double p, MonadState (Axis c) m, Plotable p, HasLinearMap (BaseSpace c)) => p -- ^ the raw plot -> m () -- ^ add plot to the 'Axis' addPlotable' p = addPlotable p (return ())@@ -389,11 +403,7 @@ ------------------------------------------------------------------------ -- | The default axis for plots in the 'V2' coordinate system.-r2Axis- :: (TypeableFloat n,- Renderable (Text n) b,- Renderable (Path V2 n) b)- => Axis b V2 n+r2Axis :: Axis V2 r2Axis = Axis { _axisStyle = fadedColours , _colourBar = defColourBar@@ -407,95 +417,110 @@ , _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 b c n) (SingleAxis b (BaseSpace c) n)+xAxis :: R1 c => Lens' (Axis c) (SingleAxis (BaseSpace c)) xAxis = axes . _x -- | The label for the x-axis. Shorthand for @'xAxis' . 'axisLabelText'@.-xLabel :: R1 c => Lens' (Axis b c n) String+xLabel :: R1 c => Lens' (Axis c) 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 b c n) (Maybe n)+xMin :: R1 c => Lens' (Axis c) (Maybe Double) 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 b c n) (Maybe n)+xMax :: R1 c => Lens' (Axis c) (Maybe Double) xMax = xAxis . boundMax -- The y-axis ---------------------------------------------------------- -- | Lens onto the y-axis of an 'Axis'.-yAxis :: R2 c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n)+yAxis :: R2 c => Lens' (Axis c) (SingleAxis (BaseSpace c)) yAxis = axes . _y -- | The label for the y-axis. Shorthand for @'yAxis' . 'axisLabelText'@.-yLabel :: R2 c => Lens' (Axis b c n) String+yLabel :: R2 c => Lens' (Axis c) 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 b c n) (Maybe n)+yMin :: R2 c => Lens' (Axis c) (Maybe Double) 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 b c n) (Maybe n)+yMax :: R2 c => Lens' (Axis c) (Maybe Double) yMax = yAxis . boundMax -- The z-axis ---------------------------------------------------------- -- | Lens onto the z-axis of an 'Axis'.-zAxis :: R3 c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n)+zAxis :: R3 c => Lens' (Axis c) (SingleAxis (BaseSpace c)) zAxis = axes . _z -- | The label for the z-axis. Shorthand for @'zAxis' . 'axisLabelText'@.-zLabel :: R3 c => Lens' (Axis b c n) String+zLabel :: R3 c => Lens' (Axis c) 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 b c n) (Maybe n)+zMin :: R3 c => Lens' (Axis c) (Maybe Double) 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 b c n) (Maybe n)+zMax :: R3 c => Lens' (Axis c) (Maybe Double) zMax = zAxis . boundMax -- The r-axis ---------------------------------------------------------- -- | Lens onto the radial axis of an 'Axis'.-rAxis :: Radial c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n)+rAxis :: Radial c => Lens' (Axis c) (SingleAxis (BaseSpace c)) rAxis = axes . _radial -- | The label for the radial axis. Shorthand for @'rAxis' . 'axisLabelText'@.-rLabel :: Radial c => Lens' (Axis b c n) String+rLabel :: Radial c => Lens' (Axis c) 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 b c n) (Maybe n)+-- rMin :: R3 c => Lens' (Axis c) (Maybe Double) -- 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 b c n) (Maybe n)+rMax :: Radial c => Lens' (Axis c) (Maybe Double) rMax = rAxis . boundMax -- The theta-axis ------------------------------------------------------ -- | Lens onto the radial axis of an 'Axis'.-thetaAxis :: Circle c => Lens' (Axis b c n) (SingleAxis b (BaseSpace c) n)+thetaAxis :: Circle c => Lens' (Axis c) (SingleAxis (BaseSpace c)) thetaAxis = axes . el etheta -- | The label for the radial axis. Shorthand for @'rAxis' . 'axisLabelText'@.-thetaLabel :: Circle c => Lens' (Axis b c n) String+thetaLabel :: Circle c => Lens' (Axis c) String thetaLabel = thetaAxis . axisLabelText @@ -521,11 +546,7 @@ -- R3 Axis -polarAxis- :: (TypeableFloat n,- Renderable (Text n) b,- Renderable (Path V2 n) b)- => Axis b Polar n+polarAxis :: Axis Polar polarAxis = Axis { _axisStyle = fadedColours , _colourBar = defColourBar
src/Plots/Axis/ColourBar.hs view
@@ -39,9 +39,8 @@ import Data.Bool (bool) import qualified Data.Foldable as F-import Data.Typeable-import Diagrams.Core.Transform (fromSymmetric)-import Diagrams.Prelude hiding (gap)+-- import Diagrams.Core.Transform (fromSymmetric)+import Diagrams.Prelude hiding (orient) import Diagrams.TwoD.Text import Plots.Axis.Grid import Plots.Axis.Labels@@ -50,29 +49,30 @@ 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 b n = ColourBar+data ColourBar = ColourBar { cbPlacement :: Placement , cbVisible :: Bool- , cbTicks :: MajorTicks V2 n- , cbMinorTicks :: MinorTicks V2 n- , cbGridLines :: MajorGridLines V2 n- , cbTickLabels :: TickLabels b V2 n- , cbDraw :: ColourMap -> QDiagram b V2 n Any- , cbWidth :: n- , cbLengthFun :: n -> n- , cbGap :: n- , cbStyle :: Style V2 n+ , 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 } -type instance V (ColourBar b n) = V2-type instance N (ColourBar b n) = n+type instance V ColourBar = V2+type instance N ColourBar = Double -- | The default colour bar.-defColourBar :: (Renderable (Text n) b, Renderable (Path V2 n) b, TypeableFloat n)- => ColourBar b n+defColourBar :: ColourBar defColourBar = ColourBar { cbPlacement = rightMid , cbVisible = False@@ -87,9 +87,9 @@ , cbStyle = mempty } -class HasColourBar a b | a -> b where+class HasColourBar a where -- | Lens onto the 'ColourBar'.- colourBar :: Lens' a (ColourBar b (N a))+ colourBar :: Lens' a ColourBar -- | 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 -> QDiagram b V2 (N a) Any)+ colourBarDraw :: Lens' a (ColourMap -> Diagram V2) 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 (N a)+ colourBarWidth :: Lens' a Double 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 (N a -> N a)+ colourBarLengthFunction :: Lens' a (Double -> Double) 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 (N a)+ colourBarGap :: Lens' a Double colourBarGap = colourBar . lens cbGap (\c a -> c {cbGap = a}) -- | Style used for the outline of a colour bar.- colourBarStyle :: Lens' a (Style V2 (N a))+ colourBarStyle :: Lens' a (Style V2 Double) colourBarStyle = colourBar . lens cbStyle (\c a -> c {cbStyle = a}) -instance HasColourBar (ColourBar b n) b where+instance HasColourBar ColourBar where colourBar = id -instance HasGap (ColourBar b n) where+instance HasGap ColourBar where gap = colourBarGap -instance HasPlacement (ColourBar b n) where+instance HasPlacement ColourBar 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 b n) where+instance HasOrientation ColourBar where orientation = lens getter setter where getter p@@ -183,32 +183,32 @@ & placementAnchor %~ flipX_Y & gapDirection ._Dir %~ flipX_Y -instance Typeable n => HasStyle (ColourBar b n) where- applyStyle sty = colourBarStyle %~ applyStyle sty+instance ApplyStyle ColourBar+instance HasStyle ColourBar where+ style = colourBarStyle -instance Functor f => HasMajorTicks f (ColourBar b n) where+instance Functor f => HasMajorTicks f ColourBar where majorTicks = lens cbTicks (\c a -> c {cbTicks = a}) -instance Functor f => HasMinorTicks f (ColourBar b n) where+instance Functor f => HasMinorTicks f ColourBar where minorTicks = lens cbMinorTicks (\c a -> c {cbMinorTicks = a}) -instance Functor f => HasMajorGridLines f (ColourBar b n) where+instance Functor f => HasMajorGridLines f ColourBar where majorGridLines = lens cbGridLines (\c a -> c {cbGridLines = a}) -instance Functor f => HasTickLabels f (ColourBar b n) b where+instance Functor f => HasTickLabels f ColourBar where tickLabel = lens cbTickLabels (\c a -> c {cbTickLabels = a}) -instance HasVisibility (ColourBar b n) where+instance HasVisibility ColourBar where visible = lens cbVisible (\c a -> c {cbVisible = a}) -- | Add a colour bar to an object, using the bounding box for the object. addColourBar- :: (TypeableFloat n, Renderable (Path V2 n) b)- => BoundingBox V2 n -- ^ bounding box to place against- -> ColourBar b n --+ :: BoundingBox V2 Double -- ^ bounding box to place against+ -> ColourBar -> ColourMap- -> (n,n)- -> QDiagram b V2 n Any+ -> (Double,Double)+ -> Diagram V2 addColourBar bb cbo@ColourBar {..} cm bnds | cbVisible = placeAgainst bb cbPlacement cbGap cb | otherwise = mempty@@ -224,12 +224,11 @@ -- | Render a colour bar by it's self at a given width. Note this -- ignores 'colourBarGap' and 'colourBarLengthFunction'. renderColourBar- :: (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+ :: 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 renderColourBar cb@ColourBar {..} cm bnds@(lb,ub) l | cbVisible = bar # xy id reflectY # o id (reflectY . _reflectX_Y)@@ -258,7 +257,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@@ -269,7 +268,6 @@ 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@@ -282,17 +280,17 @@ someTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> mkP2 0 (-d*bb) ~~ mkP2 0 (d*aa)- AutoTick -> mkP2 0 (-d) ~~ mkP2 0 d+ -> fromVertices [mkP2 0 (-d*bb), mkP2 0 (d*aa)]+ AutoTick -> fromVertices [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- # strokePath+ # (stroke :: Path V2 Double -> Diagram V2) # applyStyle (cbGridLines ^. majorGridLinesStyle)- mkGridLine x = mkP2 (f x) (-w/2) ~~ mkP2 (f x) (w/2)+ mkGridLine x = fromVertices [mkP2 (f x) (-w/2), mkP2 (f x) (w/2)] -- tick labels tickLabelXs = view tickLabelFunction cbTickLabels tickXs' bnds@@ -321,22 +319,21 @@ -- This may not be supported by all backends. -- -- <<diagrams/src_Plots_Axis_ColourBar_gradientColourBarExample.svg#diagram=gradientColourBarExample&width=600>>-gradientColourBar :: (TypeableFloat n, Renderable (Path V2 n) b) => ColourMap -> QDiagram b V2 n Any+gradientColourBar :: ColourMap -> Diagram V2 gradientColourBar cm = rect 1 1 # fillTexture grad # lw none where- stops = map (\(x,c) -> GradientStop (SomeColor c) (fromRational x)) (colourList cm)- grad = defaultLG & _LG . lGradStops .~ stops+ stops = map (\(x,c) -> (c,fromRational x)) (colourList cm)+ grad = mkLinearGradient stops origin unitX -- 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 :: (TypeableFloat n, Renderable (Path V2 n) b)- => Int -> ColourMap -> QDiagram b V2 n Any+pathColourBar :: Int -> ColourMap -> Diagram V2 pathColourBar n cm = ifoldMap mkR xs where mkR i x = rect d' 1@@ -358,7 +355,7 @@ flipX_Y (V2 x y) = V2 (-y) (-x) _reflectionX_Y :: (Additive v, R2 v, Num n) => Transformation v n-_reflectionX_Y = fromSymmetric $ (_xy %~ flipX_Y) <-> (_xy %~ flipX_Y)+_reflectionX_Y = undefined -- 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 n = MajorGridLines- { magFun :: GridLineFunction n- , magStyle :: Style v n+data MajorGridLines v = MajorGridLines+ { magFun :: GridLineFunction Double+ , magStyle :: Style v Double , magVisible :: Bool } deriving Typeable -type instance V (MajorGridLines v n) = v-type instance N (MajorGridLines v n) = n+type instance V (MajorGridLines v) = v+type instance N (MajorGridLines v) = Double class HasMajorGridLines f a where -- | The options for how to draw the grid lines. This can be used on@@ -81,45 +81,46 @@ -- 'majorGridLines' :: 'Lens'' ('SingleAxis' b v n) ('GridLines' v n) -- 'majorGridLines' :: 'Lens'' ('GridLines' v n) ('GridLines' v n) -- @- majorGridLines :: LensLike' f a (MajorGridLines (V a) (N a))+ majorGridLines :: LensLike' f a (MajorGridLines (V 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 (N a))+ majorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction Double) 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) (N a))+ majorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) Double) majorGridLinesStyle = majorGridLines . lens magStyle (\gl sty -> gl {magStyle = sty}) -instance HasMajorGridLines f (MajorGridLines v n) where+instance HasMajorGridLines f (MajorGridLines v) where majorGridLines = id -instance (Typeable n, Floating n) => Default (MajorGridLines v n) where+instance Default (MajorGridLines v) where def = MajorGridLines { magFun = onTicksGridLineFunction , magStyle = mempty # lwO 0.8 , magVisible = True } -instance HasVisibility (MajorGridLines v n) where+instance HasVisibility (MajorGridLines v) where visible = lens magVisible (\gl b -> gl {magVisible = b}) -instance Typeable n => HasStyle (MajorGridLines v n) where- applyStyle s = majorGridLinesStyle %~ applyStyle s+instance ApplyStyle (MajorGridLines v)+instance HasStyle (MajorGridLines v) where+ style = majorGridLinesStyle ------------------------------------------------------------------------ -- Minor grid lines ------------------------------------------------------------------------ -data MinorGridLines v n = MinorGridLines- { migFun :: GridLineFunction n- , migStyle :: Style v n+data MinorGridLines v = MinorGridLines+ { migFun :: GridLineFunction Double+ , migStyle :: Style v Double , migVisible :: Bool } deriving Typeable -type instance V (MinorGridLines v n) = v-type instance N (MinorGridLines v n) = n+type instance V (MinorGridLines v) = v+type instance N (MinorGridLines v) = Double class HasMinorGridLines f a where -- | The options for how to draw the grid lines. This can be used on@@ -130,22 +131,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) (N a))+ minorGridLines :: LensLike' f a (MinorGridLines (V 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 (N a))+ minorGridLinesFunction :: Functor f => LensLike' f a (GridLineFunction Double) 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) (N a))+ minorGridLinesStyle :: Functor f => LensLike' f a (Style (V a) Double) minorGridLinesStyle = minorGridLines . lens migStyle (\gl sty -> gl {migStyle = sty}) -instance HasMinorGridLines f (MinorGridLines v n) where+instance HasMinorGridLines f (MinorGridLines v) where minorGridLines = id -instance (Typeable n, Floating n) => Default (MinorGridLines v n) where+instance Default (MinorGridLines v) where def = MinorGridLines { migFun = onTicksGridLineFunction , migStyle = mempty # lwO 0.5@@ -153,11 +154,12 @@ } -- | Hidden by default.-instance HasVisibility (MinorGridLines v n) where+instance HasVisibility (MinorGridLines v) where visible = lens migVisible (\gl b -> gl {migVisible = b}) -instance Typeable n => HasStyle (MinorGridLines v n) where- applyStyle s = minorGridLinesStyle %~ applyStyle s+instance ApplyStyle (MinorGridLines v)+instance HasStyle (MinorGridLines v) where+ style = minorGridLinesStyle ------------------------------------------------------------------------ -- Grid lines helpers@@ -184,7 +186,7 @@ -- @ gridLinesVisible :: (HasGridLines f a, Applicative f) => LensLike' f a Bool gridLinesVisible = gridLines . vis where- vis :: Traversal' (GridLines v n) Bool+ vis :: Traversal' (GridLines v) Bool vis f a = (\m mn -> a & majorGridLines . visible .~ m & minorGridLines . visible .~ mn) <$> f (a ^. majorGridLines . visible) <*> f (a ^. minorGridLines . visible)@@ -194,33 +196,33 @@ ------------------------------------------------------------------------ -- | Type holding information about both major and minor grid lines.-data GridLines v n = GridLines- { majGrid :: MajorGridLines v n- , minGrid :: MinorGridLines v n+data GridLines v = GridLines+ { majGrid :: MajorGridLines v+ , minGrid :: MinorGridLines v } deriving Typeable -type instance V (GridLines v n) = v-type instance N (GridLines v n) = n+type instance V (GridLines v) = v+type instance N (GridLines v) = Double class (HasMinorGridLines f a, HasMajorGridLines f a) => HasGridLines f a where- gridLines :: LensLike' f a (GridLines (V a) (N a))+ gridLines :: LensLike' f a (GridLines (V a)) -instance Functor f => HasGridLines f (GridLines v n) where+instance Functor f => HasGridLines f (GridLines v) where gridLines = id -instance (Typeable n, Floating n) => Default (GridLines v n) where+instance Default (GridLines v) where def = GridLines { majGrid = def , minGrid = def } -instance Functor f => HasMajorGridLines f (GridLines v n) where+instance Functor f => HasMajorGridLines f (GridLines v) where majorGridLines = lens majGrid (\g a -> g {majGrid = a}) -instance Functor f => HasMinorGridLines f (GridLines v n) where+instance Functor f => HasMinorGridLines f (GridLines v) where minorGridLines = lens minGrid (\g a -> g {minGrid = a}) -instance Typeable n => HasStyle (GridLines v n) where+instance ApplyStyle (GridLines v) where applyStyle s = (majorGridLines %~ applyStyle s) . (minorGridLines %~ applyStyle s) -- | Hide both major and minor grid lines.@@ -248,9 +250,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) (N a))+gridLinesStyle :: (HasGridLines f a, Applicative f) => LensLike' f a (Style (V a) Double) gridLinesStyle = gridLines . styles where- styles :: Traversal' (GridLines v n) (Style v n)+ styles :: Traversal' (GridLines v) (Style v Double) 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 b v n = TextAlignment n -> String -> QDiagram b v n Any+type TextFunction v = TextAlignment Double -> String -> Diagram v ------------------------------------------------------------------------ -- Axis labels@@ -74,45 +74,45 @@ -- @ -- -- See 'HasAxisLabel' for more advanced settings.-data AxisLabel b v n = AxisLabel- { alFun :: TextFunction b v n+data AxisLabel v = AxisLabel+ { alFun :: TextFunction v , alText :: String- , alStyle :: Style v n- , alGap :: n+ , alStyle :: Style v Double+ , alGap :: Double , alPos :: AxisLabelPosition , alPlacement :: AxisLabelPlacement , alVisible :: Bool } -type instance V (AxisLabel b v n) = v-type instance N (AxisLabel b v n) = n+type instance V (AxisLabel v) = v+type instance N (AxisLabel v) = Double -class HasAxisLabel f a b | a -> b where+class HasAxisLabel f a 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' b v n) ('AxisLabel' v n)+ -- 'axisLabel' :: 'Lens'' ('SingleAxis' v) ('AxisLabel' v n) -- 'axisLabel' :: 'Lens'' ('AxisLabel' v n) ('AxisLabel' v n) -- @- axisLabel :: LensLike' f a (AxisLabel b (V a) (N a))+ axisLabel :: LensLike' f a (AxisLabel (V 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 b (V a) (N a))+ axisLabelTextFunction :: Functor f => LensLike' f a (TextFunction (V 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 (N a)+ axisLabelGap :: Functor f => LensLike' f a Double 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) (N a))+ axisLabelStyle :: Functor f => LensLike' f a (Style (V a) Double) axisLabelStyle = axisLabel . lens alStyle (\al sty -> al {alStyle = sty}) -- | The position the label will be placed parallel to the axis.@@ -124,63 +124,75 @@ axisLabelPlacement :: Functor f => LensLike' f a AxisLabelPosition axisLabelPlacement = axisLabel . lens alPos (\al sty -> al {alPos = sty}) -instance HasAxisLabel f (AxisLabel b v n) b where+instance HasAxisLabel f (AxisLabel v) where axisLabel = id -instance Typeable n => HasStyle (AxisLabel b v n) where- applyStyle = over axisLabelStyle . applyStyle+instance ApplyStyle (AxisLabel v)+instance HasStyle (AxisLabel v) where+ style = axisLabelStyle -instance HasVisibility (AxisLabel b v n) where+instance HasVisibility (AxisLabel v) where visible = lens alVisible (\al b -> al {alVisible = b}) -instance HasGap (AxisLabel b v n) where+instance HasGap (AxisLabel v) where gap = axisLabelGap -instance (TypeableFloat n, Renderable (Text n) b)- => Default (AxisLabel b V2 n) where+instance Default (AxisLabel V2) where def = AxisLabel { alFun = mkText , alText = "" , alStyle = mempty & fontSize (output 11)- & recommendFillColor black+ & 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+ , alGap = 30+ , alPos = MiddleAxisLabel+ , alPlacement = OutsideAxisLabel+ , alVisible = True+ }+ ------------------------------------------------------------------------ -- Tick labels ------------------------------------------------------------------------ -- | 'TickLabels' describes how to draw the labels next to ticks. See -- 'HasTickLabels' for more options.-data TickLabels b v n = TickLabels- { tlFun :: [n] -> (n,n) -> [(n, String)]- , tlTextFun :: TextFunction b v n- , tlStyle :: Style v n- , tlGap :: n+data TickLabels v = TickLabels+ { tlFun :: [Double] -> (Double,Double) -> [(Double, String)]+ , tlTextFun :: TextFunction v+ , tlStyle :: Style v Double+ , tlGap :: Double , tlVisible :: Bool } deriving Typeable -type instance V (TickLabels b v n) = v-type instance N (TickLabels b v n) = n+type instance V (TickLabels v) = v+type instance N (TickLabels v) = Double -class HasTickLabels f a b | a -> b where+class HasTickLabels f a where -- | The options for the label of ticks. This can be used on various -- levels of the axis: -- -- @- -- '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' :: 'Traversal'' ('Tick' c) ('TickLabels' ('BaseSpace' c))+ -- 'tickLabel' :: 'Lens'' ('SingleAxis' v) ('TickLabels' v)+ -- 'tickLabel' :: 'Lens'' ('TickLabel' v) ('TickLabels' v) -- @- tickLabel :: LensLike' f a (TickLabels b (V a) (N a))+ tickLabel :: LensLike' f a (TickLabels (V a)) -- | The 'TextFunction' to render the text. -- -- 'Default' is 'mkText'.- tickLabelTextFunction :: Functor f => LensLike' f a (TextFunction b (V a) (N a))+ tickLabelTextFunction :: Functor f => LensLike' f a (TextFunction (V a)) tickLabelTextFunction = tickLabel . lens tlTextFun (\tl f -> tl {tlTextFun = f}) -- | Tick labels functions are used to draw the tick labels. They have@@ -188,39 +200,48 @@ -- position of the tick and label to use at that position. -- -- 'Default' is @'atMajorTicks' 'floatShow'@- tickLabelFunction :: Functor f => LensLike' f a ([N a] -> (N a, N a) -> [(N a, String)])+ tickLabelFunction :: Functor f => LensLike' f a ([Double] -> (Double, Double) -> [(Double, 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) (N a))+ tickLabelStyle :: Functor f => LensLike' f a (Style (V a) Double) 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 (N a)+ tickLabelGap :: Functor f => LensLike' f a Double tickLabelGap = tickLabel . lens tlGap (\tl n -> tl {tlGap = n}) -instance HasTickLabels f (TickLabels b v n) b where+instance HasTickLabels f (TickLabels v) where tickLabel = id -instance HasGap (TickLabels b v n) where+instance HasGap (TickLabels v) where gap = tickLabelGap -instance (TypeableFloat n, Renderable (Text n) b)- => Default (TickLabels b V2 n) where+instance Default (TickLabels V2) where def = TickLabels { tlFun = atMajorTicks floatShow , tlTextFun = mkText , tlStyle = mempty & fontSize (output 11)- & recommendFillColor black+ & backupFillColor black , tlGap = 12 , tlVisible = True } -instance HasVisibility (TickLabels b v n) where+instance Default (TickLabels V3) where+ def = TickLabels+ { tlFun = atMajorTicks floatShow+ , tlTextFun = mempty+ , tlStyle = mempty & fontSize (output 11)+ -- & sc black+ , tlGap = 12+ , tlVisible = True+ }++instance HasVisibility (TickLabels v) where visible = lens tlVisible (\tl b -> tl {tlVisible = b}) -- | Setter over the final positions the major ticks. This is not as@@ -237,8 +258,7 @@ -- If you want to change or add normal ticks see 'majorTicksFunction'. -- tickLabelPositions- :: (HasTickLabels f a b, Settable f)- => LensLike' f a [(N a, String)]+ :: (HasTickLabels f a, Settable f) => LensLike' f a [(Double, String)] tickLabelPositions = tickLabelFunction . mapped . mapped -- | Numbers are shown as 'Float's to reduce the chance of numbers like@@ -248,7 +268,7 @@ -- | Make a 'TickLabelFunction' by specifying how to draw a single label -- from a position on the axis.-atMajorTicks :: (n -> String) -> [n] -> (n,n) -> [(n, String)]+atMajorTicks :: (Double -> String) -> [Double] -> (Double,Double) -> [(Double, 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 n = AxisLine+data AxisLine v = AxisLine { alType :: AxisLineType- , alArrowOpts :: Maybe (ArrowOpts n)+ -- , alArrowOpts :: Maybe ArrowOpts , alVisible :: Bool- , alStyle :: Style v n+ , alStyle :: Style v Double } deriving Typeable -type instance V (AxisLine v n) = v-type instance N (AxisLine v n) = n+type instance V (AxisLine v) = v+type instance N (AxisLine v) = Double -- | Class of object that have an 'AxisLine'. class HasAxisLine f a where -- | Lens onto the 'AxisLine'.- axisLine :: LensLike' f a (AxisLine (V a) (N a))+ axisLine :: LensLike' f a (AxisLine (V a)) -- | The position of the axis line around the axis. --@@ -75,28 +75,32 @@ -- '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) (N a))+ axisLineStyle :: Functor f => LensLike' f a (Style (V a) Double) axisLineStyle = axisLine . lens alStyle (\al sty -> al {alStyle = sty}) -instance HasAxisLine f (AxisLine v n) where+instance HasAxisLine f (AxisLine v) 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 n) where+instance HasVisibility (AxisLine v) where visible = lens alVisible (\al b -> al {alVisible = b}) -instance Typeable n => Default (AxisLine v n) where+instance Default (AxisLine v) where def = AxisLine { alType = def- , alArrowOpts = def+ -- , alArrowOpts = def , alVisible = True , alStyle = mempty }
src/Plots/Axis/Render.hs view
@@ -39,8 +39,9 @@ import Data.List (sort) import Data.Typeable -import Diagrams.BoundingBox+import Geometry.BoundingBox import Diagrams.Prelude+import Geometry.Envelope import Diagrams.TwoD.Text import Linear hiding (rotate, translation) @@ -62,37 +63,65 @@ 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 (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)+instance WithOutcome (Axis Polar)+instance WithOutcome (Axis V2)+instance WithOutcome (Axis V3) - mainRender opts = mainRender opts . renderAxis+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 (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)+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) - mainRender opts = mainRender opts . renderAxis+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) -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+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)++-- 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)++-- 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++-- toResult d _ = d+ -- | 'mainWith' specialised to a 2D Axis. r2AxisMain- :: (Parseable (MainOpts (QDiagram b V2 Double Any)),- Mainable (Axis b V2 Double))- => Axis b V2 Double+ :: RenderOutcome t (Diagram V2)+ => t+ -> Axis V2 -> IO () r2AxisMain = mainWith @@ -108,7 +137,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 b c n -> [StyledPlot b v n]+buildPlots :: BaseSpace c ~ v => Axis c -> [StyledPlot v] buildPlots a = map (appEndo $ a ^. plotModifier) $ zipWith styleDynamic (a ^.. axisStyles) (a ^. axisPlots) -- TODO: correct order@@ -118,21 +147,21 @@ ------------------------------------------------------------------------ -- | Renderable axes.-class RenderAxis b v n where+class RenderAxis c where -- | Render an axis to a diagram. The size of the diagram is -- determined by the 'axisSize'.- renderAxis :: Axis b v n -> QDiagram b (BaseSpace v) n Any+ renderAxis :: Axis c -> Diagram (BaseSpace c) +-- R2 rendering --------------------------------------------------------+ -- | The 'RenderAxis' class provides a default way to render an axis for -- each space.-instance (TypeableFloat n, Renderable (Path V2 n) b)- => RenderAxis b V2 n where+instance RenderAxis V2 where -- | Render an axis and its plots, as well as the legend and colour -- bar. renderAxis = renderR2Axis -renderR2Axis :: (TypeableFloat n, Renderable (Path V2 n) b)- => Axis b V2 n -> QDiagram b V2 n Any+renderR2Axis :: Axis V2 -> Diagram V2 renderR2Axis a = frame 40 $ leg <> ttl@@ -159,6 +188,41 @@ -- 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@@ -169,23 +233,22 @@ deriving (Show, Eq, Typeable) axisOnBasis- :: 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+ :: forall v. (HasLinearMap v, Typeable v)+ => Point v Double -- start of axis+ -> v (Double, Double) -- calculated bounds+ -> SingleAxis v -- axis data -> v LogScale -- log scale- -> T2 n -- transformation to apply to positions of things+ -> Transformation v Double -- 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?- -> QDiagram b V2 n Any -- resulting axis+ -> Diagram v -- 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 = stroke . transform t+ tStroke = strokePathV . transform t -- axis labels (x,y etc.) axLabels@@ -263,13 +326,13 @@ maTicks | a ^. majorTicks . hidden = mempty | otherwise = foldMap (positionTick majorTick) majorTickXs'- # stroke+ # strokePathV # applyStyle (a ^. majorTicksStyle) -- miTicks | a ^. minorTicks . hidden = mempty | otherwise = foldMap (positionTick minorTick) minorTickXs'- # stroke+ # strokePathV # applyStyle (a ^. minorTicksStyle) -- minorTick = someTick (a ^. minorTicksAlignment) (a ^. minorTicksLength)@@ -300,16 +363,16 @@ | a ^. axisLine . hidden = mempty | otherwise = foldMap mkline (map snd ys) -- merge with ticks? # transform t- # stroke+ # strokePathV # 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 n+ $ map (\x -> over lensP ((el e .~ x) . (el eO .~ y)) p) [x0, x1] :: Path v Double -- measurements- b@(x0,x1) = bs ^. el e :: (n, n) -- bounds+ b@(x0,x1) = bs ^. el e :: (Double, Double) -- bounds coscale = ep e %~ coscaleNum coscaleNum = scaleNum (bs ^. el e) (ls ^. el e) yb@(y0,y1) = bs ^. el eO . if lp == UpperLabels@@ -364,8 +427,7 @@ -- Polar ------------------------------------------------------------------------ -instance (TypeableFloat n, Renderable (Path V2 n) b)- => RenderAxis b Polar n where+instance RenderAxis Polar where renderAxis = renderPolarAxis -- | An lower and upper bound for the bounding radius using @n@ envelope@@ -373,15 +435,15 @@ -- the bound. boundingRadiusR :: (InSpace V2 n a, Enveloped a) => Int -> a -> (n, n) boundingRadiusR (max 3 -> n) e =- case appEnvelope (getEnvelope e) of- Nothing -> (0,0)- Just f ->+ case getEnvelope e of+ EmptyEnvelope -> (0,0)+ Envelope f -> let thetas = map (@@rad) $ enumFromToN 0 tau n- vs = map angleV thetas+ vs = map angleDir 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 (f v) r) 0 vs+ lowerBound = F.foldr (\v r -> max (I.sup $ 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.@@ -394,9 +456,7 @@ in (lowerBound, upperBound) -renderPolarAxis- :: (TypeableFloat n, Renderable (Path V2 n) b)- => Axis b Polar n -> QDiagram b V2 n Any+renderPolarAxis :: Axis Polar -> Diagram V2 renderPolarAxis a = frame 15 $ leg -- <> colourBar@@ -420,9 +480,7 @@ styledPlots = map (appEndo $ a ^. plotModifier) $ zipWith styleDynamic (a ^.. axisStyles) (a ^. axisPlots) -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 :: AxisSpec V2 -> Polar (SingleAxis V2) -> Diagram V2 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)@@ -449,8 +507,9 @@ where -- XXX for now the radial axis is on the theta=0 line. Need some -- way to change this- line = (origin ~~ mkP2 r 0) # applyStyle (rA^.axisLineStyle)- # transform t+ line = fromVertices [origin, mkP2 r 0]+ # applyStyle (rA^.axisLineStyle)+ # transform t -- Radial axis label ------------------------------------------------- @@ -495,8 +554,8 @@ someTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> mkP2 0 (-d*bb) ~~ mkP2 0 (d*aa)- AutoTick -> mkP2 0 (-d) ~~ mkP2 0 d+ -> fromVertices [mkP2 0 (-d*bb), mkP2 0 (d*aa)]+ AutoTick -> fromVertices [mkP2 0 (-d) , mkP2 0 d ] -- Radial grid lines ------------------------------------------------- @@ -507,7 +566,7 @@ majorGridRs = view majorGridLinesFunction rA majorTickRs (0,r) majorGridRs' = map (*s) $ filter rInRange majorGridRs - rMajorGridLines :: QDiagram b V2 n Any+ rMajorGridLines :: Diagram V2 rMajorGridLines | rA ^. majorGridLines . hidden = mempty | otherwise = F.foldMap circle (filter (>0) majorGridRs')@@ -515,7 +574,7 @@ minorGridRs = view minorGridLinesFunction rA minorTickRs (0,r) minorGridRs' = map (*s) $ filter rInRange minorGridRs- rMinorGridLines :: QDiagram b V2 n Any+ rMinorGridLines :: Diagram V2 rMinorGridLines | rA ^. minorGridLines . hidden = mempty | otherwise = F.foldMap circle (filter (>0) minorGridRs')@@ -523,17 +582,17 @@ -- Radial tick labels ------------------------------------------------ - rAxTickLabels :: QDiagram b V2 n Any+ rAxTickLabels :: Diagram V2 rAxTickLabels | rA ^. tickLabel . hidden = mempty | otherwise = F.foldMap rDrawTickLabel tickLabelRs -- The positions of the tick labels.- tickLabelRs :: [(n, String)]+ tickLabelRs :: [(Double, String)] tickLabelRs = view tickLabelFunction rA (filter rInRange majorTickRs) (0,r) -- Draw a single tick label given the position and the string to use- rDrawTickLabel :: (n,String) -> QDiagram b V2 n Any+ rDrawTickLabel :: (Double,String) -> Diagram V2 rDrawTickLabel (x,label) = view tickLabelTextFunction rA (BoxAlignedText 0.5 1) label # translate (V2 (s*x) (- view axisLabelGap rA))@@ -607,8 +666,8 @@ someThetaTick tType d = case tType of TickSpec (fromRational -> aa) (fromRational -> bb)- -> mkP2 (-d*bb) 0 ~~ mkP2 (d*aa) 0- AutoTick -> mkP2 (-d) 0 ~~ mkP2 d 0+ -> fromVertices [mkP2 (-d*bb) 0, mkP2 (d*aa) 0]+ AutoTick -> fromVertices [mkP2 (-d) 0 , mkP2 d 0 ] -- Angular grid lines ------------------------------------------------ @@ -620,35 +679,35 @@ majorGridThetas = view majorGridLinesFunction thetaA majorTickThetas (0,theta) majorGridThetas' = filter thetaInRange majorGridThetas - thetaMajorGridLines :: QDiagram b V2 n Any+ thetaMajorGridLines :: Diagram V2 thetaMajorGridLines | thetaA ^. majorGridLines . hidden = mempty- | otherwise = F.foldMap (\phi -> origin ~~ mkP2 r 0 # rotate (phi@@rad)) majorGridThetas'+ | otherwise = F.foldMap (\phi -> fromVertices [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 :: QDiagram b V2 n Any+ thetaMinorGridLines :: Diagram V2 thetaMinorGridLines | thetaA ^. minorGridLines . hidden = mempty- | otherwise = F.foldMap (\phi -> origin ~~ mkP2 r 0 # rotate (phi@@rad)) minorGridThetas'+ | otherwise = F.foldMap (\phi -> fromVertices [origin, mkP2 r 0] # rotate (phi@@rad)) minorGridThetas' # transform t # applyStyle (thetaA ^. minorGridLinesStyle) -- Angular tick labels ----------------------------------------------- - thetaAxTickLabels :: QDiagram b V2 n Any+ thetaAxTickLabels :: Diagram V2 thetaAxTickLabels | thetaA ^. tickLabel . hidden = mempty | otherwise = F.foldMap thetaDrawTickLabel tickLabelThetas -- The positions of the tick labels.- tickLabelThetas :: [(n, String)]+ tickLabelThetas :: [(Double, String)] tickLabelThetas = view tickLabelFunction thetaA majorTickThetas' (0,theta) -- Draw a single tick label given the position and the string to use- thetaDrawTickLabel :: (n, String) -> QDiagram b V2 n Any+ thetaDrawTickLabel :: (Double, String) -> Diagram V2 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 n = Scaling- { asRatio :: Maybe n+data AxisScaling = Scaling+ { asRatio :: Maybe Double , asMode :: ScaleMode- , asEnlarge :: Extending n- , asBoundMin :: Maybe n- , asBoundMax :: Maybe n- , asSize :: Maybe n+ , asEnlarge :: Extending+ , asBoundMin :: Maybe Double+ , asBoundMax :: Maybe Double+ , asSize :: Maybe Double , asLogScale :: LogScale -- backup bound in case there's no inferred bounds to go by- , asBackupBoundMax :: n- , asBackupBoundMin :: n+ , asBackupBoundMax :: Double+ , asBackupBoundMin :: Double } -type instance N (AxisScaling n) = n+type instance N AxisScaling = Double -instance Fractional n => Default (AxisScaling n) where+instance Default AxisScaling where def = Scaling { asRatio = Nothing , asMode = AutoScale@@ -101,24 +101,24 @@ } -- | How much to extend the bounds beyond any inferred bounds.-data Extending n- = AbsoluteExtend n- | RelativeExtend n- deriving (Show, Ord, Eq, Functor)+data Extending+ = AbsoluteExtend !Double+ | RelativeExtend !Double+ deriving (Show, Ord, Eq) -- | Do not extend the axis beyond the inferred bounds.-noExtend :: Num n => Extending n+noExtend :: Extending 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 (N a))+ axisScaling :: LensLike' f a AxisScaling -- | 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 (N a))+ scaleAspectRatio :: Functor f => LensLike' f a (Maybe Double) 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 (N a))+ axisExtend :: Functor f => LensLike' f a Extending 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 (N a))+ boundMin :: Functor f => LensLike' f a (Maybe Double) boundMin = axisScaling . lens asBoundMin (\as b -> as {asBoundMin = b}) -- | The maximum bound the axis. There are helper functions for@@ -162,31 +162,30 @@ -- @ -- -- Default is 'Nothing'.- boundMax :: Functor f => LensLike' f a (Maybe (N a))+ boundMax :: Functor f => LensLike' f a (Maybe Double) 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 (N a))+ renderSize :: Functor f => LensLike' f a (Maybe Double) 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, Num n, Ord n) => Lens' (v (AxisScaling n)) (SizeSpec v n)+asSizeSpec :: HasLinearMap v => Lens' (v AxisScaling) (SizeSpec v Double) asSizeSpec = column renderSize . iso mkSizeSpec getSpec -instance HasAxisScaling f (AxisScaling n) where+instance HasAxisScaling f AxisScaling where axisScaling = id -- calculating bounds -------------------------------------------------- -- | Calculating the bounds for an axis. calculateBounds- :: 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+ :: 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 calculateBounds Scaling {..} mInferred = (l', u') where -- bounds are only enlarged when min/max bound wasn't set l' = l & whenever (isNothing asBoundMin) (subtract x)@@ -215,10 +214,10 @@ -- - scale to match desired 'scaleAspectRatio' -- - scale to match desired 'asSizeSpec' calculateScaling- :: (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)+ :: (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) calculateScaling aScaling bb = (bounds, aspectScaling, sizeScaling) where -- final bounds of the axis@@ -231,8 +230,8 @@ -- aScaling. Otherwise no ratios are set, ignore them and scale -- such that each axis is the same length | anyOf (folded . scaleAspectRatio) isJust aScaling- = vectorScaling $ view (scaleAspectRatio . non 1) <$> aScaling- | otherwise = inv $ vectorScaling v+ = scalingV $ view (scaleAspectRatio . non 1) <$> aScaling+ | otherwise = inv $ scalingV v -- scaling used so the axis fits in the size spec sizeScaling = requiredScaling szSpec v'@@ -242,11 +241,6 @@ 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@@ -283,9 +277,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,7 +52,6 @@ ) where import Control.Lens hiding (transform, ( # ))-import Data.Data import Data.Default import Data.Foldable as F import Data.Ord@@ -104,15 +103,15 @@ ------------------------------------------------------------------------ -- | The big ticks on the axis line.-data MajorTicks v n = MajorTicks- { matFunction :: (n,n) -> [n]+data MajorTicks v = MajorTicks+ { matFunction :: (Double,Double) -> [Double] , matAlign :: TicksAlignment- , matLength :: n- , matStyle :: Style v n+ , matLength :: Double+ , matStyle :: Style v Double , matVisible :: Bool } -instance TypeableFloat n => Default (MajorTicks v n) where+instance Default (MajorTicks v) where def = MajorTicks { matFunction = linearMajorTicks 5 , matAlign = autoTicks@@ -121,20 +120,20 @@ , matVisible = True } -type instance V (MajorTicks v n) = v-type instance N (MajorTicks v n) = n+type instance V (MajorTicks v) = v+type instance N (MajorTicks v) = Double -- | 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) (N a))+ majorTicks :: LensLike' f a (MajorTicks (V 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 ((N a, N a) -> [N a])+ majorTicksFunction :: Functor f => LensLike' f a ((Double, Double) -> [Double]) majorTicksFunction = majorTicks . lens matFunction (\mat a -> mat {matFunction = a}) -- | Alignment of the major ticks. Choose between 'autoTicks'@@ -145,38 +144,42 @@ -- | The total length the major ticks. -- -- Default is @7@.- majorTicksLength :: Functor f => LensLike' f a (N a)+ majorTicksLength :: Functor f => LensLike' f a Double 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) (N a))+ majorTicksStyle :: Functor f => LensLike' f a (Style (V a) Double) majorTicksStyle = majorTicks . lens matStyle (\mat sty -> mat {matStyle = sty}) -instance HasMajorTicks f (MajorTicks v n) where+instance HasMajorTicks f (MajorTicks v) where majorTicks = id -instance HasVisibility (MajorTicks v n) where+instance HasVisibility (MajorTicks v) 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 n = MinorTicks- { mitFunction :: [n] -> (n,n) -> [n]+data MinorTicks v = MinorTicks+ { mitFunction :: [Double] -> (Double,Double) -> [Double] , mitAlign :: TicksAlignment- , mitLength :: n- , mitStyle :: Style v n+ , mitLength :: Double+ , mitStyle :: Style v Double , mitVisible :: Bool } -type instance V (MinorTicks v n) = v-type instance N (MinorTicks v n) = n+type instance V (MinorTicks v) = v+type instance N (MinorTicks v) = Double -instance TypeableFloat n => Default (MinorTicks v n) where+instance Default (MinorTicks v) where def = MinorTicks { mitFunction = minorTicksHelper 4 , mitAlign = autoTicks@@ -188,13 +191,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) (N a))+ minorTicks :: LensLike' f a (MinorTicks (V 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 ([N a] -> (N a, N a) -> [N a])+ minorTicksFunction :: Functor f => LensLike' f a ([Double] -> (Double, Double) -> [Double]) minorTicksFunction = minorTicks . lens mitFunction (\mit a -> mit {mitFunction = a}) -- | Alignment of the minor ticks. Choose between 'autoTicks'@@ -205,52 +208,56 @@ -- | The total length the minor ticks. -- -- Default is @3@.- minorTicksLength :: Functor f => LensLike' f a (N a)+ minorTicksLength :: Functor f => LensLike' f a Double 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) (N a))+ minorTicksStyle :: Functor f => LensLike' f a (Style (V a) Double) minorTicksStyle = minorTicks . lens mitStyle (\mit sty -> mit {mitStyle = sty}) -instance HasMinorTicks f (MinorTicks v n) where+instance HasMinorTicks f (MinorTicks v) where minorTicks = id -instance HasVisibility (MinorTicks v n) where+instance HasVisibility (MinorTicks v) 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 n = Ticks (MajorTicks v n) (MinorTicks v n)+data Ticks v = Ticks (MajorTicks v) (MinorTicks v) -- 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 n) = v-type instance N (Ticks v n) = n+type instance V (Ticks v) = v+type instance N (Ticks v) = Double -- | 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) (N a))+ bothTicks :: LensLike' f a (Ticks (V a)) -instance Functor f => HasTicks f (Ticks v n) where+instance Functor f => HasTicks f (Ticks v) where bothTicks = id -instance Functor f => HasMajorTicks f (Ticks v n) where+instance Functor f => HasMajorTicks f (Ticks v) where majorTicks f (Ticks ma mi) = f ma <&> \ma' -> Ticks ma' mi -instance Functor f => HasMinorTicks f (Ticks v n) where+instance Functor f => HasMinorTicks f (Ticks v) where minorTicks f (Ticks ma mi) = f mi <&> \mi' -> Ticks ma mi' -instance TypeableFloat n => Default (Ticks v n) where+instance Default (Ticks v) where def = Ticks def def -instance Typeable n => HasStyle (Ticks v n) where- applyStyle s = over ticksStyle (applyStyle s)+instance ApplyStyle (Ticks v) where+ applyStyle = over ticksStyle . applyStyle -- | Traversal over both major and minor tick alignment. ticksAlign :: (HasTicks f a, Applicative f) => LensLike' f a TicksAlignment@@ -260,7 +267,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) (N a))+ticksStyle :: (HasTicks f a, Applicative f) => LensLike' f a (Style (V a) Double) ticksStyle = bothTicks . styles where styles f a = (\m mn -> a & majorTicksStyle .~ m & minorTicksStyle .~ mn)@@ -291,7 +298,7 @@ -- you want to add or modify existing tick positions. majorTickPositions :: (HasMajorTicks f a, Settable f)- => LensLike' f a [N a]+ => LensLike' f a [Double] majorTickPositions = majorTicksFunction . mapped -- | Setter over the final positions the major ticks. This is not as@@ -300,7 +307,7 @@ -- you want to add or modify existing tick positions. minorTickPositions :: (HasMinorTicks f a, Settable f)- => LensLike' f a [N a]+ => LensLike' f a [Double] minorTickPositions = minorTicksFunction . mapped . mapped ------------------------------------------------------------------------
src/Plots/Axis/Title.hs view
@@ -30,18 +30,17 @@ import Diagrams.TwoD.Text import Plots.Types -data Title b v n = Title+data Title v = Title { tVisible :: Bool , tTxt :: String- , tTxtFun :: TextAlignment n -> String -> QDiagram b v n Any- , tStyle :: Style v n+ , tTxtFun :: TextAlignment Double -> String -> Diagram v+ , tStyle :: Style v Double , tPlacement :: Placement- , tAlignment :: TextAlignment n- , tGap :: n+ , tAlignment :: TextAlignment Double+ , tGap :: Double } deriving Typeable -instance (Renderable (Text n) b, TypeableFloat n)- => Default (Title b V2 n) where+instance Default (Title V2) where def = Title { tVisible = True , tTxt = ""@@ -52,20 +51,31 @@ , tGap = 20 } -type instance V (Title b v n) = v-type instance N (Title b v n) = n+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+ } -instance HasVisibility (Title b v n) where+type instance V (Title v) = v+type instance N (Title v) = Double++instance HasVisibility (Title v) where visible = lens tVisible (\t b -> t {tVisible = b}) -instance HasGap (Title b v n) where+instance HasGap (Title v) where gap = lens tGap (\t g -> t {tGap = g}) -instance HasPlacement (Title b v n) where+instance HasPlacement (Title v) where placement = titlePlacement -class HasTitle a b | a -> b where- title :: Lens' a (Title b (V a) (N a))+class HasTitle a where+ title :: Lens' a (Title (V a)) -- | The text used for the title. If the string is empty, no title is -- drawn.@@ -77,7 +87,7 @@ -- | The style applied to the title. -- -- Default is 'mempty'.- titleStyle :: Lens' a (Style (V a) (N a))+ titleStyle :: Lens' a (Style (V a) Double) titleStyle = title . lens tStyle (\t s -> t {tStyle = s}) -- | The placement of the title against the axis.@@ -89,31 +99,30 @@ -- | The function used to draw the title text. -- -- Default is 'mkText'.- titleTextFunction :: Lens' a (TextAlignment (N a) -> String -> QDiagram b (V a) (N a) Any)+ titleTextFunction :: Lens' a (TextAlignment Double -> String -> Diagram (V a)) titleTextFunction = title . lens tTxtFun (\t s -> t {tTxtFun = s}) -- | The 'TextAlignment' used for the title text. This is given to the -- 'titleTextFunction'. -- -- Default is @'BoxAlignedText' 0.5 0@.- titleAlignment :: Lens' a (TextAlignment (N a))+ titleAlignment :: Lens' a (TextAlignment Double) titleAlignment = title . lens tAlignment (\t s -> t {tAlignment = s}) -- | The gap between the axis and the title. -- -- Default is 'mempty'.- titleGap :: Lens' a (N a)+ titleGap :: Lens' a Double titleGap = title . lens tGap (\t s -> t {tGap = s}) -instance HasTitle (Title b v n) b where+instance HasTitle (Title v) where title = id -- | Render the title and place it around the bounding box. drawTitle- :: TypeableFloat n- => BoundingBox V2 n- -> Title b V2 n- -> QDiagram b V2 n Any+ :: BoundingBox V2 Double+ -> Title V2+ -> Diagram V2 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 Diagrams.BoundingBox-import Diagrams.Prelude+import Geometry.BoundingBox+import Diagrams.Prelude hiding (orient) import Plots.Types -- | The data type to describe how to draw a legend. For legend entries -- see 'Plots.Types.LegendEntry'.-data Legend b n = Legend+data Legend = Legend { lPlacement :: Placement- , lGap :: n- , lStyle :: Style V2 n- , lSpacing :: n- , lTextWidth :: n- , lTextF :: String -> QDiagram b V2 n Any- , lTextStyle :: Style V2 n+ , lGap :: Double+ , lStyle :: Style V2 Double+ , lSpacing :: Double+ , lTextWidth :: Double+ , lTextF :: String -> Diagram V2+ , lTextStyle :: Style V2 Double , lOrientation :: Orientation , lVisible :: Bool } deriving Typeable -type instance V (Legend b n) = V2-type instance N (Legend b n) = n+type instance V Legend = V2+type instance N Legend = Double -class HasLegend a b | a -> b where+class HasLegend a where -- | Lens onto the 'Legend' of something.- legend :: Lens' a (Legend b (N a))+ legend :: Lens' a Legend -- | 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 (N a)+ legendGap :: Lens' a Double legendGap = legend . lens lGap (\l a -> l {lGap = a}) -- | The style applied to the surronding box of the legend.- legendStyle :: Lens' a (Style V2 (N a))+ legendStyle :: Lens' a (Style V2 Double) legendStyle = legend . lens lStyle (\l a -> l {lStyle = a}) -- | The spacing between entries in the legend.- legendSpacing :: Lens' a (N a)+ legendSpacing :: Lens' a Double legendSpacing = legend . lens lSpacing (\l a -> l {lSpacing = a}) -- | The space given for the text in the legend.- legendTextWidth :: Lens' a (N a)+ legendTextWidth :: Lens' a Double legendTextWidth = legend . lens lTextWidth (\l a -> l {lTextWidth = a}) -- | The function to generate the legend text.- legendTextFunction :: Lens' a (String -> QDiagram b V2 (N a) Any)+ legendTextFunction :: Lens' a (String -> Diagram V2) legendTextFunction = legend . lens lTextF (\l a -> l {lTextF = a}) -- | The style applied to the legend text.- legendTextStyle :: Lens' a (Style V2 (N a))+ legendTextStyle :: Lens' a (Style V2 Double) 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 b n) b where+instance HasLegend Legend where legend = id -instance HasGap (Legend b n) where+instance HasGap Legend where gap = legendGap -instance HasPlacement (Legend b n) where+instance HasPlacement Legend where placement = legendPlacement -instance (TypeableFloat n, Renderable (Text n) b) => Default (Legend b n) where+instance Default Legend where def = Legend { lPlacement = rightTop , lGap = 20@@ -104,24 +104,26 @@ , lVisible = True } -instance HasVisibility (Legend b n) where+instance HasVisibility Legend where visible = lens lVisible (\l a -> l {lVisible = a}) -instance TypeableFloat n => HasStyle (Legend b n) where- applyStyle sty = over legendStyle (applyStyle sty)+instance ApplyStyle Legend -instance HasOrientation (Legend b n) where+-- | The style for the bounding box of the legend.+instance HasStyle Legend where+ style = legendStyle+ {-# INLINE style #-}++instance HasOrientation Legend where orientation = legendOrientation -- | Draw a legend to the bounding box using the legend entries and -- legend options. drawLegend- :: (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+ :: 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 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.Core.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.Types.Names+-- import Diagrams.Prelude hiding (view) -data PlotName n = PlotName- { _plotName :: String- , _namedSize2D :: SizeSpec V2 n- , _namedT2 :: T2 n- } deriving Typeable+-- data PlotName = PlotName+-- { _plotName :: String+-- , _namedSize2D :: SizeSpec V2 Double+-- , _namedT2 :: T2 Double+-- } deriving Typeable -makeLenses ''PlotName+-- makeLenses ''PlotName -instance Show (PlotName n) where- show pn = "Plot: " ++ view plotName pn+-- instance Show PlotName 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 n) where- (==) = on (==) (view plotName)+-- instance Eq PlotName where+-- (==) = on (==) (view plotName) -instance Ord (PlotName n) where- compare = comparing (view plotName)+-- instance Ord PlotName where+-- compare = comparing (view plotName) -instance Typeable n => IsName (PlotName n)+-- instance IsName PlotName --- _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,6 +29,7 @@ -- ** Predefined styles , fadedColours+ , fadedColours3D , vividColours , blackAndWhite @@ -82,6 +83,10 @@ 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.@@ -121,23 +126,23 @@ -- 'histogramPlot') -- * 'markerStyle' - style used for markers in 'scatterPlot' -- * 'plotMarker' - marker used in 'scatterPlot'-data PlotStyle b v n = PlotStyle+data PlotStyle v = PlotStyle { _plotColour :: Colour Double- , _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+ , _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 } deriving Typeable -- XXX link to examples in haddock? -type instance V (PlotStyle b v n) = v-type instance N (PlotStyle b v n) = n+type instance V (PlotStyle v) = v+type instance N (PlotStyle v) = Double -- | Class for objects that contain a 'PlotStyle'.-class HasPlotStyle f a b | a -> b where+class HasPlotStyle f a where -- | Lens onto the 'PlotStyle'.- plotStyle :: LensLike' f a (PlotStyle b (V a) (N a))+ plotStyle :: LensLike' f a (PlotStyle (V a)) -- | The 'plotColour' is the overall colour of the plot. This is passed -- to the other styles ('lineStyle', 'markerStyle' etc.) to give an@@ -152,61 +157,60 @@ -- | 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) (N a))+ lineStyle :: Settable f => LensLike' f a (Style (V a) Double) 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) (N a))+ lineStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double) 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) (N a))+ markerStyle :: Settable f => LensLike' f a (Style (V a) Double) 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) (N a))+ markerStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double) 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) (N a))+ areaStyle :: Settable f => LensLike' f a (Style (V a) Double) 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) (N a))+ areaStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double) 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) (N a))+ textStyle :: Settable f => LensLike' f a (Style (V a) Double) 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) (N a))+ textStyleFunction :: Functor f => LensLike' f a (Colour Double -> Style (V a) Double) 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 (QDiagram b (V a) (N a) Any)+ plotMarker :: Functor f => LensLike' f a (Diagram (V a)) 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) (N a))+ plotStyles :: Settable f => LensLike' f a (Style (V a) Double) plotStyles = plotStyleFunctions . mapped -- | A version of 'plotStyles' with access to the 'plotColour'.- plotStyleFunctions :: Applicative f => LensLike' f a (Colour Double -> Style (V a) (N a))+ plotStyleFunctions :: Applicative f => LensLike' f a (Colour Double -> Style (V a) Double) plotStyleFunctions = plotStyle . t where t f PlotStyle {..} = PlotStyle@@ -217,7 +221,7 @@ <*> f _textStyle <*> pure _plotMarker -instance HasPlotStyle f (PlotStyle b v n) b where+instance HasPlotStyle f (PlotStyle v) where plotStyle = id -- Applying styles -----------------------------------------------------@@ -225,48 +229,48 @@ -- | Apply the 'lineStyle' from a 'PlotStyle'. -- -- @--- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle b v n -> t -> t+-- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t -- @ applyLineStyle- :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)- => a -> t -> t+ :: (InSpace v Double t, ApplyStyle t)+ => PlotStyle v -> 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 b v n -> t -> t+-- applyMarkerStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t -- @ applyMarkerStyle- :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)- => a -> t -> t+ :: (InSpace v Double t, ApplyStyle t)+ => PlotStyle v -> 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 b v n -> t -> t+-- applyLineStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t -- @ applyAreaStyle- :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)- => a -> t -> t+ :: (InSpace v Double t, ApplyStyle t)+ => PlotStyle v -> 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 b v n -> t -> t+-- applyTextStyle :: (InSpace v n t, HasStyle t) => PlotStyle v -> t -> t -- @ applyTextStyle- :: (SameSpace a t, HasPlotStyle (Const (PlotStyle b (V a) (N a))) a b, HasStyle t)- => a -> t -> t+ :: (InSpace v Double t, ApplyStyle t)+ => PlotStyle v -> t -> t applyTextStyle (view plotStyle -> sty) = applyStyle $ (sty ^. textStyleFunction) (sty ^. plotColour) -instance (Metric v, Traversable v, OrderedField n) => Transformable (PlotStyle b v n) where+instance (Metric v, Traversable v) => Transformable (PlotStyle v) where transform t = (plotMarker %~ transform t) . (plotStyles %~ transform t) ------------------------------------------------------------------------@@ -275,15 +279,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 b v n = AxisStyle ColourMap [PlotStyle b v n]+data AxisStyle v = AxisStyle ColourMap [PlotStyle v] -type instance V (AxisStyle b v n) = v-type instance N (AxisStyle b v n) = n+type instance V (AxisStyle v) = v+type instance N (AxisStyle v) = Double -- | Class of things that have an 'AxisStyle'.-class HasAxisStyle a b | a -> b where+class HasAxisStyle a where -- | Lens onto the 'AxisStyle'.- axisStyle :: Lens' a (AxisStyle b (V a) (N a))+ axisStyle :: Lens' a (AxisStyle (V a)) -- | The 'ColourMap' is used to draw the 'Plots.Axis.ColourBar' and -- render plots like 'Plots.HeatMap'.@@ -293,14 +297,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 b (V a) (N a))+ axisStyles :: IndexedTraversal' Int a (PlotStyle (V a)) axisStyles = axisStyle . stys . traversed where stys f (AxisStyle c ss) = f ss <&> \ss' -> AxisStyle c ss' -instance HasAxisStyle (AxisStyle b v n) b where+instance HasAxisStyle (AxisStyle v) where axisStyle = id -instance Applicative f => HasPlotStyle f (AxisStyle b v n) b where+instance Applicative f => HasPlotStyle f (AxisStyle v) where plotStyle = axisStyles ------------------------------------------------------------------------@@ -327,7 +331,7 @@ -- | Theme using 'funColours' with faded fills and thick lines. -- -- <<diagrams/src_Plots_Style_fadedColourPic.svg#diagram=fadedColourPic&width=600>>-fadedColours :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n+fadedColours :: AxisStyle V2 fadedColours = AxisStyle viridis $ zipWith mkStyle (cycle colours1) (cycle $ map stroke filledMarkers) where@@ -336,10 +340,20 @@ 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 :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n+vividColours :: AxisStyle V2 vividColours = AxisStyle viridis $ zipWith mkStyle (cycle colours2) (cycle $ map (scale 1.2 . stroke) filledMarkers) where@@ -351,7 +365,7 @@ -- | Theme without any colours, useful for black and white documents. -- -- <<diagrams/src_Plots_Style_blackAndWhitePic.svg#diagram=blackAndWhitePic&width=600>>-blackAndWhite :: (TypeableFloat n, Renderable (Path V2 n) b) => AxisStyle b V2 n+blackAndWhite :: AxisStyle V2 blackAndWhite = AxisStyle greys $ zipWith3 mkStyle (cycle colours) (cycle lineStyles) (cycle $ map stroke filledMarkers) where@@ -397,9 +411,18 @@ -- | 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 . pathFromTrail) $ cycle- [ circle 0.5+filledMarkers = scale 11 . map (centerXY . toPath) $ cycle+ [ circle 0.5 :: RealFloat n => Trail V2 n , square 1 , triangle 1 , diamond (1 / sqrt 2)@@ -431,27 +454,27 @@ asterisk n x = mconcat . take n . iterate (rotateBy (1/fromIntegral n))- $ (0 ^& 0) ~~ (0 ^& x)+ $ fromVertices [origin, mkP2 0 x] -- | A rotated 'square'.-diamond :: (InSpace V2 n t, TrailLike t) => n -> t-diamond = trailLike . rotateBy (1/8) . square+diamond :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t+diamond = fromLocTrail . rotateBy (1/8) . square -- | A rotated 'plus'.-crossShape :: (InSpace V2 n t, TrailLike t) => n -> t-crossShape = trailLike . rotateBy (1/8) . plus+crossShape :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t+crossShape = fromLocTrail . rotateBy (1/8) . plus -- | Filled in @+@ symbol.-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+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) $ square (x/3) -- | A filled in five sided start of size x.-star' :: (InSpace V2 n t, TrailLike t) => n -> t-star' x = trailLike . (`at` mkP2 (-x/6) (x/6))- . wrapTrail . glueLine . mconcat . take 5+star' :: (InSpace V2 n t, FromTrail t, OrderedField n) => n -> t+star' x = fromLocLoop . (`at` mkP2 (-x/6) (x/6))+ . glueLine . mconcat . take 5 . iterate (rotateBy (-1/5)) $ spoke where spoke = fromOffsets . map r2 $ [(x/6,x/2), (x/6,-x/2)]@@ -588,8 +611,8 @@ (b,_) = M.findMax cm normalise x = (x - a) / (b - a) -toStops :: Fractional n => ColourMap -> [GradientStop n]-toStops = map (\(x,c) -> GradientStop (SomeColor c) (fromRational x))+toStops :: ColourMap -> [GradientStop]+toStops = map (\(x,c) -> GradientStop (opaque 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' b v n@]+-- [@'PlotOptions' v@] -- Generic options all plots have. ----- [@'PlotMods' b v n@]+-- [@'PlotMods' v@] -- Includes 'PlotOptions' along with modifications to the 'PlotStyle'. ----- [@'Plot' p b@]+-- [@'Plot' p@] -- A 'rawPlot' @p@ grouped with a 'PlotMods'. ----- [@'DynamicPlot' b v n@]+-- [@'DynamicPlot' v@] -- A wrapped up 'Plot' so it can be stored in an 'Axis'. ----- [@'StyledPlot' b v n@]+-- [@'StyledPlot' v@] -- A 'DynamicPlot' with a concrete 'PlotStyle', ready to be rendered. -- -- As well as other things like the 'Plotable' class, 'LegendEntries',@@ -131,12 +131,18 @@ import Data.Ord (comparing) import Data.Orphans () import Data.Typeable-import Diagrams.Prelude as D+import Diagrams.Prelude as D hiding (orient) 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@@ -172,16 +178,16 @@ class HasGap a where -- | The value of the gap when rendering.- gap :: Lens' a (N a)+ gap :: Lens' a Double -- | 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 Rational+ , pGapDir :: Direction V2 Double }- deriving (Show, Read, Eq, Ord)+ deriving (Show, Eq) -- 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.@@ -204,7 +210,7 @@ placementAnchor = placement . lens pAnchor (\p a -> p {pAnchor = a}) -- | The direction to extend the 'gap' when positioning.- gapDirection :: Lens' a (Direction V2 Rational)+ gapDirection :: Lens' a (Direction V2 Double) gapDirection = placement . lens pGapDir (\p a -> p {pGapDir = a}) instance HasPlacement Placement where@@ -217,11 +223,11 @@ pInside v = Placement { pAt = v , pAnchor = v- , pGapDir = dirBetween' (P v) origin+ , pGapDir = dirBetween' (P $ fromRational <$> v) origin } -- | @dirBetween p q@ returns the directions from @p@ to @q@-dirBetween' :: (Additive v, Num n) => Point v n -> Point v n -> Direction v n+dirBetween' :: (Metric v, Floating n) => Point v n -> Point v n -> Direction v n dirBetween' p q = direction $ q .-. p @@ -260,12 +266,11 @@ -- | 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,- HasOrigin b, Alignable b)+ :: (InSpace V2 n a, SameSpace a b, Enveloped a, Enveloped b, HasOrigin b) => a -> Placement -> n -> b -> b placeAgainst a (Placement (V2 px py) (V2 ax ay) d) n b = b # anchor- # moveTo (pos .+^ n *^ fromDirection (fmap fromRational d))+ # moveTo (pos .+^ n *^ fromDirection (realToFrac <$> d)) where pos = mkP2 (lerp' px xu xl) (lerp' py yu yl) anchor = alignBy unitX (fromRational ax) . alignBy unitY (fromRational ay)@@ -280,26 +285,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 b v n+data LegendPic v = DefaultLegendPic- | CustomLegendPic (PlotStyle b v n -> QDiagram b v n Any)+ | CustomLegendPic (PlotStyle v -> Diagram v) -instance Default (LegendPic b v n) where+instance Default (LegendPic v) where def = DefaultLegendPic -- | Data type for holding a legend entry.-data LegendEntry b v n = LegendEntry- { lPic :: LegendPic b v n+data LegendEntry v = LegendEntry+ { lPic :: LegendPic v , lText :: String- , lPrecedence :: n+ , lPrecedence :: Double } deriving Typeable -- | The picture used in the legend entry.-legendPicture :: Lens' (LegendEntry b v n) (LegendPic b v n)+legendPicture :: Lens' (LegendEntry v) (LegendPic v) legendPicture = lens lPic (\l pic -> l {lPic = pic}) -- | The text used in the legend entry.-legendText :: Lens' (LegendEntry b v n) String+legendText :: Lens' (LegendEntry v) String legendText = lens lText (\l txt -> l {lText = txt}) -- | The order in which the legend entries are rendered. If precedences@@ -307,15 +312,15 @@ -- axis. -- -- Default is @0@.-legendPrecedence :: Lens' (LegendEntry b v n) n+legendPrecedence :: Lens' (LegendEntry v) Double legendPrecedence = lens lPrecedence (\l n -> l {lPrecedence = n}) -type instance V (LegendEntry b v n) = v-type instance N (LegendEntry b v n) = n+type instance V (LegendEntry v) = v+type instance N (LegendEntry v) = Double -- | Make a legend entry with a default 'legendPicture' and -- 'legendPrecedence' 0 using the string as the 'legendText'.-mkLegendEntry :: Num n => String -> LegendEntry b v n+mkLegendEntry :: String -> LegendEntry v mkLegendEntry x = LegendEntry DefaultLegendPic x 0 ------------------------------------------------------------------------@@ -325,24 +330,24 @@ -- Generic Plot info -- | Data type for holding information all plots must contain.-data PlotOptions b v n = PlotOptions+data PlotOptions v = PlotOptions { poName :: Name , poClipPlot :: Bool- , poLegend :: [LegendEntry b v n]+ , poLegend :: [LegendEntry v] , poVisible :: Bool- , poTransform :: Transformation v n+ , poTransform :: Transformation v Double -- , poPostPlotBoundingBox :: BoundingBox v n -> BoundingBox v n- -- , poPlotPostProduction :: QDiagram b v n Any -> QDiagram b v n Any+ -- , poPlotPostProduction :: QDiagram v Any -> QDiagram v Any } deriving Typeable -type instance V (PlotOptions b v n) = v-type instance N (PlotOptions b v n) = n+type instance V (PlotOptions v) = v+type instance N (PlotOptions v) = Double -- | Class of things that have 'PlotOptions'.-class HasPlotOptions f a b | a -> b where+class HasPlotOptions f a where {-# MINIMAL plotOptions #-} -- | Lens onto the 'PlotOptions'.- plotOptions :: LensLike' f a (PlotOptions b (V a) (N a))+ plotOptions :: LensLike' f a (PlotOptions (V a)) -- | The 'Name' applied to the plot. This gives a way to reference a -- specific plot in a rendered axis.@@ -362,7 +367,7 @@ -- | The legend entries to be used for the current plot. -- -- 'Default' is 'mempty'.- legendEntries :: Functor f => LensLike' f a [LegendEntry b (V a) (N a)]+ legendEntries :: Functor f => LensLike' f a [LegendEntry (V a)] legendEntries = plotOptions . lens poLegend (\g a -> g {poLegend = a}) {-# INLINE legendEntries #-} @@ -370,7 +375,7 @@ -- coordinates. -- -- 'Default' is 'mempty'.- plotTransform :: Functor f => LensLike' f a (Transformation (V a) (N a))+ plotTransform :: Functor f => LensLike' f a (Transformation (V a) Double) plotTransform = plotOptions . lens poTransform (\g a -> g {poTransform = a}) {-# INLINE plotTransform #-} @@ -382,7 +387,7 @@ plotVisible = plotOptions . lens poVisible (\po b -> po {poVisible = b}) {-# INLINE plotVisible #-} -instance (Additive v, Num n) => Default (PlotOptions b v n) where+instance (HasBasis v, Foldable v) => Default (PlotOptions v) where def = PlotOptions { poName = mempty , poClipPlot = True@@ -393,25 +398,25 @@ -- , poPlotPostProduction = id } -instance HasPlotOptions f (PlotOptions b v n) b where+instance HasPlotOptions f (PlotOptions v) where plotOptions = id {-# INLINE plotOptions #-} -instance (HasLinearMap v, Num n) => Transformable (PlotOptions b v n) where+instance HasLinearMap v => Transformable (PlotOptions v) where transform = over plotTransform . transform --- instance HasBounds (PlotOptions b v n) v where+-- instance HasBounds (PlotOptions v) v where -- bounds = plotBounds -- | Move origin by applying to @plotTransform@.-instance (Additive v, Num n) => HasOrigin (PlotOptions b v n) where+instance Additive v => HasOrigin (PlotOptions v) where moveOriginTo = over plotTransform . moveOriginTo -instance Qualifiable (PlotOptions b v n) where+instance Qualifiable (PlotOptions v) where n .>> p = over plotName (n .>>) p -- XXX template haskell getting in the way--- instance HasVisibility (PlotOptions b v n) where+-- instance HasVisibility (PlotOptions v) where -- visible = plotVisible -- | Add a 'LegendEntry' to something with 'PlotOptions' using the@@ -419,27 +424,27 @@ -- some typical examples: -- -- @--- 'key' :: 'String' -> 'State' ('Plot' ('ScatterPlot' v n) b) ()--- 'key' :: 'String' -> 'State' ('DynamicPlot' b v n) ()--- 'key' :: 'String' -> 'State' ('PlotMods' b v n) ()+-- 'key' :: 'String' -> 'State' ('Plot' ('ScatterPlot' v)) ()+-- 'key' :: 'String' -> 'State' ('DynamicPlot' v) ()+-- 'key' :: 'String' -> 'State' ('PlotMods' v) () -- @ -- -- If you only care about the name of the legend, use 'key'.-key :: (HasPlotOptions Identity a b, MonadState a m, Num (N a)) => String -> m ()+key :: (HasPlotOptions Identity a, MonadState a m) => String -> m () key = addLegendEntry . mkLegendEntry -- | Add a 'LegendEntry' to something with 'PlotOptions'. Here are some -- typical examples: -- -- @--- 'addLegendEntry' :: 'LegendEntry' b v n -> 'State' ('Plot' ('ScatterPlot' v n) b) ()--- 'addLegendEntry' :: 'LegendEntry' b v n -> 'State' ('DynamicPlot' b v n) ()+-- 'addLegendEntry' :: 'LegendEntry' v -> 'State' ('Plot' ('ScatterPlot' v)) ()+-- 'addLegendEntry' :: 'LegendEntry' v -> 'State' ('DynamicPlot' v) () -- @ -- -- If you only care about the name of the legend, use 'key'. addLegendEntry- :: (HasPlotOptions Identity a b, MonadState a m)- => LegendEntry b (V a) (N a)+ :: (HasPlotOptions Identity a, MonadState a m)+ => LegendEntry (V a) -> m () addLegendEntry l = legendEntries <>= [l] @@ -451,17 +456,17 @@ ------------------------------------------------------------------------ -- | Information from the 'Plots.Axis.Axis' necessary to render a 'Plotable'.-data AxisSpec v n = AxisSpec- { _specBounds :: v (n, n)- , _specTrans :: Transformation v n+data AxisSpec v = AxisSpec+ { _specBounds :: v (Double, Double)+ , _specTrans :: Transformation v Double , _specScale :: v LogScale , _specColourMap :: ColourMap } makeLenses ''AxisSpec -type instance V (AxisSpec v n) = v-type instance N (AxisSpec v n) = n+type instance V (AxisSpec v) = v+type instance N (AxisSpec v) = Double -- | Scale a number by log10-ing it and linearly scaling it so it's -- within the same range.@@ -472,7 +477,9 @@ where d = b - a -- | Apply log scaling and the transform to a point.-specPoint :: (Applicative v, Additive v, Floating n) => AxisSpec v n -> Point v n -> Point v n+specPoint+ :: (Applicative v, Additive v, Foldable v)+ => AxisSpec v -> Point v Double -> Point v Double specPoint (AxisSpec bs tr ss _) p = papply tr $ over _Point (scaleNum <$> bs <*> ss <*>) p @@ -481,36 +488,38 @@ ------------------------------------------------------------------------ -- | Class defining how plots should be rendered.-class (Typeable p, Enveloped p) => Plotable p b where+class (Typeable p, Enveloped p, N p ~ Double) => Plotable p where -- | Render a plot according to the 'AxisSpec', using the 'PlotStyle'. renderPlotable- :: InSpace v n p- => AxisSpec v n- -> PlotStyle b v n+ :: InSpace v Double p+ => AxisSpec v+ -> PlotStyle v -> p- -> QDiagram b v n Any+ -> Diagram v -- | The default legend picture when the 'LegendPic' is -- 'DefaultLegendPic'. defLegendPic- :: InSpace v n p- => PlotStyle b v n+ :: InSpace v Double p+ => PlotStyle v -> p- -> QDiagram b v n Any+ -> Diagram v defLegendPic = mempty -instance (Typeable b, Typeable v, Metric v, Typeable n, OrderedField n)- => Plotable (QDiagram b v n Any) b where+instance (Typeable v, HasLinearMap v) => Plotable (Diagram v) where renderPlotable s _ dia = dia # transform (s^.specTrans) -instance (TypeableFloat n, Renderable (Path V2 n) b) => Plotable (Path V2 n) b where+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 renderPlotable s sty path- = stroke path+ = strokePathV path # transform (s^.specTrans) # applyLineStyle sty defLegendPic sty _- = (p2 (-10,0) ~~ p2 (10,0))+ = strokePathV (fromVertices [(-10) *^ unitX, 10 *^ unitX]) # applyLineStyle sty ------------------------------------------------------------------------@@ -527,26 +536,26 @@ hidden = visible . involuted not {-# INLINE hidden #-} -instance HasVisibility (PlotOptions b v n) where+instance HasVisibility (PlotOptions v) where visible = plotVisible -instance HasVisibility (PlotMods b v n) where+instance HasVisibility (PlotMods v) where visible = plotVisible -instance HasVisibility (Plot p b) where+instance HasVisibility (Plot p) where visible = plotVisible -instance HasVisibility (DynamicPlot b v n) where+instance HasVisibility (DynamicPlot v) where visible = plotVisible -instance HasVisibility (StyledPlot b v n) where+instance HasVisibility (StyledPlot v) where visible = plotVisible -- | Set 'visible' to 'False' for the given setter. -- -- @--- 'hide' 'minorTicks' :: 'State' ('Axis' b v n) ()--- 'hide' ('xAxis' . 'gridLines') :: 'State' ('Axis' b v n) ()+-- 'hide' 'minorTicks' :: 'State' ('Axis' v) ()+-- 'hide' ('xAxis' . 'gridLines') :: 'State' ('Axis' v) () -- @ hide :: (MonadState s m, HasVisibility a) => ASetter' s a -> m () hide l = l . visible .= False@@ -554,8 +563,8 @@ -- | Set 'visible' to 'True' for the given setter. -- -- @--- 'display' 'minorGridLines' :: 'State' ('Axis' b v n) ()--- 'display' 'colourBar' :: 'State' ('Axis' b v n) ()+-- 'display' 'minorGridLines' :: 'State' ('Axis' v) ()+-- 'display' 'colourBar' :: 'State' ('Axis' v) () -- @ display :: (MonadState s m, HasVisibility a) => ASetter' s a -> m () display l = l . visible .= True@@ -565,20 +574,20 @@ ------------------------------------------------------------------------ -- | A 'PlotOptions' with modifications to a 'PlotStyle'.-data PlotMods b v n- = PlotMods (PlotOptions b v n) (PlotStyle b v n -> PlotStyle b v n)+data PlotMods v+ = PlotMods (PlotOptions v) (PlotStyle v -> PlotStyle v) -type instance V (PlotMods b v n) = v-type instance N (PlotMods b v n) = n+type instance V (PlotMods v) = v+type instance N (PlotMods v) = Double -instance Functor f => HasPlotOptions f (PlotMods b v n) b where+instance Functor f => HasPlotOptions f (PlotMods v) where plotOptions f (PlotMods opts sty) = f opts <&> \opts' -> PlotMods opts' sty -instance Settable f => HasPlotStyle f (PlotMods b v n) b where+instance Settable f => HasPlotStyle f (PlotMods v) where plotStyle = sty . mapped where sty f (PlotMods opts s) = f s <&> \s' -> PlotMods opts s' -instance (Additive v, Num n) => Default (PlotMods b v n) where+instance (HasBasis v, Foldable v) => Default (PlotMods v) where def = PlotMods def id ------------------------------------------------------------------------@@ -587,35 +596,35 @@ -- | A parameterised plot, together with a 'PlotMods'. This type has an -- instance of many classes for modifying specific plots.-data Plot p b =+data Plot p = Plot p- (PlotOptions b (V p) (N p))- (PlotStyle b (V p) (N p) -> PlotStyle b (V p) (N p))+ (PlotOptions (V p))+ (PlotStyle (V p) -> PlotStyle (V p)) deriving Typeable -type instance V (Plot p b) = V p-type instance N (Plot p b) = N p+type instance V (Plot p) = V p+type instance N (Plot p) = Double -instance Functor f => HasPlotOptions f (Plot p b) b where+instance Functor f => HasPlotOptions f (Plot p) where plotOptions f (Plot p opts sty) = f opts <&> \opts' -> Plot p opts' sty -instance Settable f => HasPlotStyle f (Plot p b) b where+instance Settable f => HasPlotStyle f (Plot p) where plotStyle = sty . mapped where sty f (Plot p opts s) = f s <&> \s' -> Plot p opts s' -instance HasOrientation p => HasOrientation (Plot p b) where+instance HasOrientation p => HasOrientation (Plot p) where orientation = rawPlot . orientation -- | Make a 'Plot' with 'Default' 'PlotOptions'.-mkPlot :: (Additive (V p), Num (N p)) => p -> Plot p b+mkPlot :: (InSpace v Double p, HasBasis v, Foldable v) => p -> Plot p mkPlot p = Plot p def id -- | Lens onto the raw 'Plotable' inside a 'Plot'.-rawPlot :: SameSpace p p' => Lens (Plot p b) (Plot p' b) p p'+rawPlot :: SameSpace p p' => Lens (Plot p) (Plot p') 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 b) (PlotMods b (V p) (N p))+plotMods :: Lens' (Plot p) (PlotMods (V p)) plotMods f (Plot p opts ps) = f (PlotMods opts ps) <&> \(PlotMods opts' ps') -> Plot p opts' ps' @@ -624,38 +633,38 @@ ------------------------------------------------------------------------ -- | A wrapped up 'Plot', used to store plots in an 'Axis'.-data DynamicPlot b v n where- DynamicPlot :: (InSpace v n p, Plotable p b) => Plot p b -> DynamicPlot b v n+data DynamicPlot v where+ DynamicPlot :: (InSpace v Double p, Plotable p) => Plot p -> DynamicPlot v deriving Typeable -type instance V (DynamicPlot b v n) = v-type instance N (DynamicPlot b v n) = n+type instance V (DynamicPlot v) = v+type instance N (DynamicPlot v) = Double -- | Prism for a 'DynamicPlot'.-_DynamicPlot :: (Plotable p b, Typeable b) => Prism' (DynamicPlot b (V p) (N p)) (Plot p b)+_DynamicPlot :: Plotable p => Prism' (DynamicPlot (V p)) (Plot p) _DynamicPlot = prism' DynamicPlot (\(DynamicPlot p) -> cast p) -- | Traversal over the dynamic plot without the 'Plotable' constraint -- '_DynamicPlot' has.-dynamicPlot :: forall p b. (Typeable p, Typeable b)- => Traversal' (DynamicPlot b (V p) (N p)) (Plot p b)+dynamicPlot :: forall p. Typeable p => Traversal' (DynamicPlot (V p)) (Plot p) 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 b)+ where eq :: Typeable a => a -> Maybe (a :~: Plot p) eq _ = eqT-instance Functor f => HasPlotOptions f (DynamicPlot b v n) b where++instance Functor f => HasPlotOptions f (DynamicPlot v) where plotOptions f (DynamicPlot (Plot p opts sty)) = f opts <&> \opts' -> DynamicPlot (Plot p opts' sty) -instance Settable f => HasPlotStyle f (DynamicPlot b v n) b where+instance Settable f => HasPlotStyle f (DynamicPlot v) where plotStyle = sty . mapped where- sty :: Setter' (DynamicPlot b v n) (PlotStyle b v n -> PlotStyle b v n)+ sty :: Setter' (DynamicPlot v) (PlotStyle v -> PlotStyle v) 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 b v n) (PlotMods b v n)+dynamicPlotMods :: Lens' (DynamicPlot v) (PlotMods v) dynamicPlotMods f (DynamicPlot (Plot p opts ps)) = f (PlotMods opts ps) <&> \(PlotMods opts' ps') -> DynamicPlot (Plot p opts' ps') @@ -668,32 +677,32 @@ -- with 'styledPlotLegend'. -- -- You can make a 'StyledPlot' with 'styleDynamic'-data StyledPlot b v n where+data StyledPlot v where StyledPlot- :: Plotable p b+ :: Plotable p => p- -> PlotOptions b (V p) (N p)- -> PlotStyle b (V p) (N p)- -> StyledPlot b (V p) (N p)+ -> PlotOptions (V p)+ -> PlotStyle (V p)+ -> StyledPlot (V p) -type instance V (StyledPlot b v n) = v-type instance N (StyledPlot b v n) = n+type instance V (StyledPlot v) = v+type instance N (StyledPlot v) = Double -instance Functor f => HasPlotOptions f (StyledPlot b v n) b where+instance Functor f => HasPlotOptions f (StyledPlot v) where plotOptions f (StyledPlot p opts sty) = f opts <&> \opts' -> StyledPlot p opts' sty -instance (Metric v, OrderedField n) => Enveloped (StyledPlot b v n) where+instance HasLinearMap v => Enveloped (StyledPlot v) where getEnvelope (StyledPlot p opts _) = getEnvelope p & transform (poTransform opts) -instance Functor f => HasPlotStyle f (StyledPlot b v n) b where+instance Functor f => HasPlotStyle f (StyledPlot v) 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 b. Typeable p => Traversal' (StyledPlot b (V p) (N p)) p+styledPlot :: forall p. Typeable p => Traversal' (StyledPlot (V p)) p styledPlot f s@(StyledPlot p opts sty) = case eq p of Just Refl -> f p <&> \p' -> StyledPlot p' opts sty@@ -702,21 +711,17 @@ eq _ = eqT -- | Give a 'DynamicPlot' a concrete 'PlotStyle'.-styleDynamic :: PlotStyle b v n -> DynamicPlot b v n -> StyledPlot b v n+styleDynamic :: PlotStyle v -> DynamicPlot v -> StyledPlot v styleDynamic sty (DynamicPlot (Plot p opts styF)) = StyledPlot p opts (styF sty) -- | Render a 'StyledPlot' given an and 'AxisSpec'.-renderStyledPlot- :: TypeableFloat n- => AxisSpec V2 n- -> StyledPlot b V2 n- -> QDiagram b V2 n Any+renderStyledPlot :: HasLinearMap v => AxisSpec v -> StyledPlot v -> Diagram v renderStyledPlot aSpec (StyledPlot p opts sty) = renderPlotable aSpec sty p- & whenever (opts^.hidden) phantom- & whenever (opts^.clipPlot) (clipTo $ specRect aSpec)+ & whenever (opts^.hidden) D.phantom+ -- & whenever (opts^.clipPlot) (clipTo $ specRect aSpec) XXX ADD CLIPTO XXX -specRect :: TypeableFloat n => AxisSpec V2 n -> Path V2 n+specRect :: AxisSpec V2 -> Path V2 Double specRect aSpec = rect (xU - xL) (yU - yL) # moveTo (mkP2 ((xU+xL)/2) ((yU+yL)/2))@@ -728,9 +733,7 @@ -- | Get the legend rendered entries from a single styled plot. The -- resulting entries are in no particular order. See also -- 'styledPlotLegends'.-singleStyledPlotLegend- :: StyledPlot b v n- -> [(n, QDiagram b v n Any, String)] -- ^ @(z-order, legend pic, legend text)@+singleStyledPlotLegend :: StyledPlot v -> [(Double, Diagram v, String)] -- ^ @(z-order, legend pic, legend text)@ singleStyledPlotLegend (StyledPlot p opts sty) = map mk (opts ^. legendEntries) where@@ -741,10 +744,7 @@ CustomLegendPic f -> f sty -- | Render a list of legend entries, in order.-styledPlotLegends- :: Ord n- => [StyledPlot b v n]- -> [(QDiagram b v n Any, String)] -- ^ @[(legend pic, legend text)]@+styledPlotLegends :: [StyledPlot v] -> [(Diagram v, String)] -- ^ @[(legend pic, legend text)]@ styledPlotLegends = map (\(_,p,t) -> (p,t)) . sortOn (view _1)
src/Plots/Types/Bar.hs view
@@ -80,11 +80,13 @@ import Plots.Util import qualified Data.List as List-import Diagrams.Core.Transform (fromSymmetric)-import Linear.V2 (_yx)+-- import Diagrams.Core.Transform (fromSymmetric)+-- import Linear.V2 (_yx) -import Diagrams.Prelude+import Geometry.TwoD.Transform +import Diagrams.Prelude hiding (orient)+ -- Single bar ---------------------------------------------------------- -- | Data for a single bar. The bar is drawn as@@ -97,9 +99,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, TrailLike t) => Point V2 n -> V2 n -> t+rectB :: (InSpace V2 n t, Fractional n, FromTrail t) => Point V2 n -> V2 n -> t rectB p (V2 x y) =- trailLike $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p .-^ V2 (x/2) 0+ fromLocTrail $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p .-^ V2 (x/2) 0 ------------------------------------------------------------------------ -- Bar layout@@ -107,49 +109,49 @@ -- | The way an individual bar plot or a group of bars plots are laid -- out on the axis.-data BarLayout n = BarLayout+data BarLayout = BarLayout { bOrient :: Orientation- , bWidth :: n- , bSpacing :: n- , bStart :: n+ , bWidth :: Double+ , bSpacing :: Double+ , bStart :: Double } deriving Typeable -instance Fractional n => Default (BarLayout n) where+instance Default BarLayout where def = BarLayout Horizontal 0.8 1 1 -type instance N (BarLayout n) = n+type instance N BarLayout = Double -instance HasOrientation (BarLayout n) where+instance HasOrientation BarLayout 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 (N a))+ barLayout :: Lens' a BarLayout -- | The width bar for single / stacked bars or the width of a group -- for grouped bar plot. -- -- Default is @0.8@- barWidth :: Lens' a (N a)+ barWidth :: Lens' a Double barWidth = barLayout . lens bWidth (\bl w -> bl {bWidth = w}) -- | The spacing between each bar or group of bars. -- -- Default is @1@- barSpacing :: Lens' a (N a)+ barSpacing :: Lens' a Double 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 (N a)+ barStart :: Lens' a Double barStart = barLayout . lens bStart (\bl x -> bl {bStart = x}) -instance HasBarLayout (BarLayout n) where+instance HasBarLayout BarLayout where barLayout = id -instance HasBarLayout a => HasBarLayout (Plot a b) where+instance HasBarLayout a => HasBarLayout (Plot a) where barLayout = rawPlot . barLayout ------------------------------------------------------------------------@@ -163,18 +165,18 @@ -- A 'BarPlot' is not intended to be constructed directly, instead use -- one of the helper functions.-data BarPlot n = BarPlot- { bpData :: [(n,n)]- , bpLayout :: BarLayout n+data BarPlot = BarPlot+ { bpData :: [(Double,Double)]+ , bpLayout :: BarLayout } deriving Typeable -type instance V (BarPlot n) = V2-type instance N (BarPlot n) = n+type instance V BarPlot = V2+type instance N BarPlot = Double -instance HasOrientation (BarPlot n) where+instance HasOrientation BarPlot where orientation = barLayout . orientation -instance OrderedField n => Enveloped (BarPlot n) where+instance Enveloped BarPlot where getEnvelope BarPlot {..} = getEnvelope . orient bpLayout _reflectXY id . (id :: Path v n -> Path v n) $ ifoldMap drawBar bpData@@ -182,8 +184,7 @@ 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 (TypeableFloat n, Renderable (Path V2 n) b)- => Plotable (BarPlot n) b where+instance Plotable BarPlot where renderPlotable s sty BarPlot {..} = ifoldMap drawBar bpData # orient bpLayout _reflectXY id@@ -205,9 +206,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 %~ atMost (local 0.8)+ sty' = sty & areaStyle . _lw . mapped %~ atMost (local 0.8) -instance HasBarLayout (BarPlot n) where+instance HasBarLayout BarPlot where barLayout = lens bpLayout (\bp l -> bp {bpLayout = l}) ------------------------------------------------------------------------@@ -215,11 +216,11 @@ ------------------------------------------------------------------------ -- | Create equidistant bars using the values.-mkBars :: (F.Foldable f, Num n) => BarLayout n -> f n -> BarPlot n+mkBars :: F.Foldable f => BarLayout -> f Double -> BarPlot 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 n -> f (n,n) -> BarPlot n+mkFloatingBars :: F.Foldable f => BarLayout -> f (Double,Double) -> BarPlot mkFloatingBars bl (F.toList -> ns) = BarPlot { bpData = ns , bpLayout = bl@@ -228,10 +229,9 @@ -- | Create uniform bars from groups of data, placing one group after -- the other. mkRunningBars- :: Num n- => BarLayout n- -> [[(n,n)]]- -> [BarPlot n]+ :: BarLayout+ -> [[(Double, Double)]]+ -> [BarPlot] mkRunningBars bl = snd . foldr f (view barStart bl, []) where f d (x, bs) = (x + dx, mkFloatingBars bl {bStart = x} d : bs)@@ -241,10 +241,9 @@ -- other. The first list will be the same as @mkUniformBars opts (map -- (0,) ys)@, subsequent lists will be placed on top. mkStackedBars- :: Num n- => BarLayout n- -> [[n]] -- values- -> [BarPlot n]+ :: BarLayout+ -> [[Double]] -- values+ -> [BarPlot] mkStackedBars bl = snd . List.mapAccumR f (repeat 0) where -- y0s are the base values for this set of bars, these accumulate@@ -255,11 +254,10 @@ -- | Similar to 'mkMultiStacked' but stack has the same height. mkStackedEqualBars- :: Fractional n- => n -- ^ value each bar reaches- -> BarLayout n- -> [[n]] -- ^ values- -> [BarPlot n]+ :: Double -- ^ value each bar reaches+ -> BarLayout+ -> [[Double]] -- ^ values+ -> [BarPlot] mkStackedEqualBars yM bl yss = mkStackedBars bl yss' where -- Multiplier for each bar to reach the desired height.@@ -273,11 +271,10 @@ -- as a single bar when using the 'BarPlotsOpts'. There is an addition -- parameter to adjust the width of each individual bar. mkGroupedBars- :: Fractional n- => n -- ^ width factor of individual bars (1 = touching)- -> BarLayout n- -> [[n]]- -> [BarPlot n]+ :: Double -- ^ width factor of individual bars (1 = touching)+ -> BarLayout+ -> [[Double]]+ -> [BarPlot] mkGroupedBars w bl xs = flip imap xs $ \i ns -> mkBars@@ -294,10 +291,10 @@ -- temporary functions that will be in next lib release -_reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n-_reflectionXY = fromSymmetric $ (_xy %~ view _yx) <-> (_xy %~ view _yx)+_reflectionXY :: (HasLinearMap v, R2 v, Num n) => Transformation v n+_reflectionXY = reflectionX <> reflectionY -_reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t+_reflectXY :: (InSpace v n t, R2 v, HasLinearMap v, Transformable t) => t -> t _reflectXY = transform _reflectionXY ----------------------------------------------------------------------------------@@ -321,11 +318,9 @@ -- -- > barExample = renderAxis barAxis barPlot- :: (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+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f Double -- ^ bar heights+ -> State (Plot BarPlot) () -- ^ changes to the bars -> m () -- ^ changes to the 'Axis' barPlot ns = addPlotable (mkBars def ns) @@ -344,11 +339,9 @@ -- -- > barExample' = renderAxis barAxis' barPlot'- :: (MonadState (Axis b V2 n) m,- Plotable (BarPlot n) b,- F.Foldable f)- => f n -- ^ bar heights- -> m () -- ^ changes to the 'Axis'+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f Double -- ^ bar heights+ -> m () -- ^ changes to the 'Axis' barPlot' ns = addPlotable' (mkBars def ns) -- | A add 'BarPlot' to an 'Axis' while naming the bars.@@ -368,11 +361,9 @@ -- > -- > namedBarExample = renderAxis namedBarAxis namedBarPlot- :: (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+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f (String, Double) -- ^ bar heights with name+ -> State (Plot BarPlot) () -- ^ changes to the bars -> m () -- ^ changes to the 'Axis' namedBarPlot d s = do addPlot bp@@ -396,20 +387,16 @@ -- -- > namedBarExample' = renderAxis namedBarAxis' namedBarPlot'- :: (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'+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f (String, Double) -- ^ 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 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+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f (Double,Double) -- ^ bar limits+ -> State (Plot BarPlot) () -- ^ changes to the bars -> m () floatingBarPlot ns = addPlotable (mkFloatingBars def ns) @@ -442,26 +429,26 @@ -- -- * Add labels to each (group of) bars with 'labelBars'. ---data MultiBarState b n a = MultiBarState- { mbsLayout :: BarLayout n+data MultiBarState a = MultiBarState+ { mbsLayout :: BarLayout -- ^ options for building bar plots - , mbsMods :: [(a, Endo (PlotMods b V2 n))]+ , mbsMods :: [(a, Endo (PlotMods V2))] -- ^ the data along with an adjustment to the plot properties , mbsLabels :: [String] -- ^ labels to be placed at the bottom of each bar - , mbsBarFun :: BarLayout n -> [[n]] -> [BarPlot n]+ , mbsBarFun :: BarLayout -> [[Double]] -> [BarPlot] -- ^ function used to build bar plots } -type instance N (MultiBarState b n a) = n+type instance N (MultiBarState a) = Double -instance HasOrientation (MultiBarState b n a) where+instance HasOrientation (MultiBarState a) where orientation = barLayout . orientation -instance HasBarLayout (MultiBarState b n a) where+instance HasBarLayout (MultiBarState a) where barLayout = lens mbsLayout (\mbs l -> mbs {mbsLayout = l}) -- > import Plots@@ -492,7 +479,7 @@ -- Adding to axis ------------------------------------------------------ -multiFun :: Lens' (MultiBarState b n a) (BarLayout n -> [[n]] -> [BarPlot n])+multiFun :: Lens' (MultiBarState a) (BarLayout -> [[Double]] -> [BarPlot]) multiFun = lens mbsBarFun (\mbs f -> mbs {mbsBarFun = f}) -- | Bars that are grouped together such that each group is a single@@ -503,7 +490,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_groupedBarsExample.svg#diagram=groupedBarsExample&height=400>> -groupedBars :: Fractional n => State (MultiBarState b n a) ()+groupedBars :: State (MultiBarState a) () groupedBars = groupedBars' 1 -- | Bars that are grouped together such that each group is a single@@ -515,7 +502,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_groupedBarsExample'.svg#diagram=groupedBarsExample'&height=400>> ---groupedBars' :: Fractional n => n -> State (MultiBarState b n a) ()+groupedBars' :: Double -> State (MultiBarState a) () groupedBars' n = multiFun .= mkGroupedBars n -- | Bars stacked on top of each other.@@ -524,7 +511,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_stackedBarsExample.svg#diagram=stackedBarsExample&height=400>> ---stackedBars :: Num n => State (MultiBarState b n a) ()+stackedBars :: State (MultiBarState a) () stackedBars = multiFun .= mkStackedBars -- | Bars stacked on top of each other where every bar is the given@@ -535,7 +522,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_stackedEqualBarsExample.svg#diagram=stackedEqualBarsExample&height=400>> ---stackedEqualBars :: Fractional n => n -> State (MultiBarState b n a) ()+stackedEqualBars :: Double -> State (MultiBarState a) () stackedEqualBars n = multiFun .= mkStackedEqualBars n -- | Normal 'bars' where each data set follows the last.@@ -544,7 +531,7 @@ -- -- <<diagrams/src_Plots_Types_Bar_runningBarsExample.svg#diagram=runningBarsExample&height=400>> ---runningBars :: Num n => State (MultiBarState b n a) ()+runningBars :: State (MultiBarState a) () runningBars = multiFun .= \l xs -> mkRunningBars l (map (map (0,)) xs) -- | Construct multiple bars, grouped together. See 'MultiBarState' for@@ -580,13 +567,10 @@ -- -- > multiBarExample = renderAxis multiBarAxis multiBars- :: (MonadState (Axis b V2 n) m,- Plotable (BarPlot n) b,- F.Foldable f,- F.Foldable g)+ :: (MonadState (Axis V2) m, F.Foldable f, F.Foldable g) => f a -- ^ data for multi plot- -> (a -> g n) -- ^ extract bar heights from each data set- -> State (MultiBarState b n a) () -- ^ state to make changes to the plot+ -> (a -> g Double) -- ^ extract bar heights from each data set+ -> State (MultiBarState a) () -- ^ state to make changes to the plot -> m () -- ^ changes to the 'Axis' multiBars (F.toList -> as) f st = do -- add the plots@@ -614,9 +598,7 @@ -- | Place labels under the centre of each bar using the 'BarLayout' by -- changing that 'axisTickLabels', using the provided string in order.-barLayoutAxisLabels- :: (MonadState (Axis b V2 n) m, Fractional n)- => BarLayout n -> [String] -> m ()+barLayoutAxisLabels :: MonadState (Axis V2) m => BarLayout -> [String] -> m () barLayoutAxisLabels bl ls = unless (null ls) $ axes . orient bl _y _x &= do@@ -639,11 +621,11 @@ -- * 'key' - add a legend entry for that group of bars -- onBars- :: (a -> State (PlotMods b V2 n) ())+ :: (a -> State (PlotMods V2) ()) -- ^ Modifier the 'PlotOptions' and 'PlotStyle' for the bars -- associated with the data from @a@. - -> State (MultiBarState b n a) ()+ -> State (MultiBarState a) () -- ^ Changes to each data set when executing 'multiBars'. onBars f = mods . mapped %= \(a, endo) -> (a, endo <> Endo (execState (f a)))@@ -652,7 +634,7 @@ class HasLabels a where labels :: Lens' a [String] -instance HasLabels (MultiBarState b n a) where+instance HasLabels (MultiBarState 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,8 +76,12 @@ import Plots.Style import Plots.Types +import Diagrams.TwoD.Image++import Geometry.ThreeD.Shapes+ --------------------------------------------------------------------------- Heatmap+-- HeatMap ------------------------------------------------------------------------ -- | 2D Array of 'Double's.@@ -196,16 +200,10 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pixelHeatRender myHM viridis ---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+pixelHeatRender :: HeatMatrix -> ColourMap -> Diagram V2+pixelHeatRender hm cm = alignBL $ imageEmb (ImageRGB8 img) where- img = heatImage hm cm- V2 x y = hmSize hm+ img = heatImage hm cm -- | Render an heatmap as an 'ImageRGB8' with @n@ pixels per heat matrix -- point.@@ -221,17 +219,11 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pixelHeatRender' 10 myHM viridis ---pixelHeatRender'- :: (Renderable (DImage n Embedded) b, TypeableFloat n)- => Int- -> HeatMatrix- -> ColourMap- -> QDiagram b V2 n Any+pixelHeatRender' :: Int -> HeatMatrix -> ColourMap -> Diagram V2 pixelHeatRender' n hm cm =- scale (1/fromIntegral n) . alignBL . image $ DImage (ImageRaster (ImageRGB8 img)) (x*n) (y*n) mempty+ scale (1/fromIntegral n) . alignBL $ imageEmb (ImageRGB8 img) where- img = scaleImage n $ heatImage hm cm- V2 x y = hmSize hm+ img = scaleImage n $ heatImage hm cm -- | Scale an image so each pixel takes (n*n) pixels. This can be -- useful for using 'heatImage' on small heat matrices to give a@@ -328,11 +320,7 @@ -- > myHM = mkHeatMatrix (V2 5 5) f -- > in pathHeatRender myHM viridis ---pathHeatRender- :: (Renderable (Path V2 n) b, TypeableFloat n)- => HeatMatrix- -> ColourMap- -> QDiagram b V2 n Any+pathHeatRender :: HeatMatrix -> ColourMap -> Diagram V2 pathHeatRender hm@(HeatMatrix _ _ a b) cm = ifoldMapOf hmPoints mk hm # lwO 0 where normalise d = (d - a) / (b - a)@@ -355,23 +343,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 b n = HeatMap+data HeatMap v = HeatMap { hMatrix :: HeatMatrix- , hStart :: P2 n- , hSize :: V2 n- , hGridSty :: Style V2 n+ , hStart :: P2 Double+ , hSize :: V2 Double+ , hGridSty :: Style v Double , hGridVisible :: Bool , hLimits :: Maybe (Double,Double)- , hDraw :: HeatMatrix -> ColourMap -> QDiagram b V2 n Any+ , hDraw :: HeatMatrix -> ColourMap -> Diagram v } deriving Typeable -type instance V (HeatMap b n) = V2-type instance N (HeatMap b n) = n+type instance V (HeatMap v) = v+type instance N (HeatMap v) = Double -- | Class of things that let you change the heatmap options.-class HasHeatMap f a b | a -> b where+class HasHeatMap f a where -- | Lens onto the heatmap options.- heatMapOptions :: LensLike' f a (HeatMap b (N a))+ heatMapOptions :: LensLike' f a (HeatMap (V a)) -- | Whether there should be grid lines draw for the heat map. --@@ -383,19 +371,19 @@ -- visible. -- -- Default is 'mempty'.- heatMapGridStyle :: Functor f => LensLike' f a (Style V2 (N a))+ heatMapGridStyle :: Functor f => LensLike' f a (Style (V a) Double) 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 (N a))+ heatMapSize :: Functor f => LensLike' f a (V2 Double) 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, Fractional (N a)) => LensLike' f a (V2 (N a))+ heatMapExtent :: Functor f => LensLike' f a (V2 Double) heatMapExtent = heatMapOptions . l where l f hm = f (hSize hm * s) <&> \x -> hm { hSize = x / s } where s = fmap fromIntegral (hmSize $ hMatrix hm)@@ -403,11 +391,11 @@ -- | The starting point at the bottom left corner of the heat map. -- -- Default is 'origin'- heatMapStart :: Functor f => LensLike' f a (P2 (N a))+ heatMapStart :: Functor f => LensLike' f a (P2 Double) heatMapStart = heatMapOptions . lens hStart (\s b -> (s {hStart = b})) -- | The center point of the heat map.- heatMapCentre :: (Functor f, Fractional (N a)) => LensLike' f a (P2 (N a))+ heatMapCentre :: Functor f => LensLike' f a (P2 Double) 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@@ -421,26 +409,31 @@ -- 'pixelHeatRender'. -- -- Default is 'pathHeatRender'.- heatMapRender :: Functor f => LensLike' f a (HeatMatrix -> ColourMap -> QDiagram b V2 (N a) Any)+ heatMapRender :: Functor f => LensLike' f a (HeatMatrix -> ColourMap -> Diagram (V a)) heatMapRender = heatMapOptions . lens hDraw (\s b -> (s {hDraw = b})) -instance HasHeatMap f (HeatMap b n) b where+instance HasHeatMap f (HeatMap v) where heatMapOptions = id -instance (Functor f, HasHeatMap f a b) => HasHeatMap f (Plot a b) b where+instance (Functor f, HasHeatMap f a) => HasHeatMap f (Plot a) where heatMapOptions = rawPlot . heatMapOptions -instance OrderedField n => Enveloped (HeatMap b n) where+instance Enveloped (HeatMap V2) where getEnvelope hm = getEnvelope (fromCorners p (p .+^ v)) where p = view heatMapStart hm v = view heatMapExtent hm -instance (Typeable b, TypeableFloat n, Renderable (Path V2 n) b)- => Plotable (HeatMap b n) b where+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 renderPlotable s _sty HeatMap {..} = transform (s^.specTrans) $ grid <> hDraw matrix' (s^.specColourMap)- # transform (scaleV hSize)+ # scaleV hSize # moveTo hStart where --- TODO@@ -456,13 +449,30 @@ -- XXX make better defLegendPic sty HeatMap {..} = square 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)+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 --- | Construct a 'Heatmap' using the given 'HeatMatrix'.-mkHeatMap :: (Renderable (Path V2 n) b, TypeableFloat n)- => HeatMatrix -> HeatMap b n+ --- 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++-- | Construct a 'HeatMap' using the given 'HeatMatrix'.+mkHeatMap :: HeatMatrix -> HeatMap V2 mkHeatMap mat = HeatMap { hMatrix = mat , hStart = origin@@ -473,6 +483,17 @@ , 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@@ -500,12 +521,9 @@ heatMap :: (F.Foldable f, F.Foldable g,- TypeableFloat n,- Typeable b,- MonadState (Axis b V2 n) m,- Renderable (Path V2 n) b)+ MonadState (Axis V2) m) => f (g Double)- -> State (Plot (HeatMap b n) b) ()+ -> State (Plot (HeatMap V2)) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' heatMap xss s = do@@ -515,6 +533,21 @@ -- (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. --@@ -541,10 +574,7 @@ heatMap' :: (F.Foldable f, F.Foldable g,- TypeableFloat n,- Typeable b,- MonadState (Axis b V2 n) m,- Renderable (Path V2 n) b)+ MonadState (Axis V2) m) => f (g Double) -> m () -- ^ add plot to 'Axis' heatMap' xss = heatMap xss (return ())@@ -574,13 +604,10 @@ -- heatMapIndexed :: (VectorLike V2 Int i,- TypeableFloat n,- Typeable b,- MonadState (Axis b V2 n) m,- Renderable (Path V2 n) b)+ MonadState (Axis V2) m) => i -- ^ extent of array -> (i -> Double) -- ^ heat from index- -> State (Plot (HeatMap b n) b) ()+ -> State (Plot (HeatMap V2)) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' heatMapIndexed i f s = do@@ -616,12 +643,14 @@ -- heatMapIndexed' :: (VectorLike V2 Int i,- TypeableFloat n,- Typeable b,- MonadState (Axis b V2 n) m,- Renderable (Path V2 n) b)+ MonadState (Axis V2) m) => 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,8 +64,7 @@ import qualified Data.Vector as V import qualified Statistics.Sample.Histogram as Stat -import Diagrams.Core.Transform (fromSymmetric)-import Diagrams.Prelude+import Diagrams.Prelude hiding (orient) import Linear.V2 (_yx) import Plots.Axis@@ -73,38 +72,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, TrailLike t) => Point V2 n -> V2 n -> t+rectBL :: (InSpace V2 n t, FromTrail t) => Point V2 n -> V2 n -> t rectBL p (V2 x y) =- trailLike $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p+ fromLocTrail $ fromOffsets [V2 x 0, V2 0 y, V2 (-x) 0] # closeTrail `at` p ------------------------------------------------------------------------ -- GHistogram plot ------------------------------------------------------------------------ -- | Simple histogram type supporting uniform bins.-data HistogramPlot n = HistogramPlot- { hWidth :: n- , hStart :: n- , hValues :: [n]+data HistogramPlot = HistogramPlot+ { hWidth :: Double+ , hStart :: Double+ , hValues :: [Double] , hOrient :: Orientation } deriving Typeable -type instance V (HistogramPlot n) = V2-type instance N (HistogramPlot n) = n+type instance V HistogramPlot = V2+type instance N HistogramPlot = Double -instance OrderedField n => Enveloped (HistogramPlot n) where+instance Enveloped HistogramPlot where getEnvelope HistogramPlot {..} =- -- don't like this redundant code- getEnvelope . orient hOrient _reflectXY id . (id :: Path v n -> Path v n) $+ -- don't like this reduntent code+ getEnvelope . orient hOrient _reflectXY id . (id :: Path V2 Double -> Path V2 Double) $ ifoldMap drawBar hValues where drawBar i h = rectBL (mkP2 x 0) (V2 hWidth h) where x = hStart + fromIntegral i * hWidth -instance (TypeableFloat n, Renderable (Path V2 n) b)- => Plotable (HistogramPlot n) b where+instance Plotable HistogramPlot where renderPlotable s sty HistogramPlot {..} = ifoldMap drawBar hValues # orient hOrient _reflectXY id@@ -121,9 +120,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 %~ atMost (local 0.8)+ sty' = sty & areaStyle . _lw . mapped %~ atMost (local 0.8) -instance HasOrientation (HistogramPlot n) where+instance HasOrientation HistogramPlot where orientation = lens hOrient $ \hp o -> hp {hOrient = o} ------------------------------------------------------------------------@@ -132,23 +131,21 @@ -- | Plot an already computed histogram with equally sized bins. computedHistogram- :: (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) ()+ :: (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) () -> m () computedHistogram x0 w xs = addPlotable (mkComputedHistogram x0 w xs) -- | Construct a 'HistogramPlot' from raw histogram data. mkComputedHistogram :: F.Foldable f- => n -- ^ start of first bin- -> n -- ^ width of each bin- -> f n -- ^ heights of the bins- -> HistogramPlot n+ => Double -- ^ start of first bin+ -> Double -- ^ width of each bin+ -> f Double -- ^ heights of the bins+ -> HistogramPlot mkComputedHistogram x0 w xs = HistogramPlot x0 w (F.toList xs) Horizontal ----------------------------------------------------------------------------@@ -192,7 +189,7 @@ -- | The way to normalise the data from a histogram. The default method -- is 'count'. newtype NormalisationMethod =- NM { runNM :: forall n. Fractional n => n -> V.Vector n -> V.Vector n }+ NM { runNM :: Double -> V.Vector Double -> V.Vector Double } -- width -> heights -> normalised heights instance Default NormalisationMethod where@@ -255,17 +252,17 @@ -- | Options for binning histogram data. For now only very basic -- histograms building is supported.-data HistogramOptions n = HistogramOptions+data HistogramOptions = HistogramOptions { hBins :: Int- , hRange :: Maybe (n, n)+ , hRange :: Maybe (Double, Double) , hNorm :: NormalisationMethod , oOrient :: Orientation } -type instance V (HistogramOptions n) = V2-type instance N (HistogramOptions n) = n+type instance V HistogramOptions = V2+type instance N HistogramOptions = Double -instance Default (HistogramOptions n) where+instance Default HistogramOptions where def = HistogramOptions { hBins = 10 , hRange = Nothing@@ -273,12 +270,12 @@ , oOrient = Vertical } -instance HasOrientation (HistogramOptions n) where+instance HasOrientation HistogramOptions 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 (N a))+ histogramOptions :: Lens' a HistogramOptions -- | The number of bins (bars) to use for the histogram. Must be -- positive.@@ -291,7 +288,7 @@ -- data outside the range is ignored. -- -- 'Default' is 'Nothing'.- binRange :: Lens' a (Maybe (N a, N a))+ binRange :: Lens' a (Maybe (Double, Double)) binRange = histogramOptions . lens hRange (\ho r -> ho {hRange = r}) -- | Should the resulting histogram be normalised so the total area is@@ -301,17 +298,15 @@ normaliseSample :: Lens' a NormalisationMethod normaliseSample = histogramOptions . lens hNorm (\ho b -> ho {hNorm = b}) -instance HasHistogramOptions (HistogramOptions n) where+instance HasHistogramOptions HistogramOptions where histogramOptions = id -instance HasHistogramOptions a => HasHistogramOptions (Plot a b) where+instance HasHistogramOptions a => HasHistogramOptions (Plot a) where histogramOptions = rawPlot . histogramOptions -- | Create a histogram by binning the data using the -- 'HistogramOptions'.-mkHistogramPlot- :: (F.Foldable f, RealFrac n)- => HistogramOptions n -> f n -> HistogramPlot n+mkHistogramPlot :: F.Foldable f => HistogramOptions -> f Double -> HistogramPlot mkHistogramPlot HistogramOptions {..} xs = HistogramPlot { hWidth = w@@ -326,10 +321,9 @@ (a,b) = fromMaybe (range hBins v) hRange -- Taken from Statistics, which was limited to 'Double'.-range :: (Ord n, Fractional n)- => Int -- ^ Number of bins (must be positive).- -> V.Vector n -- ^ Sample data (cannot be empty).- -> (n, n)+range :: Int -- ^ Number of bins (must be positive).+ -> V.Vector Double -- ^ Sample data (cannot be empty).+ -> (Double, Double) range nBins xs | nBins < 1 = error "Plots.Types.Histogram: invalid bin count" | V.null xs = error "Plots.Types.Histogram: empty sample"@@ -377,40 +371,40 @@ -- -- > histogramExample = renderAxis histogramAxis histogramPlot- :: (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+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f Double -- ^ data+ -> State (Plot HistogramOptions) () -- ^ 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 b V2 n) m, Plotable (HistogramPlot n) b, F.Foldable f, RealFrac n)- => f n -- ^ data+ :: (MonadState (Axis V2) m, F.Foldable f)+ => f Double -- ^ data -> m () -- ^ add plot to axis histogramPlot' d = histogramPlot d (return ()) -- | Add a 'HistogramPlot' using a fold over the data. histogramPlotOf- :: (MonadState (Axis b V2 n) m, Plotable (HistogramPlot n) b, RealFrac n)- => Fold s n -- ^ fold over the data+ :: (MonadState (Axis V2) m)+ => Fold s Double -- ^ fold over the data -> s -- ^ data to fold- -> State (Plot (HistogramOptions n) b) () -- ^ change to the plot+ -> State (Plot HistogramOptions) () -- ^ 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 b V2 n) m, Plotable (HistogramPlot n) b, RealFrac n)- => Fold s n -> s -> m ()+ :: MonadState (Axis V2) m+ => Fold s Double -> s -> m () histogramPlotOf' f s = histogramPlotOf f s (return ()) -- temporary functions that will be in next lib release -_reflectionXY :: (Additive v, R2 v, Num n) => Transformation v n-_reflectionXY = fromSymmetric $ (_xy %~ view _yx) <-> (_xy %~ view _yx)+_reflectionXY :: (HasLinearMap v, R2 v, Num n) => Transformation v n+_reflectionXY = reflectionX <> reflectionY -_reflectXY :: (InSpace v n t, R2 v, Transformable t) => t -> t+_reflectXY :: (InSpace v n t, HasLinearMap v, 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,47 +55,46 @@ 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,- 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+ :: (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 -> m () -- ^ add plot to the 'Axis'-trailPlot = pathPlot . toPath+trailPlot = pathPlot . trail2Path -- | Add a 'Trail' as a 'Plot' to an 'Axis' without changes to the plot -- options. trailPlot'- :: (BaseSpace c ~ v,- Plotable (Path v n) b,- MonadState (Axis b c n) m)- => Trail v n -- ^ trail to plot+ :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)+ => Located (Trail v Double) -- ^ trail to plot -> m () -- ^ add plot to the 'Axis'-trailPlot' = pathPlot' . toPath+trailPlot' = pathPlot' . trail2Path -- | Add a 'Path' as a 'Plot' to an 'Axis'. pathPlot- :: (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+ :: (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 -> 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,- Plotable (Path v n) b,- MonadState (Axis b c n) m)- => Path v n -- ^ path to plot+ :: (BaseSpace c ~ v, MonadState (Axis c) m, HasLinearMap v, Typeable v, R1 v)+ => Path v Double -- ^ path to plot -> m () -- ^ add plot to the 'Axis' pathPlot' = addPlotable' @@ -106,54 +105,56 @@ -- | Add a 'Path' plot from a list of points. linePlot :: (BaseSpace c ~ v,- Metric v,+ HasLinearMap v, F.Foldable f,- PointLike v n p,- Plotable (Path v n) b,- MonadState (Axis b c n) m)+ R1 v,+ PointLike v Double p,+ MonadState (Axis c) m) => f p -- ^ points to turn into trail- -> State (Plot (Path v n) b) () -- ^ changes to plot options+ -> State (Plot (Path v Double)) () -- ^ 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,- Metric v,+ HasLinearMap v, F.Foldable f,- PointLike v n p,- Plotable (Path v n) b,- MonadState (Axis b c n) m)+ R1 v,+ PointLike v Double p,+ MonadState (Axis c) 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,- 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)+-- 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) -- | 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 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 ())+-- 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 ()) ------------------------------------------------------------------------ -- Trail and path@@ -173,5 +174,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 $ map (mkTrailOf f2) (toListOf f1 as)+mkPathOf f1 f2 as = Path . S.fromList $ map (mkTrailOf f2) (toListOf f1 as)
− src/Plots/Types/Pie.hs
@@ -1,308 +0,0 @@-{-# 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,6 +80,8 @@ import Plots.Style import Plots.Types +import Diagrams.Types (mkQD, Prim (..))+ -- config -- > import Plots @@ -89,31 +91,30 @@ -- | 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 n where- ScatterPlot :: Typeable a => ScatterOptions v n a -> ScatterPlot v n+data ScatterPlot v where+ ScatterPlot :: Typeable a => ScatterOptions v a -> ScatterPlot v deriving Typeable -type instance V (ScatterPlot v n) = v-type instance N (ScatterPlot v n) = n+type instance V (ScatterPlot v) = v+type instance N (ScatterPlot v) = Double -- | 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 n a = ScatterOptions+data ScatterOptions v a = ScatterOptions { oData :: [a]- , oPos :: a -> Point v n- , oTr :: a -> Transformation v n- , oSty :: a -> Style v n+ , oPos :: a -> Point v Double+ , oTr :: a -> Transformation v Double+ , oSty :: a -> Style v Double , oLine :: Bool } deriving Typeable -type instance V (ScatterOptions v n a) = v-type instance N (ScatterOptions v n a) = n+type instance V (ScatterOptions v a) = v+type instance N (ScatterOptions v a) = Double -instance (Metric v, OrderedField n) => Enveloped (ScatterPlot v n) where+instance Metric v => Enveloped (ScatterPlot v) where getEnvelope (ScatterPlot (ScatterOptions {..})) = getEnvelope (map oPos oData) -instance (TypeableFloat n, Renderable (Path V2 n) b)- => Plotable (ScatterPlot V2 n) b where+instance Plotable (ScatterPlot V2) where renderPlotable s sty (ScatterPlot (ScatterOptions {..})) = markers <> line where@@ -133,21 +134,44 @@ 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 n p, F.Foldable f, Fractional n)+ :: (PointLike v Double p, F.Foldable f) => f a -> (a -> p)- -> ScatterOptions v n a+ -> ScatterOptions v a mkScatterOptions xs pf = ScatterOptions { oData = F.toList xs , oPos = view unpointLike . pf , oTr = mempty- , oSty = const (_Wrapped ## mempty)+ , oSty = const mempty , oLine = False } @@ -163,100 +187,100 @@ -- 'lineStyle' from the 'PlotStyle'. connectingLine :: Functor f => LensLike' f a Bool -instance HasConnectingLine f (ScatterOptions v n a) where+instance HasConnectingLine f (ScatterOptions v a) where connectingLine = lens oLine (\o b -> o {oLine = b}) -instance HasConnectingLine f (ScatterPlot v n) where+instance HasConnectingLine f (ScatterPlot v) where connectingLine f (ScatterPlot o@(ScatterOptions {..})) = f oLine <&> \b -> ScatterPlot o {oLine = b} -instance HasConnectingLine f p => HasConnectingLine f (Plot p b) where+instance HasConnectingLine f p => HasConnectingLine f (Plot p) where connectingLine = rawPlot . connectingLine -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))+instance (Applicative f, Typeable v)+ => HasConnectingLine f (DynamicPlot v) where+ connectingLine = (dynamicPlot :: Traversal' (DynamicPlot v) (Plot (ScatterPlot v))) . connectingLine -instance (Applicative f, Typeable v, Typeable n)- => HasConnectingLine f (StyledPlot b v n) where- connectingLine = (styledPlot :: Traversal' (StyledPlot b v n) (ScatterPlot v n))+instance (Applicative f, Typeable v)+ => HasConnectingLine f (StyledPlot v) where+ connectingLine = (styledPlot :: Traversal' (StyledPlot v) (ScatterPlot v)) . connectingLine -instance (Settable f, Typeable (BaseSpace c), Typeable n)- => HasConnectingLine f (Axis b c n) where+instance (Settable f, Typeable (BaseSpace c))+ => HasConnectingLine f (Axis c) 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) (N a) d)+ gscatterOptions :: LensLike' f a (ScatterOptions (V a) d) -- | Apply a transform to the markers using the associated data.- scatterTransform :: Functor f => LensLike' f a (d -> Transformation (V a) (N a))+ scatterTransform :: Functor f => LensLike' f a (d -> Transformation (V a) Double) 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) (N a))+ scatterStyle :: Functor f => LensLike' f a (d -> Style (V a) Double) 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) (N a))+ scatterPosition :: Functor f => LensLike' f a (d -> Point (V a) Double) scatterPosition = gscatterOptions . lens oPos (\o pos -> o {oPos = pos}) -instance d ~ d' => HasScatterOptions f (ScatterOptions v n d) d' where+instance d ~ d' => HasScatterOptions f (ScatterOptions v d) d' where gscatterOptions = id -instance (Applicative f, Typeable v, Typeable n, Typeable d)- => HasScatterOptions f (ScatterPlot v n) d where+instance (Applicative f, Typeable v, Typeable d)+ => HasScatterOptions f (ScatterPlot v) 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 n d)+ eq :: Typeable a => a -> Maybe (a :~: ScatterOptions v d) eq _ = eqT -instance (Functor f, HasScatterOptions f p a) => HasScatterOptions f (Plot p b) a where+instance (Functor f, HasScatterOptions f p a) => HasScatterOptions f (Plot p) a where gscatterOptions = rawPlot . gscatterOptions -instance (Applicative f, Typeable b, Typeable v, Typeable n, Typeable a)- => HasScatterOptions f (DynamicPlot b v n) a where+instance (Applicative f, Typeable v, Typeable a)+ => HasScatterOptions f (DynamicPlot v) a where gscatterOptions = dynamicPlot . rawPlot -instance (Applicative f, Typeable b, Typeable (BaseSpace c), Typeable n, Typeable a)- => HasScatterOptions f (Axis b c n) a where+instance (Applicative f, Typeable (BaseSpace c), Typeable a)+ => HasScatterOptions f (Axis c) a where gscatterOptions = axisPlots . traverse . gscatterOptions -- Pure scatter lenses ------------------------------------------------- -- | Lens onto a scatter plot of points.-scatterOptions :: (InSpace v n a, HasScatterOptions f a (Point v n))- => LensLike' f a (ScatterOptions v n (Point v n))+scatterOptions :: (InSpace v Double a, HasScatterOptions f a (Point v Double))+ => LensLike' f a (ScatterOptions v (Point v Double)) 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 n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n))--- => LensLike' f a (p -> Transformation v n)+-- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v))+-- => LensLike' f a (p -> Transformation v) -- _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 n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n))+-- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v)) -- => 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 n a, PointLike v n p, Functor f, HasScatterOptions f a (Point v n))--- => LensLike' f a (p -> Style v n)+-- :: (InSpace v a, PointLike v p, Functor f, HasScatterOptions f a (Point v))+-- => LensLike' f a (p -> Style v) -- _scatterStyle = scatterStyle . lmapping unpointLike ------------------------------------------------------------------------@@ -275,9 +299,9 @@ -- | Add a 'ScatterPlot' to the 'AxisState' from a data set. -- -- @--- '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') ()+-- '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') () -- @ -- -- === __Example__@@ -289,7 +313,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 B V2 Double+-- > scatterAxis :: Axis V2 -- > scatterAxis = r2Axis &~ do -- > scatterPlot mydata1 $ key "data 1" -- > scatterPlot mydata2 $ key "data 2"@@ -298,13 +322,12 @@ -- > scatterExample = renderAxis scatterAxis scatterPlot :: (BaseSpace c ~ v,- PointLike v n p,- Typeable n,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v), F.Foldable f) => f p -- ^ points to plot- -> State (Plot (ScatterOptions v n (Point v n)) b) ()+ -> State (Plot (ScatterOptions v (Point v Double))) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' scatterPlot xs = gscatterPlot (xs ^.. folded . unpointLike) id@@ -336,10 +359,9 @@ -- > scatterExample' = renderAxis scatterAxis' scatterPlot' :: (BaseSpace c ~ v,- PointLike v n p,- Typeable n,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v), F.Foldable f) => f p -- ^ points to plot -> m () -- ^ add plot to 'Axis'@@ -348,13 +370,12 @@ -- | Version of 'scatterPlot' that accepts a 'Fold' over the data. scatterPlotOf :: (BaseSpace c ~ v,- PointLike v n p,- Typeable n,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b)+ PointLike v Double p,+ Plotable (ScatterPlot v),+ MonadState (Axis c) m) => Fold s p -- ^ fold over points -> s -- ^ data to fold- -> State (Plot (ScatterOptions v n (Point v n)) b) () -- ^ changes to plot options+ -> State (Plot (ScatterOptions v (Point v Double))) () -- ^ changes to plot options -> m () -- ^ add plot to 'Axis' scatterPlotOf f s = scatterPlot (toListOf f s) @@ -362,10 +383,9 @@ -- without any changes to the 'ScatterOptions'. scatterPlotOf' :: (BaseSpace c ~ v,- PointLike v n p,- Typeable n,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b)+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v)) => Fold s p -- ^ fold over points -> s -- ^ data to fold -> m () -- ^ add plot to axis@@ -376,15 +396,15 @@ ------------------------------------------------------------------------ -- | A bubble plot is a scatter plot using point together with a scalar.-type BubbleOptions v n = ScatterOptions v n (n, Point v n)+type BubbleOptions v = ScatterOptions v (Double, Point v Double) -- | Scatter plots with extra numeric parameter. By default the extra -- parameter is the scale of the marker but this can be changed. -- -- @--- 'bubblePlot' :: [('Double', ('Double', 'Double'))] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') ()--- 'bubblePlot' :: [('Double', 'V2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') ()--- 'bubblePlot' :: [('Double', 'P2' 'Double')] -> 'State' ('Plot' ('BubbleOptions' v n) b) () -> 'State' ('Axis' b 'V2' 'Double') ()+-- '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') () -- @ -- -- === __Example__@@ -406,13 +426,12 @@ -- > bubbleExample = renderAxis bubbleAxis bubblePlot :: (BaseSpace c ~ v,- PointLike v n p,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,- Typeable n,+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v), F.Foldable f)- => f (n, p) -- ^ fold over points with a size- -> State (Plot (BubbleOptions v n) b) () -- ^ changes to the options+ => f (Double, p) -- ^ fold over points with a size+ -> State (Plot (BubbleOptions v)) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlot xs s = gscatterPlot (xs ^.. folded . mapping unpointLike) snd $ do@@ -428,25 +447,23 @@ -- bubblePlot' :: (v ~ BaseSpace c,- PointLike v n p,- Typeable n,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v), F.Foldable f)- => f (n, p) -- ^ fold over points with a size+ => f (Double, 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 n p,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,- Typeable n)- => Fold s (n,p) -- ^ fold over the data+ PointLike v Double p,+ Plotable (ScatterPlot v),+ MonadState (Axis c) m)+ => Fold s (Double,p) -- ^ fold over the data -> s -- ^ data- -> State (Plot (BubbleOptions v n) b) ()+ -> State (Plot (BubbleOptions v)) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlotOf f s = bubblePlot (toListOf f s)@@ -455,13 +472,12 @@ -- changes to the 'BubbleOptions'. bubblePlotOf' :: (BaseSpace c ~ v,- 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+ PointLike v Double p,+ MonadState (Axis c) m,+ Plotable (ScatterPlot v))+ => Fold s (Double,p) -- ^ fold over the data -> s -- ^ data- -> State (Plot (BubbleOptions v n) b) ()+ -> State (Plot (BubbleOptions v)) () -- ^ changes to the options -> m () -- ^ add plot to 'Axis' bubblePlotOf' f s = bubblePlot (toListOf f s)@@ -469,43 +485,43 @@ -- Bubble scatter lenses ----------------------------------------------- -- | LensLike onto into a 'ScatterOptions' made up of a scaler @n@, and--- a point, @'Point' v n@+-- a point, @'Point' v@ -- -- @--- 'bubbleOptions' :: 'Lens'' ('Plot' ('BubbleOptions' v n) v) ('BubbleOptions' v n)+-- 'bubbleOptions' :: 'Lens'' ('Plot' ('BubbleOptions' v) v) ('BubbleOptions' v) -- @-bubbleOptions :: (InSpace v n a, HasScatterOptions f a (n, Point v n))- => LensLike' f a (BubbleOptions v n)+bubbleOptions :: (InSpace v Double a, HasScatterOptions f a (Double, Point v Double))+ => LensLike' f a (BubbleOptions v) bubbleOptions = gscatterOptions -- | Setter over the transform function for a 'bubblePlot'. Default is 'scale'. -- -- @--- 'bubbleOptions' :: 'Setter'' ('Plot' ('BubbleOptions' v n) v) (n -> 'Transformation' v n)+-- 'bubbleOptions' :: 'Setter'' ('Plot' ('BubbleOptions' v) v) (n -> 'Transformation' v) -- @ -- -- Note that this is the less general version of @'bubblePlot' . -- 'scatterTransform'@, which would give a 'LensLike' onto @(n,--- 'Point' v n) -> 'Transformation' v n@.+-- 'Point' v) -> 'Transformation' v@. -- bubbleTransform- :: (InSpace v n a, HasScatterOptions f a (n, Point v n), Settable f)- => LensLike' f a (n -> Transformation v n)+ :: (InSpace v Double a, HasScatterOptions f a (Double, Point v Double), Settable f)+ => LensLike' f a (Double -> Transformation v Double) 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 n) v) (n -> 'Style' v n)+-- 'bubbleStyle' :: 'Setter'' ('Plot' ('BubbleOptions' v) v) (n -> 'Style' v) -- @ -- -- Note that this is the less general version of @'bubblePlot' . -- 'scatterTransform'@, which would give a 'LensLike' onto @(n,--- 'Point' v n) -> 'Style' v n@.+-- 'Point' v) -> 'Style' v@. ---bubbleStyle :: (InSpace v n a, Settable f, HasScatterOptions f a (n, Point v n))- => LensLike' f a (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 = bubbleOptions . scatterStyle . sets nOnly where nOnly f g (n,p) = f (\n' -> g (n', p)) n @@ -517,14 +533,14 @@ -- the 'scatterTransform' and 'scatterStyle'. gscatterPlot :: (BaseSpace c ~ v,- PointLike v n p,- MonadState (Axis b c n) m,- Plotable (ScatterPlot v n) b,+ PointLike v Double p,+ MonadState (Axis c) m, Typeable d,+ Plotable (ScatterPlot v), F.Foldable f) => f d -- ^ data -> (d -> p) -- ^ extract point from data- -> State (Plot (ScatterOptions v n d) b) ()+ -> State (Plot (ScatterOptions v d)) () -- ^ options for plot -> m () -- ^ add plot to 'Axis' gscatterPlot xs pf s = addPlot $ over rawPlot ScatterPlot p1@@ -535,7 +551,7 @@ -- | Helper to traverse over a general scatter plot where the type of d -- is not infered. gscatterOptionsFor- :: (InSpace v n a, HasScatterOptions f a d)- => proxy d -> LensLike' f a (ScatterOptions v n d)+ :: (InSpace v Double a, HasScatterOptions f a d)+ => proxy d -> LensLike' f a (ScatterOptions v d) gscatterOptionsFor _ = gscatterOptions