diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -23,11 +23,9 @@ Available on Hackage : https://hackage.haskell.org/package/plot-light in the `Graphics.Rendering.Plot.Light` module -Please let me know if documentation is lacking or confusing. - ## Contributing -You can use `plot-light` in your own projects (either personal, academic or commercial), and all feedback such as comments, bug reports, feature requests and patches is welcome. +You can use `plot-light` in your own projects (either personal, academic or commercial). All feedback such as comments, bug reports, new documentation, feature requests and patches is welcome. ## License diff --git a/plot-light.cabal b/plot-light.cabal --- a/plot-light.cabal +++ b/plot-light.cabal @@ -1,5 +1,5 @@ name: plot-light -version: 0.1.0.9 +version: 0.1.1 synopsis: A lightweight plotting library, exporting to SVG description: A lightweight plotting library, exporting to SVG homepage: https://github.com/ocramz/plot-light diff --git a/src/Graphics/Rendering/Plot/Light.hs b/src/Graphics/Rendering/Plot/Light.hs --- a/src/Graphics/Rendering/Plot/Light.hs +++ b/src/Graphics/Rendering/Plot/Light.hs @@ -20,8 +20,13 @@ -- @import qualified Data.Colour.Names as C@ module Graphics.Rendering.Plot.Light ( - -- * Graphical elements - rectCentered, circle, line, axis, text, polyline, + -- * Plot elements + -- ** Geometrical primitives + rectCentered, circle, line, text, polyline, filledPolyline, + -- ** Composite plot elements + filledBand, candlestick, + -- ** Plot utilities + toPlot, FigureData(..), -- ** Element attributes LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), -- ** SVG utilities @@ -40,9 +45,11 @@ -- ** Vector construction v2fromEndpoints, v2fromPoint, -- ** Operations on points - movePoint, moveLabeledPointV2, (-.), + movePoint, moveLabeledPointV2, (-.), toSvgFrame, toSvgFrameLP, pointRange, -- ** Operations on vectors - frameToFrame, + frameToFrame, + -- ** Operations on frames + frameFromPoints, mkFrame, mkFrameOrigin, width, height, -- ** Typeclasses AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..) ) where diff --git a/src/Graphics/Rendering/Plot/Light/Internal.hs b/src/Graphics/Rendering/Plot/Light/Internal.hs --- a/src/Graphics/Rendering/Plot/Light/Internal.hs +++ b/src/Graphics/Rendering/Plot/Light/Internal.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Graphics.Rendering.Plot.Light.Internal (Frame(..), mkFrame, mkFrameOrigin, frameToFrame, frameFromDataset, Point(..), mkPoint, LabeledPoint(..), mkLabeledPoint, Axis(..), svgHeader, rectCentered, circle, line, tick, ticks, axis, text, polyline, strokeLineJoin, LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), V2(..), Mat2(..), DiagMat2(..), diagMat2, AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), norm2, normalize2, v2fromEndpoints, v2fromPoint, origin, (-.), movePoint, moveLabeledPointV2, moveLabeledPointV2Frames, e1, e2) where +module Graphics.Rendering.Plot.Light.Internal (FigureData(..), Frame(..), mkFrame, mkFrameOrigin, frameToFrame, frameFromPoints, width, height, Point(..), mkPoint, LabeledPoint(..), mkLabeledPoint, Axis(..), svgHeader, rectCentered, circle, line, tick, ticks, axis, toPlot, text, polyline, filledPolyline, filledBand, candlestick, strokeLineJoin, LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), V2(..), Mat2(..), DiagMat2(..), diagMat2, AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), norm2, normalize2, v2fromEndpoints, v2fromPoint, origin, (-.), pointRange, movePoint, moveLabeledPointV2, moveLabeledPointV2Frames, toSvgFrame, toSvgFrameLP, e1, e2) where import Data.Monoid ((<>)) import qualified Data.Foldable as F (toList) @@ -28,7 +28,26 @@ import Graphics.Rendering.Plot.Light.Internal.Geometry +-- | Figure data +data FigureData a = FigureData { + -- | Figure width + figWidth :: a + -- | Figure height + , figHeight :: a + -- | Left margin fraction (w.r.t figure width) + , figLeftMFrac :: a + -- | Right margin fraction (w.r.t figure width) + , figRightMFrac :: a + -- | Top margin fraction (w.r.t figure height) + , figTopMFrac :: a + -- | Bottom margin fraction (w.r.t figure height) + , figBottomMFrac :: a + -- | Tick label font size + , figLabelFontSize :: Int + } deriving (Eq, Show) + + -- | Create the SVG header from a `Frame` svgHeader :: Real a => Frame a -> Svg -> Svg svgHeader fd = @@ -48,11 +67,12 @@ Point a -- ^ Center coordinates -> a -- ^ Width -> a -- ^ Height + -> a -- ^ Stroke width -> Maybe (C.Colour Double) -- ^ Stroke colour -> Maybe (C.Colour Double) -- ^ Fill colour -> Svg -rectCentered (Point x0 y0) wid hei scol fcol = S.g ! SA.transform (S.translate x0c y0c) $ - S.rect ! SA.width (vd wid) ! SA.height (vd hei) ! colourFillOpt fcol ! colourStrokeOpt scol where +rectCentered (Point x0 y0) wid hei sw scol fcol = S.g ! SA.transform (S.translate x0c y0c) $ + S.rect ! SA.width (vd wid) ! SA.height (vd hei) ! colourFillOpt fcol ! colourStrokeOpt scol ! SA.strokeWidth (vd sw) where x0c = x0 - (wid / 2) y0c = y0 - (hei / 2) @@ -152,6 +172,49 @@ | otherwise = setPointX ox + +-- | `toPlot` performs a number of related operations: +-- +-- * Maps the dataset to the figure frame +-- +-- * 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 + -> (t (LabeledPoint l a) -> t (LabeledPoint l a)) -- ^ X axis labels + -> (t (LabeledPoint l a) -> 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 tickXf tickYf plotf dat = do + axis oSvg X (right - left) sw col1 0.05 Continuous fontsize rotx TAEnd flabelx (V2 (-10) 0) (tickXf dat') + axis oSvg Y (top - bot) sw col1 0.05 Continuous fontsize roty TAEnd flabely (V2 (-10) 0) (tickYf dat') + plotf dat' + where + fontsize = figLabelFontSize fd + wfig = figWidth fd + hfig = figHeight fd + (left, right) = (figLeftMFrac fd * wfig, figRightMFrac fd * wfig) + (top, bot) = (figTopMFrac fd * hfig, figBottomMFrac fd * hfig) + oTo = Point left top + p2To = Point right bot + from = frameFromPoints $ _lp <$> dat + to = mkFrame oTo p2To + dat' = toSvgFrameLP from to False <$> dat + oSvg = Point left bot + + + + + -- * text -- | `text` renders text onto the SVG canvas @@ -196,11 +259,12 @@ :: (Real a1, Real a) => Point a1 -- ^ Center -> a -- ^ Radius + -> a -- ^ Stroke width -> Maybe (C.Colour Double) -- ^ Stroke colour -> Maybe (C.Colour Double) -- ^ Fill colour -> Svg -circle (Point x y) r scol fcol = - S.circle ! SA.cx (vd x) ! SA.cy (vd y) ! SA.r (vd r) ! colourFillOpt fcol ! colourStrokeOpt scol +circle (Point x y) r sw scol fcol = + S.circle ! SA.cx (vd x) ! SA.cy (vd y) ! SA.r (vd r) ! colourFillOpt fcol ! colourStrokeOpt scol ! SA.strokeWidth (vd sw) @@ -232,6 +296,70 @@ 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] +-- > +filledPolyline :: (Foldable t, Show a, Real o) => + C.Colour Double -- ^ Fill colour + -> o -- ^ Fill opacity + -> t (Point a) -- ^ Contour point coordinates + -> Svg +filledPolyline col opac lis = S.polyline ! SA.points (S.toValue $ unwords $ map show $ F.toList lis) ! SA.fill (colourAttr col) ! SA.fillOpacity (vd opac) + + +-- | A filled band of colour, given the coordinates of its center line +-- +-- This element can be used to overlay uncertainty ranges (e.g. the first standard deviation) associated with a given data series. +filledBand :: (Foldable t, Real o, Show a) => + C.Colour Double -- ^ Fill colour + -> o -- ^ Fill opacity + -> (LabeledPoint l a -> a) -- ^ Band maximum value + -> (LabeledPoint l a -> a) -- ^ Band minimum value + -> t (LabeledPoint l a) -- ^ Centerline points + -> Svg +filledBand col opac ftop fbot lis0 = filledPolyline col opac (lis1 <> lis2) where + lis = F.toList lis0 + f1 lp = setPointY (ftop lp) $ _lp lp + f2 lp = setPointY (fbot lp) $ _lp lp + lis1 = f1 <$> lis + lis2 = f2 <$> reverse lis + + +-- | A `candlestick` glyph for time series plots. This is a type of box glyph, commonly used in plotting financial time series. +-- +-- Some financial market quantities such as currency exchange rates are aggregated over some time period (e.g. a day) and summarized by various quantities, for example opening and closing rates, as well as maximum and minimum over the period. +-- +-- By convention, the `candlestick` colour depends on the derivative sign of one such quantity (e.g. it is green if the market closes higher than it opened, and red otherwise). +candlestick + :: (Show a, RealFrac a) => + (LabeledPoint l a -> Bool) -- ^ If True, fill the box with the first colour, otherwise with the second + -> (LabeledPoint l a -> a) -- ^ Box maximum value + -> (LabeledPoint l a -> a) -- ^ Box minimum value + -> (LabeledPoint l a -> a) -- ^ Line maximum value + -> (LabeledPoint l a -> a) -- ^ Line minimum value + -> a -- ^ Box width + -> a -- ^ Stroke width + -> C.Colour Double -- ^ First box colour + -> C.Colour Double -- ^ 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 p wid hei sw (Just colstroke) (Just col) + where + p = _lp lp + pmin = setPointY (fmin lp) p + pmax = setPointY (fmax lp) p + hei = fboxmax lp - fboxmin lp + col | fdec lp = col1 + | otherwise = col2 + + + + + -- | Specify the type of connection between line segments data StrokeLineJoin_ = Miter | Round | Bevel | Inherit deriving (Eq, Show) @@ -241,6 +369,24 @@ | slj == Round = "round" | slj == Bevel = "bevel" | otherwise = "inherit" + + +-- | Move point to the SVG frame of reference (for which the origing is a the top-left corner of the screen) +toSvgFrame :: + Fractional a => + Frame a -- ^ Initial frame + -> Frame a -- ^ Final frame + -> Bool -- ^ Flip L-R in [0,1] x [0,1] + -> Point a -- ^ Point in the initial frame + -> Point a +toSvgFrame from to fliplr p = pointFromV2 v' where + v' = frameToFrame from to fliplr True (v2fromPoint p) + + +-- | Move LabeledPoint to the SVG frame of reference (uses `toSvgFrame` ) +toSvgFrameLP :: + Fractional a => Frame a -> Frame a -> Bool -> LabeledPoint l a -> LabeledPoint l a +toSvgFrameLP from to fliplr (LabeledPoint p lab) = LabeledPoint (toSvgFrame from to fliplr p) lab diff --git a/src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs b/src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs --- a/src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs +++ b/src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs @@ -56,22 +56,24 @@ mkFrameOrigin w h = Frame origin (Point w h) --- | Create a `Frame` from a container of `LabeledPoint`s `P`, i.e. construct two points `p1` and `p2` such that : +-- | Create a `Frame` from a container of `Point`s `P`, i.e. construct two points `p1` and `p2` such that : -- -- p1 := inf(x,y) P -- p2 := sup(x,y) P -frameFromDataset :: - (Functor t, Ord a, Foldable t) => t (LabeledPoint l a) -> Frame a -frameFromDataset ds = mkFrame (Point mx my) (Point mmx mmy) +frameFromPoints :: (Ord a, Foldable t, Functor t) => + t (Point a) -> Frame a +frameFromPoints ds = mkFrame (Point mx my) (Point mmx mmy) where - xcoord = _px . _lp <$> ds - ycoord = _py . _lp <$> ds + xcoord = _px <$> ds + ycoord = _py <$> ds mmx = maximum xcoord mmy = maximum ycoord mx = minimum xcoord my = minimum ycoord - + + + -- | Frame corner coordinates xmin, xmax, ymin, ymax :: Frame a -> a xmin = _px . _fpmin @@ -209,6 +211,12 @@ diagMat2 :: Num a => a -> a -> DiagMat2 a diagMat2 = DMat2 + +-- | Rotation matrix +rotMtx :: Floating a => a -> Mat2 a +rotMtx r = Mat2 (cos r) (- (sin r)) (sin r) (cos r) + + -- | The class of invertible linear transformations class LinearMap m v => MatrixGroup m v where -- | Inverse matrix action on a vector @@ -224,10 +232,14 @@ instance Fractional a => MatrixGroup (DiagMat2 a) (V2 a) where DMat2 d1 d2 <\> V2 vx vy = V2 (vx / d1) (vy / d2) --- | Build a V2 from a `Point` p (i.e. assuming the V2 points from the origin (0,0) to p) +-- | Build a `V2` v from a `Point` p (i.e. assuming v points from the origin (0,0) to p) v2fromPoint :: Num a => Point a -> V2 a v2fromPoint p = origin -. p +-- | Build a `Point` p from a `V2` v (i.e. assuming v points from the origin (0,0) to p) +pointFromV2 :: V2 a -> Point a +pointFromV2 (V2 x y) = Point x y + -- | Move a point along a vector movePoint :: Num a => V2 a -> Point a -> Point a movePoint (V2 vx vy) (Point px py) = Point (px + vx) (py + vy) @@ -237,8 +249,18 @@ moveLabeledPointV2 = moveLabeledPoint . movePoint +-- | `pointRange n p q` returns a list of `n+1` equi-spaced `Point`s between `p` and `q` (i.e. the input points are included as the first and last points in the list) +pointRange :: (Fractional a, Integral n) => + n -> Point a -> Point a -> [Point a] +pointRange n p q = [ movePoint (fromIntegral x .* vnth) p | x <- [0 .. n]] + where + v = p -. q + vnth = (1/fromIntegral n) .* v + + + fromFrame :: Fractional a => Frame a -> V2 a -> V2 a fromFrame from v = mfrom <\> (v ^-^ vfrom) where vfrom = v2fromPoint (_fpmin from) -- min.point vector of `from` @@ -252,39 +274,53 @@ --- | Given two frames `F1` and `F2`, returns a function `f` that maps an arbitrary vector `v` that points within `F1` to one contained within `F2`. +-- | Given two frames `F1` and `F2`, returns a function `f` that maps an arbitrary vector `v` contained within `F1` onto one contained within `F2`. -- --- 1. map `v` into a unit square vector `v01` with an affine transformation +-- This function is composed of three affine maps : -- --- 2. (optional) map `v01` into another point in the unit square via a linear rescaling +-- 1. map `v` into a vector `v01` that points within the unit square, -- --- 3. map `v01'` onto `F2` with a second affine transformation +-- 2. map `v01` onto `v01'`. This transformation serves to e.g. flip the dataset along the y axis (since the origin of the SVG canvas is the top-left corner of the screen). If this is not needed one can just supply the identity matrix and the zero vector, -- --- NB: we do not check that `v` is actually contained within the `F1`. This has to be supplied correctly by the user. -frameToFrame :: (Fractional a, LinearMap m (V2 a)) => +-- 3. map `v01'` onto the target frame `F2`. +-- +-- NB: we do not check that `v` is actually contained within the `F1`, nor that `v01'` is still contained within [0,1] x [0, 1]. This has to be supplied correctly by the user. +frameToFrame :: Fractional a => Frame a -- ^ Initial frame -> Frame a -- ^ Final frame - -> m -- ^ Optional rescaling in [0,1] x [0,1] - -> V2 a -- ^ Optional shift + -> Bool -- ^ Flip L-R in [0,1] x [0,1] + -> Bool -- ^ Flip U-D in [0,1] x [0,1] -> V2 a -- ^ Initial vector -> V2 a -frameToFrame from to mopt vopt v = toFrame to v01' +frameToFrame from to fliplr flipud v = toFrame to v01' where v01 = fromFrame from v - v01' = (mopt #> v01) ^+^ vopt + v01' | fliplr && flipud = flipLR01 (flipUD01 v01) + | fliplr = flipLR01 v01 + | flipud = flipUD01 v01 + | otherwise = v01 + +flipLR01, flipUD01 :: Num a => V2 a -> V2 a +flipLR01 (V2 a b) = V2 (1 - a) b +flipUD01 (V2 a b) = V2 a (1 - b) + + + + moveLabeledPointV2Frames :: - (LinearMap m (V2 a), Fractional a) => + Fractional a => Frame a -- ^ Initial frame -> Frame a -- ^ Final frame - -> m -- ^ Optional rescaling in [0,1] x [0,1] - -> V2 a -- ^ Optional shift + -> Bool -- ^ Flip L-R in [0,1] x [0,1] + -> Bool -- ^ Flip U-D in [0,1] x [0,1] -> LabeledPoint l a -- ^ Initial `LabeledPoint` -> LabeledPoint l a -moveLabeledPointV2Frames from to mopt vopt lp = moveLabeledPointV2 vmove lp +moveLabeledPointV2Frames from to fliplr flipud lp = LabeledPoint p' (_lplabel lp) where vlp = v2fromPoint $ _lp lp -- vector associated with starting point - vmove = frameToFrame from to mopt vopt vlp -- frame translation vector + vlp' = frameToFrame from to fliplr flipud vlp -- vector associated w new point + p' = pointFromV2 vlp' diff --git a/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs b/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs --- a/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs +++ b/src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs @@ -11,6 +11,7 @@ import Graphics.Rendering.Plot.Light.Internal import Data.TimeSeries +import Data.TimeSeries.Forex -- For debugging import Text.Blaze.Svg @@ -25,33 +26,52 @@ -- 1. Remap the figure data to fit within the FigData ranges, expressed in pixels -- 2. Flip the data along the y axis since the origin in SVG is the top-left corner of the screen --- tsAxis :: (Num a, LinearMap (DiagMat2 a) (V2 a), RealFrac a, Show a, --- Foldable t, Functor t) => --- (a -> a) --- -> a --- -> a --- -> a --- -> C.Colour Double --- -> a --- -> t (TsPoint a) --- -> Svg -tsAxis fval wFig hFig sw col rot ps = dat' -- axis origin X wFig sw col 0.01 Continuous rot TAEnd T.pack (V2 (-10) 0) dat' +tsAxis fval wfig hfig sw col1 col2 rot ps = do + axis oSvg X (right - left) sw col1 0.01 Continuous 10 rot TAEnd (T.pack . fst) (V2 (-10) 0) dat' + axis oSvg Y (top - bot) sw col1 0.01 Continuous 10 0 TAEnd (T.pack . snd) (V2 (-10) 0) dat' + polyline (_lp <$> dat') sw Continuous Round col2 where - lpFun = tspToLP fval (\t _ -> show t) - dat = lpFun <$> ps - frameFrom = frameFromDataset dat - frameTo = mkFrameOrigin wFig hFig - dat' = moveLabeledPointV2Frames frameFrom frameTo (mempty :: DiagMat2 Scientific) (V2 0 0) <$> dat + dat = tspToLP fval (\(Tick d t) v -> (show (d, t), show (fval v))) <$> ps + dat' = toSvgFrameLP from to False <$> dat + (left, right) = (0.1 * wfig, 0.9 * wfig) + (top, bot) = (0.1 * hfig, 0.9 * hfig) + oTo = Point left top + p2To = Point right bot + from = frameFromPoints $ _lp <$> dat + to = mkFrame oTo p2To + oSvg = Point left bot + + +tsAxis' fval ftickx fticky fd sw col rot ps = + toPlot fd (T.pack . ftickx) (T.pack . fticky) rot 0 sw col + -nth xss n = reverse $ go xss n [] where - go (_:xs) i l | i>0 = go xs (i-1) l - go (x:xs) i l | i==0 = go xs n (x : l) - go [] _ l = l +-- nth xss n = reverse $ go xss n [] where +-- go (_:xs) i l | i>0 = go xs (i-1) l +-- go (x:xs) i l | i==0 = go xs n (x : l) +-- go [] _ l = l + +-- tsp1 :: Maybe (TsPoint (FxRow Double)) +-- tsp1 = Tsp <$> mkTick 2017 16 3 20 30 01 <*> Just (FxRow pi 20 10 5.4) + +dat1 :: [ LabeledPoint String Double ] +dat1 = [LabeledPoint (Point 0 1) "blah", + LabeledPoint (Point 2 0) "asdf", + LabeledPoint (Point 3 1) "yo"] + +to, from :: Frame Double +from = frameFromPoints $ _lp <$> dat1 +to = mkFrameOrigin 400 300 + + + + + -- * Helpers @@ -76,6 +96,10 @@ fromTick :: Tick -> Rational fromTick (Tick d t) = fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction t + +-- fromTickI (Tick d t) = toModifiedJulianDay d + timeOfDayToDayFraction t + + diff --git a/test/LibSpec.hs b/test/LibSpec.hs --- a/test/LibSpec.hs +++ b/test/LibSpec.hs @@ -27,9 +27,7 @@ let from = Frame (Point 5 1) (Point 8 3) :: Frame Double to = Frame (Point 1 2) (Point 4 4) v1 = v2fromPoint $ Point 7 2 - mopt = diagMat2 1 1 :: DiagMat2 Double - vopt = V2 0 0 - v2 = frameToFrame from to mopt vopt v1 + v2 = frameToFrame from to False False v1 p2 = movePoint v2 origin -- p2 `shouldBe` Point 3 3 norm2 (p2 -. Point 3 3) ~= 0 `shouldBe` True @@ -38,7 +36,14 @@ +ps = [Point 12312 0.2, Point 13420.2 0.3, Point 14567 0.14] +fin = frameFromPoints ps +fout = mkFrame (Point 0 0) (Point 1 1) + +vf = frameToFrame fin fout False False + +v1 = V2 13555.2 0.25