plot-light 0.3.3.2 → 0.4

raw patch · 8 files changed

+337/−203 lines, 8 filesdep +blaze-markupdep +exceptionsdep +histogram-filldep −data-default-classPVP ok

version bump matches the API change (PVP)

Dependencies added: blaze-markup, exceptions, histogram-fill, vector

Dependencies removed: data-default-class

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• plot-light.cabal +5/−2
• src/Graphics/Rendering/Plot/Light/Internal.hs +181/−111
• src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs +18/−10
• src/Graphics/Rendering/Plot/Light/Internal/Layout.hs +13/−9
• src/Graphics/Rendering/Plot/Light/PlotTypes/Histogram.hs +42/−2
• src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs +68/−66
• src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs +4/−3

@@ -1,3 +1,9 @@+	0.4++	Remove data-default-*+	Improve shape colour representation: shapes can have a colour fill, a coloured contour, or both (see 'ShapeCol').+	+ 	0.3.3  	Add Semigroup instances to everything that had Monoid instances (since from GHC 8.4.2 Semigroup m => Monoid m )

@@ -1,5 +1,5 @@ name:                plot-light-version:             0.3.3.2+version:             0.4 synopsis:            A lightweight plotting library, exporting to SVG description:         This library provides drawing and plotting datastructures and functions; it is aimed in particular at scientific visualization, but it also exposes its plotting primitives and a small but general purpose 2D geometry library.                      @@ -37,14 +37,17 @@                        Graphics.Rendering.Plot.Light.Internal.Utils                        Data.Parsers   build-depends:       base >= 4.7 && < 5+                     , blaze-markup >= 0.8.0.0                      , blaze-svg >= 0.3.6.1                      , colour >= 2.3.3                      , containers >= 0.5.7.1+                     , histogram-fill >= 0.8.5.0+                     , exceptions                      , mtl                      , scientific >= 0.3.5.1                      , text >= 1.2.2.2                      , time-                     , data-default-class >= 0.1.2.0+                     , vector                      -- -- * DEBUG                      -- , hspec                          -- , QuickCheck

@@ -1,6 +1,31 @@ {-# LANGUAGE OverloadedStrings, DeriveFunctor, DeriveGeneric #-} module Graphics.Rendering.Plot.Light.Internal-  (FigureData(..), Frame(..), mkFrame, mkFrameOrigin, frameToFrame, frameToFrameValue, frameFromPoints, frameFromFigData, xmin,xmax,ymin,ymax, width, height, figFWidth, figFHeight, Point(..), mkPoint, LabeledPoint(..), mkLabeledPoint, labelPoint, mapLabel, Axis(..), axes, meshGrid, subdivSegment, svgHeader, rect, rectCentered, squareCentered, circle, line, tick, ticks, axis, toPlot, text, pixel, pixel', pickColour, colourBar, legendBar, plusGlyph, crossGlyph, polyline, filledPolyline, filledBand, candlestick, strokeLineJoin, LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), LegendPosition_(..), V2(..), Mat2(..), DiagMat2(..), diagMat2, AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), norm2, normalize2, v2fromEndpoints, v2fromPoint, origin, (-.), pointRange, movePoint, moveLabeledPointV2, moveLabeledPointBwFrames, translateSvg, toSvgFrame, toSvgFrameLP, e1, e2, toFloat, wholeDecimal, blendTwo, palette, interpolateBilinear)+  (+  -- * Frame+    Frame(..), mkFrame, unitFrame, mkFrameOrigin, frameToFrame, frameToFrameValue, frameFromPoints, frameFromFigData, xmin,xmax,ymin,ymax, width, height,+    -- * FigureData+    FigureData(..), figFWidth, figFHeight+    -- * Point+  , Point(..), mkPoint, origin+    -- * LabeledPoint+  , LabeledPoint(..), mkLabeledPoint, labelPoint, mapLabel, Axis(..), axes, meshGrid, subdivSegment,+    -- * SVG elements+    svgHeader, rect, rectCentered, squareCentered, circle, line, tick, ticks, axis, toPlot, text, pixel, pixel', pickColour, colourBar, legendBar, plusGlyph, crossGlyph, polyline, filledPolyline, filledBand, candlestick, strokeLineJoin, LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), LegendPosition_(..)+    -- * Geometry+    -- ** R^2 Vectors+  , V2(..), e1, e2, norm2, normalize2, v2fromEndpoints, v2fromPoint, (-.), pointRange+    -- ** R^2 -> R^2 Matrices+  , Mat2(..), DiagMat2(..), diagMat2+    -- ** Typeclasses+  , AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), movePoint, moveLabeledPointV2, moveLabeledPointBwFrames, translateSvg, toSvgFrame, toSvgFrameLP, toFloat, wholeDecimal+  -- * Colours+  , blendTwo, palette+    -- ** Col+  , (!#), Col(..), ShapeCol(..), col, col50, col100, shapeColBoth+  , shapeColNoBorder, shapeColNoFill+    -- * General utility+    -- ** Function interpolation+  , interpolateBilinear)   where  import Data.Monoid ((<>))@@ -16,6 +41,7 @@ import qualified Data.Text as T -- import qualified Data.Vector as V +import Text.Blaze.Internal (Attributable(..)) import Text.Blaze.Svg import Text.Blaze.Svg11  ((!)) import qualified Text.Blaze.Svg11 as S hiding (style)@@ -29,7 +55,6 @@ import GHC.Real import GHC.Generics import Data.Fixed-import Data.Default.Class  import Graphics.Rendering.Plot.Light.Internal.Geometry import Graphics.Rendering.Plot.Light.Internal.Utils@@ -56,11 +81,12 @@   , figLabelFontSize :: Int                        } deriving (Eq, Show, Functor, Generic) -instance (Default a, Fractional a) => Default (FigureData a) where-  def = FigureData 400 300 0.1 0.9 0.1 0.9 10+figureDataDefault :: Floating a => FigureData a+figureDataDefault = FigureData 400 300 0.1 0.9 0.1 0.9 10   + -- | Create the SVG header svgHeader :: Real a =>      a   -- ^ Image width (X axis)@@ -76,35 +102,86 @@      fd = mkFrameOrigin w h  ++-- | A Col is both a 'Colour' and an alpha (opacity) coefficient+data Col a = Col {+    cColour :: C.Colour Double+  , cAlpha :: a } deriving (Eq, Show)++col :: C.Colour Double -> a -> Col a+col = Col++-- | Full opacity colour+col100 :: Num a => C.Colour Double -> Col a+col100 c = col c 1++-- | Half opacity colour+col50 :: Fractional a => C.Colour Double -> Col a+col50 c = col c 0.5++-- | A shape can either be only filled, or only contoured, or both+data ShapeCol a =+    NoBorderCol (Col a)  -- ^ Only fill colour+  | NoFillCol (Col a) a   -- ^ Only border colour + stroke width+  | BothCol (Col a) (Col a) a -- ^ Fill and border colours+  deriving (Eq, Show)++shapeColNoBorder :: C.Colour Double -> a -> ShapeCol a+shapeColNoBorder c a = NoBorderCol $ col c a++shapeColNoFill :: C.Colour Double -> a -> a -> ShapeCol a+shapeColNoFill c a = NoFillCol $ col c a ++shapeColBoth ::+     C.Colour Double  -- ^ Fill colour+  -> C.Colour Double  -- ^ Stroke colour+  -> a                -- ^ Opacity +  -> a                -- ^ Stroke width+  -> ShapeCol a+shapeColBoth cs cf a = BothCol (col cs a) (col cf a)++-- | Set the fill and stroke colour and opacity attributes all at once (e.g. if the fill is set to invisible, the stroke must be visible somehow.+(!#) :: (Attributable h, Real a) => h -> ShapeCol a -> h+m !# col = case col of+  NoBorderCol (Col c a) ->+    m ! SA.fillOpacity (vd a) ! SA.fill (colourAttr c) ! SA.stroke none+  NoFillCol (Col c a) sw  ->+    m ! SA.strokeOpacity (vd a) ! SA.stroke (colourAttr c) ! SA.strokeWidth (vd sw) ! SA.fill none+  BothCol (Col cf af) (Col cb ab) sw ->+    m ! SA.fillOpacity (vd af) ! SA.fill (colourAttr cf) ! SA.strokeOpacity (vd ab) ! SA.stroke (colourAttr cb) ! SA.strokeWidth (vd sw)++++none :: S.AttributeValue+none = S.toValue ("none" :: String)+++ -- | A rectangle, defined by its anchor point coordinates and side lengths ----- > > putStrLn $ renderSvg $ rect (Point 100 200) 30 60 2 Nothing (Just C.aquamarine)--- > <rect x="100.0" y="200.0" width="30.0" height="60.0" fill="#7fffd4" stroke="none" stroke-width="2.0" />-rect :: (Show a, RealFrac a) =>-     a                       -- ^ Width-  -> a                       -- ^ Height-  -> a                       -- ^ Stroke width-  -> Maybe (C.Colour Double) -- ^ Stroke colour-  -> Maybe (C.Colour Double) -- ^ Fill colour-  -> Point a                 -- ^ Corner point coordinates  -  -> Svg-rect wid hei sw scol fcol (Point x0 y0) = S.rect ! SA.x (vd x0) ! SA.y (vd y0) ! SA.width (vd wid) ! SA.height (vd hei) ! colourFillOpt fcol ! colourStrokeOpt scol ! SA.strokeWidth (vd sw)+-- > > putStrLn $ renderSvg $ rect 50 60 (shapeColNoBorder C.blue 0.5) (Point 100 30)+-- > <rect x="100.0" y="30.0" width="50.0" height="60.0" fill-opacity="0.5" fill="#0000ff" stroke="none" />+rect :: Real a =>+         a          -- ^ Width+      -> a          -- ^ Stroke width +      -> ShapeCol a -- ^ Colour and alpha information+      -> Point a    -- ^ Corner point coordinates+      -> Svg+rect wid hei col (Point x0 y0) = S.rect ! SA.x (vd x0) ! SA.y (vd y0) ! SA.width (vd wid) ! SA.height (vd hei) !# col   -- | A rectangle, defined by its center coordinates and side lengths ----- > > putStrLn $ renderSvg $ rectCentered 15 30 1 (Just C.blue) (Just C.red) (Point 20 30)--- > <rect x="12.5" y="15.0" width="15.0" height="30.0" fill="#ff0000" stroke="#0000ff" stroke-width="1.0" />+-- > > putStrLn $ renderSvg $ rectCentered 15 30 (Just C.blue) (Just C.red) (Point 20 30)+ rectCentered :: (Show a, RealFrac a) =>      a                       -- ^ Width   -> a                       -- ^ Height-  -> a                       -- ^ Stroke width-  -> Maybe (C.Colour Double) -- ^ Stroke colour-  -> Maybe (C.Colour Double) -- ^ Fill colour+  -> ShapeCol a              -- ^ Colour and alpha information   -> Point a                 -- ^ Center coordinates        -> Svg-rectCentered  wid hei sw scol fcol (Point x0 y0) =-  rect wid hei sw scol fcol p' where+rectCentered  wid hei col (Point x0 y0) =+  rect wid hei col p' where     p' = Point x0c y0c     x0c = x0 - (wid / 2)     y0c = y0 - (hei / 2)   @@ -114,24 +191,26 @@ squareCentered   :: (Show a, RealFrac a) =>      a                          -- ^ Side length-     -> a                       -- ^ Stroke width-     -> Maybe (C.Colour Double) -- ^ Stroke colour-     -> Maybe (C.Colour Double) -- ^ Fill colour+     -> ShapeCol a              -- ^ Colour and alpha information      -> Point a                 -- ^ Center coordinates      -> Svg squareCentered w = rectCentered w w +lineColourDefault :: C.Colour Double+lineColourDefault = C.blue -newtype Col = Col { unCol :: C.Colour Double} deriving (Eq, Show, Generic)-instance Default Col where-  def = Col C.blue+lineStrokeTypeDefault :: LineStroke_ a+lineStrokeTypeDefault = Continuous  data LineOptions a = LineOptions {     loStrokeWidth :: a            -- ^ Stroke width    , loStrokeType :: LineStroke_ a -- ^ Stroke type-  , loColour :: Col               -- ^ Stroke colour+  , loColour :: C.Colour Double   -- ^ Stroke colour                                  } deriving (Eq, Show, Generic) +lineOptionsDefault :: Num a => LineOptions a+lineOptionsDefault = LineOptions 2 lineStrokeTypeDefault lineColourDefault+ -- | Line options "picker". Creates an unbounded stream of LineOptions, may be useful when plotting multiple timeseries (essentially imitating the Matlab behaviour) lineOptionCycle :: Fractional a => a -> [LineOptions a] lineOptionCycle lw =@@ -140,7 +219,7 @@       replicate 5 Continuous <>       replicate 5 (Dashed [0.2, 0.5]) <>       replicate 5 (Dashed [0.5, 0.2])       -    cols = Col <$> [C.blue, C.green, C.red, C.black, C.purple]+    cols = [C.blue, C.green, C.red, C.black, C.purple]     nc = length cols   in   LineOptions <$>@@ -148,8 +227,6 @@   strTys <*>   cols -instance (Default a, Num a) => Default (LineOptions a) where-  def = LineOptions 2 def def   -- | Line segment between two `Point`s@@ -179,11 +256,10 @@  -- | Specify a continuous or dashed stroke data LineStroke_ a = Continuous | Dashed [a] deriving (Eq, Show, Generic)-instance Default (LineStroke_ a) where-  def = Continuous   + tick :: (Show a, RealFrac a) => Axis -> a -> a -> C.Colour Double -> Point a -> Svg tick ax len sw col (Point x y) = line (Point x1 y1) (Point x2 y2) sw Continuous col where   lh = len / 2@@ -192,16 +268,15 @@     | otherwise = (x-lh, y, x+lh, y)  -plusGlyph, crossGlyph-  :: (Show a, RealFrac a) =>-     a-     -> a-     -> C.Colour Double-     -> Point a-     -> Svg-plusGlyph w sw col (Point x y) = do-  line pl pr sw Continuous col-  line pt pb sw Continuous col+plusGlyph, crossGlyph :: (Show a, RealFrac a) =>+                         a               -- ^ Width+                      -> a               -- ^ Stroke width+                      -> C.Colour Double+                      -> Point a+                      -> Svg+plusGlyph w sw k (Point x y) = do+  line pl pr sw Continuous k+  line pt pb sw Continuous k   where     wh = w / 2     pl = Point (x-wh) y@@ -209,9 +284,9 @@     pt = Point x (y-wh)     pb = Point x (y+wh) -crossGlyph w sw col (Point x y) = do-  line pa pb sw Continuous col-  line pc pd sw Continuous col+crossGlyph w sw k (Point x y) = do+  line pa pb sw Continuous k+  line pc pd sw Continuous k   where     wh = 1.4142 * w     pa = Point (x+wh) (x+wh)@@ -253,6 +328,18 @@ ticks ax len sw col ps = forM_ ps (tick ax len sw col)  +labeledTicks :: (Foldable t, Show a, RealFrac a) =>+                Axis+             -> a+             -> a+             -> C.Colour Double+             -> Int+             -> a+             -> TextAnchor_+             -> (t2 -> T.Text)+             -> V2 a+             -> t (LabeledPoint t2 a)+             -> Svg labeledTicks ax len sw col fontsize lrot tanchor flab vlab ps =   forM_ ps (labeledTick ax len sw col fontsize lrot tanchor flab vlab) @@ -318,20 +405,19 @@ -- * Renders the X, Y axes -- -- * Renders the transformed dataset onto the newly created plot canvas-toPlot-  :: (Functor t, Foldable t, Show a, RealFrac a) =>-     FigureData a     -     -> (l -> T.Text)  -- ^ X tick label-     -> (l -> T.Text)  -- ^ Y tick label-     -> a   -- ^ X label rotation angle-     -> a -- ^ Y label rotation angle-     -> a -- ^ Stroke width-     -> C.Colour Double -- ^ Stroke colour-     -> Maybe (t (LabeledPoint l a))  -- ^ X axis labels-     -> Maybe (t (LabeledPoint l a))  -- ^ Y axis labels-     -> (t (LabeledPoint l a) -> Svg)  -- ^ Data rendering function-     -> t (LabeledPoint l a) -- ^ Data-     -> Svg +toPlot :: (Functor t, Foldable t, Show a, RealFrac a) =>+          FigureData a     +       -> (l -> T.Text)  -- ^ X tick label+       -> (l -> T.Text)  -- ^ Y tick label+       -> a   -- ^ X label rotation angle+       -> a -- ^ Y label rotation angle+       -> a -- ^ Stroke width+       -> C.Colour Double -- ^ Stroke colour+       -> Maybe (t (LabeledPoint l a))  -- ^ X axis labels+       -> Maybe (t (LabeledPoint l a))  -- ^ Y axis labels+       -> (t (LabeledPoint l a) -> Svg)  -- ^ Data rendering function+       -> t (LabeledPoint l a) -- ^ Data+       -> Svg  toPlot fd flabelx flabely rotx roty sw col1 tickxe tickye plotf dat = do   axis oSvg X (width to) sw col1 0.05 Continuous fontsize rotx TAEnd flabelx (V2 (-10) 0) tickx   axis oSvg Y (negate $ height to) sw col1 0.05 Continuous fontsize roty TAEnd flabely (V2 (-10) 0) ticky@@ -407,18 +493,16 @@  -- | A circle ----- > > putStrLn $ renderSvg $ circle (Point 20 30) 15 (Just C.blue) (Just C.red)--- > <circle cx="20.0" cy="30.0" r="15.0" fill="#ff0000" stroke="#0000ff" />+-- > > putStrLn $ renderSvg $ circle 15 (shapeColBoth C.red C.blue 1 5) (Point 10 20)+-- > <circle cx="10.0" cy="20.0" r="15.0" fill-opacity="1.0" fill="#ff0000" stroke-opacity="1.0" stroke="#0000ff" stroke-width="5.0" /> circle   :: (Real a1, Real a) =>         a                       -- ^ Radius-     -> a                       -- ^ Stroke width-     -> Maybe (C.Colour Double) -- ^ Stroke colour-     -> Maybe (C.Colour Double) -- ^ Fill colour+     -> ShapeCol a       -> Point a1                   -- ^ Center        -> Svg-circle  r sw scol fcol (Point x y) =-  S.circle ! SA.cx (vd x) ! SA.cy (vd y) ! SA.r (vd r) ! colourFillOpt fcol ! colourStrokeOpt scol ! SA.strokeWidth (vd sw) +circle r col (Point x y) =+  S.circle ! SA.cx (vd x) ! SA.cy (vd y) ! SA.r (vd r) !# col   @@ -441,18 +525,9 @@   in case strTy of Continuous -> svg0                    Dashed d -> svg0 ! strokeDashArray d -none :: S.AttributeValue-none = S.toValue ("none" :: String) -colourFillOpt :: Maybe (C.Colour Double) -> S.Attribute-colourFillOpt Nothing = SA.fill none-colourFillOpt (Just c) = SA.fill (colourAttr c) -colourStrokeOpt :: Maybe (C.Colour Double) -> S.Attribute-colourStrokeOpt Nothing = SA.stroke none-colourStrokeOpt (Just c) = SA.stroke (colourAttr c) - -- | A filled polyline -- -- > > putStrLn $ renderSvg $ filledPolyline C.coral 0.3 [(Point 0 1), (Point 10 40), Point 34 50, Point 30 5]@@ -497,14 +572,14 @@      -> (l -> a) -- ^ Line minimum value      -> a                       -- ^ Box width      -> a                       -- ^ Stroke width-     -> C.Colour Double         -- ^ First box colour-     -> C.Colour Double         -- ^ Second box colour+     -> ShapeCol a              -- ^ First box colour+     -> ShapeCol a              -- ^ Second box colour      -> C.Colour Double         -- ^ Line stroke colour      -> LabeledPoint l a        -- ^ Data point      -> Svg candlestick fdec fboxmin fboxmax fmin fmax wid sw col1 col2 colstroke lp = do   line pmin pmax sw Continuous colstroke-  rectCentered wid hei sw (Just colstroke) (Just col) p+  rectCentered wid hei col p     where     p = _lp lp     lab = _lplabel lp@@ -573,30 +648,31 @@   -pixel-  :: (Show a, RealFrac a) =>-     [C.Colour Double]-     -> a-     -> a-     -> Scientific-     -> Scientific-     -> LabeledPoint Scientific a-     -> Svg-pixel pal w h vmin vmax (LabeledPoint p l) = rect w h 0 Nothing (Just col) p where+pixel :: (Show a, RealFrac a) =>+         [C.Colour Double]         -- ^ Palette+      -> a                         -- ^ Width+      -> a                         -- ^ Height+      -> Scientific          +      -> Scientific+      -> LabeledPoint Scientific a+      -> Svg+pixel pal w h vmin vmax (LabeledPoint p l) = rect w h col p where   col = pickColour pal (toFloat vmin) (toFloat vmax) (toFloat l)  pixel'   :: (Show a, RealFrac a, RealFrac t) =>      [C.Colour Double] -> a -> a -> t -> t -> LabeledPoint t a -> Svg-pixel' pal w h vmin vmax (LabeledPoint p l) = rect w h 0 Nothing (Just col) p where+pixel' pal w h vmin vmax (LabeledPoint p l) = rect w h col p where   col = pickColour pal vmin vmax l    -pickColour :: RealFrac t => [C.Colour Double] -> t -> t -> t -> C.Colour Double-pickColour pal xmin xmax x = pal !! i+-- | Pick a colour from a list, assumed to be a palette mapped onto a compact numerical interval.+pickColour :: (RealFrac t, Num a) =>+        [C.Colour Double] -> t -> t -> t -> ShapeCol a+pickColour pal xmin xmax x = NoBorderCol $ Col (pal !! i) 1   where     i = floor (x01 * fromIntegral (nColors - 1))-    x01 = (x-xmin)/(xmax - xmin)+    x01 = (x - xmin) / (xmax - xmin)     nColors = length pal  @@ -629,17 +705,16 @@   legendBar (fromRational <$> fdat) w vmin vmax n legpos legh (colBarPx pal)  -legendBar-  :: (Monad m, Enum t, Fractional t, Fractional a) =>-     FigureData a-     -> a-     -> t-     -> t-     -> Int-     -> LegendPosition_-     -> a-     -> (FigureData a -> a -> a -> t -> t -> LabeledPoint t a -> m b)-     -> m ()+legendBar :: (Monad m, Enum t, Fractional t, Fractional a) =>+             FigureData a+          -> a+          -> t+          -> t+          -> Int+          -> LegendPosition_+          -> a+          -> (FigureData a -> a -> a -> t -> t -> LabeledPoint t a -> m b)+          -> m () legendBar fdat w vmin vmax n legpos legh fun = do   -- rect wrect hrect 1 (Just C.black) (Just C.white) prect   forM_ lps (fun fdat w h vmin vmax) where@@ -669,7 +744,7 @@      -> Svg colBarPx pal fdat w h vmin vmax (LabeledPoint p val) = do   text 0 (figLabelFontSize fdat) C.black TAStart (T.pack $ show (rr val :: Fixed E3)) (V2 (1.1*w) (0.5*h)) p-  rectCentered w h 0 Nothing (Just $ pickColour pal vmin vmax val) p+  rectCentered w h (pickColour pal vmin vmax val) p     @@ -683,11 +758,6 @@ -- | Render a Colour from `colour` into a `blaze` Attribute colourAttr :: C.Colour Double -> S.AttributeValue colourAttr = S.toValue . C.sRGB24show ----- **--   

@@ -11,7 +11,7 @@   -- ** LabeledPoint   LabeledPoint(..), mkLabeledPoint, labelPoint, mapLabel,   -- ** Frame-  Frame(..), mkFrame, frameFromPoints,  mkFrameOrigin, height, width, xmin, xmax, ymin, ymax, +  Frame(..), mkFrame, unitFrame, frameFromPoints,  mkFrameOrigin, height, width, xmin, xmax, ymin, ymax, isPointInFrame,   -- ** Axis   Axis(..), otherAxis,   -- ** Vectors@@ -37,16 +37,18 @@  -- import Data.Monoid ((<>)) +import Control.Exception+import Control.Monad.Catch (MonadThrow(..), throwM) import GHC.Generics-import Data.Default.Class+ import Data.Semigroup (Semigroup(..))   -- | A `Point` object defines a point in the plane data Point a = Point { _px :: a,                        _py :: a } deriving (Eq, Generic)-instance Default a => Default (Point a) where + instance Ord a => Ord (Point a) where   (Point x1 y1) <= (Point x2 y2) = x1 <= x2 && y1 <= y2 @@ -121,9 +123,6 @@    _fpmax :: Point a    } deriving (Eq, Show, Generic) -instance (Default a, Num a) => Default (Frame a) where-  def = unitFrame- -- | The semigroup operation (`mappend`) applied on two `Frames` results in a new `Frame` that bounds both.  instance (Ord a) => Semigroup (Frame a) where@@ -133,6 +132,8 @@   mempty = Frame (Point 0 0) (Point 0 0)   mappend = (<>) +isPointInFrame :: Ord a => Frame a -> Point a -> Bool+isPointInFrame (Frame p1 p2) p = p >= p1 && p <= p2  mkFrame :: Point a -> Point a -> Frame a mkFrame = Frame@@ -184,8 +185,16 @@  -- | Interpolation -interpolateBilinear :: Fractional a => Frame a -> Point a -> (Point a -> a) -> a-interpolateBilinear (Frame q11@(Point x1 y1) q22@(Point x2 y2)) (Point x y) f =+-- | Safe+interpolateBilinear  :: (Ord p, Fractional p, Show p) =>+     Frame p -> (Point p -> p) -> Point p -> p+interpolateBilinear fr@(Frame p1 p2) f p+  | isPointInFrame fr p = interpolateBilinear' p1 p2 f p+  | otherwise = error $ unwords ["Point", show p, "is outside frame", show fr]++-- | Unsafe+interpolateBilinear' :: Fractional a => Point a -> Point a -> (Point a -> a) -> Point a -> a+interpolateBilinear' q11@(Point x1 y1) q22@(Point x2 y2) f (Point x y) =   let     q12 = Point x1 y2     q21 = Point x2 y1@@ -415,8 +424,7 @@  data MeshGrid a = MeshGrid (Frame a) Int Int deriving (Eq, Show, Generic) -instance (Default a, Num a) => Default (MeshGrid a) where-  +-- meshGridDefault = MeshGrid     subdivSegment :: (Real a, Enum b, RealFrac b) => a -> a -> Int -> [b]

@@ -91,15 +91,19 @@   -liftF :: Functor f => f r -> Free f r-liftF x = Free (fmap Pure x) -data Free f r = Free (f (Free f r)) | Pure r deriving Functor+-- * Free -instance Functor f => Applicative (Free f) where-  pure = Pure -instance (Functor f) => Monad (Free f) where-    return = pure-    (Free x) >>= f = Free (fmap (>>= f) x)-    (Pure r) >>= f = f r+-- liftF :: Functor f => f r -> Free f r+-- liftF x = Free (fmap Pure x)++-- data Free f r = Free (f (Free f r)) | Pure r deriving Functor++-- instance Functor f => Applicative (Free f) where+--   pure = Pure++-- instance (Functor f) => Monad (Free f) where+--     return = pure+--     (Free x) >>= f = Free (fmap (>>= f) x)+--     (Pure r) >>= f = f r

@@ -1,12 +1,52 @@+{-# language FlexibleContexts #-} module Graphics.Rendering.Plot.Light.PlotTypes.Histogram where  import Graphics.Rendering.Plot.Light.Internal  import Control.Monad (forM_)-import Text.Blaze.Svg+-- import Text.Blaze.Svg import qualified Data.Colour as C -- import qualified Data.Colour.Palette.BrewerSet as CP import qualified Data.Colour.Names as C +import qualified Data.Histogram as H (Histogram(..), Bin(..), bins, asList)+import qualified Data.Histogram.Bin as H (BinD(..), binD, BinI(..), binI, binSize, UniformBin(..))+import qualified Data.Histogram.Fill as H (mkSimple, mkWeighted, fillBuilder, HBuilder(..)) -histogram figdata = undefined +import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Generic as VG++-- histogram figdata =+  + ++++histogram col h = undefined where+  (binCenters, binCounts) = unzip $ H.asList h+  binXOffset = - head binCenters + 0.5 * binSize+  binSize = H.binSize $ H.bins h+  -- hcol = case col of+  --   NoBorderCol c a ++++-- | Uniform, un-weighted bins+histo :: (Foldable v, VU.Unbox a, Num a) =>+         Int+      -> v Double+      -> H.Histogram H.BinD a+histo n v = histo'' bins v where+  mi = minimum v+  ma = maximum v + 1+  bins = H.binD mi n ma+++histo'' :: (Foldable f, H.Bin bin, VU.Unbox val, Num val) =>+           bin+        -> f (H.BinValue bin)+        -> H.Histogram bin val+histo'' bins v = H.fillBuilder buildr v+  where+    buildr = H.mkSimple bins

@@ -16,16 +16,12 @@ -- | Scatter plot -- -- Every point in the plot has the same parameters, as declared in the `ScatterPointData` record-scatter-  :: (Foldable t, Show a, RealFrac a) =>-     ScatterPointData a-     -> t (Point a)-     -> Svg-scatter (ScatterPointData glshape w sw fcol) ps = -  forM_ ps $ glyph w sw glshape Nothing (Just fcol)---+scatter :: (Foldable t, Show a, RealFrac a) =>+           ScatterPointData a+        -> t (Point a)+        -> Svg+scatter (ScatterPointData glshape w sw fcol alpha) ps = +  forM_ ps $ glyph w sw glshape fcol alpha   -- | Parametric scatter plot@@ -33,50 +29,50 @@ -- The parameters of every point in the scatter plot are modulated according to the label, using the three functions. -- -- This can be used to produce rich infographics, in which e.g. the colour and size of the glyphs carry additional information.-scatterLP-  :: (Foldable t, RealFrac a, Show a) =>-     (l -> b -> a)            -- ^ Modifies the glyph size-     -> (l -> b -> a)         -- ^ Modifies the glyph stroke width-     -> (l -> C.Colour Double -> C.Colour Double)  -- ^ Modifies the glyph colour     -     -> ScatterPointData b    -- ^ Glyph style defaults-     -> t (LabeledPoint l a) -- ^ Data-     -> Svg-scatterLP f g h spdat lps = forM_ lps (scatterLP1 f g h spdat)+scatterLP :: (Foldable t, RealFrac a, Show a) =>+             (l -> b -> a)            -- ^ Modifies the glyph size+          -> (l -> b -> a)         -- ^ Modifies the glyph stroke width+          -> (l -> C.Colour Double -> C.Colour Double)  -- ^ Modifies the glyph colour+          -> (l -> b -> a)+          -> ScatterPointData b    -- ^ Glyph style defaults+          -> t (LabeledPoint l a) -- ^ Data+          -> Svg+scatterLP f g h i spdat lps = forM_ lps (scatterLP1 f g h i spdat)  -scatterLP1-  :: (Show a, RealFrac a) =>-     (l -> b -> a)            -- ^ Modifies the glyph size-     -> (l -> b -> a)         -- ^ Modifies the glyph stroke width-     -> (l -> C.Colour Double -> C.Colour Double)  -- ^ Modifies the glyph colour-     -> ScatterPointData b   -     -> LabeledPoint l a-     -> Svg-scatterLP1 f g h spdat lp = glyph w' sw' sh Nothing (Just col') (_lp lp)+scatterLP1 :: (Show a, RealFrac a) =>+              (l -> b -> a)            -- ^ Modifies the glyph size+           -> (l -> b -> a)         -- ^ Modifies the glyph stroke width+           -> (l -> C.Colour Double -> C.Colour Double)  -- ^ Modifies the glyph colour+           -> (l -> b -> a)        -- ^ Modifies the glyph opacity+           -> ScatterPointData b   +           -> LabeledPoint l a+           -> Svg+scatterLP1 f g h i spdat lp = glyph w' sw' sh col' a' (_lp lp)  where-    ScatterPointData sh w' sw' col' = modifyScatterPoint f g h spdat lp+    ScatterPointData sh w' sw' col' a' = modifyScatterPoint f g h i spdat lp   -scatterLPBar-  :: (RealFrac t, Enum t, RealFrac b, Show b) =>-     FigureData b-     -> b                 -- ^ Legend width-     -> t                 -- ^ Data value lower bound-     -> t                 -- ^ Data value upper bound-     -> Int               -- ^ Number of legend entries-     -> LegendPosition_   -- ^ Legend position in the figure-     -> b                 -- ^ Legend length-     -> (t -> b -> b)     -- ^ Modifies the glyph size-     -> (t -> b -> b)     -- ^ Modifies the glyph stroke width-     -> (t -> C.Colour Double -> C.Colour Double) -- ^ Modifies the glyph colour-     -> ScatterPointData b    -- ^ Glyph style defaults-     -> Svg-scatterLPBar fdat w vmin vmax n legpos legh f g h spdat = legendBar fdat w vmin vmax n legpos legh fun where+scatterLPBar :: (RealFrac t, Enum t, RealFrac b, Show b) =>+                FigureData b+             -> b                 -- ^ Legend width+             -> t                 -- ^ Data value lower bound+             -> t                 -- ^ Data value upper bound+             -> Int               -- ^ Number of legend entries+             -> LegendPosition_   -- ^ Legend position in the figure+             -> b                 -- ^ Legend length+             -> (t -> b -> b)     -- ^ Modifies the glyph size+             -> (t -> b -> b)     -- ^ Modifies the glyph stroke width+             -> (t -> C.Colour Double -> C.Colour Double) -- ^ Modifies the glyph colour+             -> (t -> b -> b)     -- ^ Modifies the glyph opacity+             -> ScatterPointData b    -- ^ Glyph style defaults+             -> Svg+scatterLPBar fdat w vmin vmax n legpos legh f g h i spdat = legendBar fdat w vmin vmax n legpos legh fun where   wglyph = spSize spdat   fun _ _ _ _ _ lp@(LabeledPoint p val) = do-    scatterLP1 f g h spdat lp-    text 0 (figLabelFontSize fdat) C.black TAStart (T.pack $ show (rr val :: Fixed E3))   (V2 (2*wglyph) (0.5*wglyph)) p+    scatterLP1 f g h i spdat lp+    text 0 (figLabelFontSize fdat) C.black TAStart (T.pack $ show (rr val :: Fixed E3))   (V2 (2 * wglyph) (0.5 * wglyph)) p     @@ -88,18 +84,20 @@   , spSize :: a   , spStrokeWidth :: a   , spColour :: C.Colour Double+  , spAlpha :: a   } deriving (Eq, Show)  -modifyScatterPoint-  :: (a -> b -> c)-     -> (a -> b -> c)-     -> (a -> C.Colour Double -> C.Colour Double)+modifyScatterPoint ::+        (l -> b -> c)                             -- ^ Modifies glyph size+     -> (l -> b -> c)                             -- ^ Modifies glyph stroke width+     -> (l -> C.Colour Double -> C.Colour Double) -- ^ Modifies glyph colour+     -> (l -> b -> c)                             -- ^ Modifies glyph opacity      -> ScatterPointData b-     -> LabeledPoint a d+     -> LabeledPoint l d      -> ScatterPointData c-modifyScatterPoint f g h (ScatterPointData glsh sz w col) lp =-  ScatterPointData glsh (f lab sz) (g lab w) (h lab col)+modifyScatterPoint f g h i (ScatterPointData glsh sz w col alpha) lp =+  ScatterPointData glsh (f lab sz) (g lab w) (h lab col) (i lab alpha)   where     lab = _lplabel lp @@ -108,19 +106,23 @@ data GlyphShape_ = Square | Circle | Cross | Plus deriving (Eq, Show, Enum)  -- | Scatterplot glyph shapes-glyph-  :: (Show a, RealFrac a) =>-     a-     -> a-     -> GlyphShape_-     -> Maybe (C.Colour Double)-     -> Maybe (C.Colour Double)-     -> Point a-     -> Svg-glyph w sw Square scol fcol p = squareCentered w sw scol fcol p-glyph w sw Circle scol fcol p = circle w sw scol fcol p-glyph w sw Cross _ fcol p = crossGlyph w sw (fromMaybe C.black fcol) p-glyph w sw Plus _ fcol p = plusGlyph w sw (fromMaybe C.black fcol) p+glyph :: (Show a, RealFrac a) =>+         a               -- ^ Width+      -> a               -- ^ Stroke width+      -> GlyphShape_     -- ^ Glyph shape+      -> C.Colour Double -- ^ Glyph colour+      -> a               -- ^ Opacity+      -> Point a         -- ^ Position+      -> Svg+glyph w sw sh col alpha p =+  let cf = shapeColNoBorder col alpha+  in +    case sh of+      Square -> squareCentered w cf p+      Circle -> circle w cf p+      Cross -> crossGlyph w sw col p+      Plus -> plusGlyph w sw col p+           -- -- | Utility function for cycling glyph colours and shapes (i.e. unique combinations of these make it easy to tell different datasets apart)

@@ -30,8 +30,7 @@ -- 2. Flip the data along the y axis since the origin in SVG is the top-left corner of the screen  -    -    +   -- tsAxis --   :: (Functor t, Foldable t, Show a, RealFrac a) => --      FigureData a@@ -68,7 +67,9 @@     fdat = frameToFrameValue from to     baz = const (T.pack "")     fplot lps =-      forM_ lps (candlestick (>) fboxmin' fboxmax' fmin' fmax' 5 1 C.green C.red colAxis)+      forM_ lps (candlestick (>) fboxmin' fboxmax' fmin' fmax' 5 1 colUp colDown colAxis)+    colUp = shapeColBoth C.green colAxis 1 sw+    colDown = shapeColBoth C.red colAxis 1 sw     fboxmin' = fdat . fboxmin     fboxmax' = fdat . fboxmax     fmin' = fdat . fmin