packages feed

plot-light 0.1.0.1 → 0.1.0.2

raw patch · 8 files changed

+411/−82 lines, 8 files

Files

app/timeseries/Main.hs view
@@ -1,15 +1,46 @@+{-# language OverloadedStrings #-} module Main where -import Graphics.Rendering.Plot.Light.IO.Text+import Control.Arrow ((***), (&&&)) -import qualified Data.Attoparsec.Text as A-import qualified Data.Text.IO as T+-- import Graphics.Rendering.Plot.Light.IO.Text+-- import Graphics.Rendering.Plot.Light.Internal+-- -- import Graphics.Rendering.Plot.Light.Internal.Types+-- import Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries+-- -- import Data.TimeSeries.Forex+  +-- import qualified Data.Attoparsec.Text as A+-- import qualified Data.Text as T+-- import qualified Data.Text.IO as T+-- import Data.Scientific (Scientific, toRealFloat)+-- import Text.Blaze.Svg.Renderer.String (renderSvg)+-- import qualified Data.Colour.Names as C  + fname = "data/forex" -main = do-  d <- T.readFile fname-  let pd = A.parseOnly parseFxDataset d-  case pd of Left e -> error e-             Right datarows -> pure datarows+xPlot = 400+yPlot = 300+fnameOut = "data/forex_plot.svg"++-- figData = mkFigureData 10 10 xPlot yPlot++main = print "hello!"++-- main = do+--   d <- T.readFile fname+--   let pd = A.parseOnly parseFxDataset d+--   case pd of Left e -> error e+--              Right datarows -> do+--                 let+--                   dat = tspToTuple rateHigh <$> reverse datarows+--                   (dat', fdat) = mkFigureData xPlot yPlot toFloat dat+--                   svg_t = renderSvg $ figure fdat+--                        (polyline dat' 0.5 C.red)+--                 T.writeFile fnameOut $ T.pack svg_t++-- toFloat :: Scientific -> Float+-- toFloat x = toRealFloat x :: Float++
plot-light.cabal view
@@ -1,7 +1,7 @@ name:                plot-light-version:             0.1.0.1+version:             0.1.0.2 synopsis:            A lightweight plotting library, exporting to SVG--- description:+description:         A lightweight plotting library, exporting to SVG homepage:            https://github.com/ocramz/plot-light license:             BSD3 license-file:        LICENSE@@ -21,14 +21,15 @@   default-language:    Haskell2010   ghc-options:         -Wall   hs-source-dirs:      src-  exposed-modules:     Lib-                       Graphics.Rendering.Plot.Light+  exposed-modules:     Graphics.Rendering.Plot.Light                    +  other-modules:                        Graphics.Rendering.Plot.Light.Internal                        Graphics.Rendering.Plot.Light.IO.Text                        Graphics.Rendering.Plot.Light.PlotTypes.Heatmap                        Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries-  other-modules:       Data.TimeSeries.Forex+                       Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries.Candlestick                          Data.TimeSeries.Forex                        Graphics.Rendering.Plot.Light.Internal.Types+                       Graphics.Rendering.Plot.Light.Internal.Geometry   build-depends:       base >= 4.7 && < 5                      , time                      , attoparsec-time                     @@ -47,8 +48,11 @@   main-is:             Main.hs   build-depends:       base                      , plot-light-                     , attoparsec-                     , text+                     -- , attoparsec+                     -- , text+                     -- , colour+                     -- , blaze-svg+                     -- , scientific  test-suite spec   default-language:    Haskell2010
src/Graphics/Rendering/Plot/Light/Internal.hs view
@@ -1,16 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} module Graphics.Rendering.Plot.Light.Internal where +import Data.Monoid ((<>)) import Control.Arrow ((&&&), (***))+import Control.Monad (forM, forM_)+import Data.Semigroup (Min(..), Max(..))+import Data.Scientific (Scientific, toRealFloat)  -- import Data.Foldable import qualified Data.Text as T -- import qualified Data.Vector as V  import Text.Blaze.Svg-import Text.Blaze.Svg11 -- ((!), mkPath, rotate, translate, l, m)-import qualified Text.Blaze.Svg11 as S-import qualified Text.Blaze.Svg11.Attributes as S+import Text.Blaze.Svg11  ((!))+import qualified Text.Blaze.Svg11 as S hiding (style)+import qualified Text.Blaze.Svg11.Attributes as SA hiding (rotate) import Text.Blaze.Svg.Renderer.String (renderSvg)  import qualified Data.Colour as C@@ -20,53 +24,148 @@ import GHC.Real  import Graphics.Rendering.Plot.Light.Internal.Types----- axis f1 figd = undefined---   where---     d = f1 <$> _figData figd -- pick out data---     numd = length d---     mm = maximum d---     m = minimum d+import Graphics.Rendering.Plot.Light.Internal.Geometry   +mkFigureData :: Num a => a -> a -> a -> a -> FigureData a+mkFigureData xmin ymin xlen ylen =+  FigData xlen ylen xmin (xmin + xlen) ymin (ymin + ylen)    -- | Header for a Figure-figure :: FigureData Int d -> Svg -> Svg+figure :: FigureData Int -> Svg -> Svg figure fd =   S.docTypeSvg-  ! S.version "1.1"-  ! S.width (vi $ _width fd)-  ! S.height (vi $ _height fd)-  ! S.viewbox (vis [_xmin fd, _ymin fd, _xmax fd, _ymax fd])+  ! SA.version "1.1"+  ! SA.width (vi $ _width fd)+  ! SA.height (vi $ _height fd)+  ! SA.viewbox (vis [_xmin fd, _ymin fd, _xmax fd, _ymax fd])   -- | A filled rectangle, centered at (x0, y0) rectCentered   :: Double -> Double -> Double -> Double -> C.Colour Double -> Svg-rectCentered x0 y0 wid hei col = S.g ! S.transform (translate x0c y0c) $ -  S.rect ! S.width (vd wid) ! S.height (vd hei) ! S.fill (colourAttr col) where+rectCentered x0 y0 wid hei col = S.g ! SA.transform (S.translate x0c y0c) $ +  S.rect ! SA.width (vd wid) ! SA.height (vd hei) ! SA.fill (colourAttr col) where    x0c = x0 - (wid / 2)    y0c = y0 - (hei / 2)     -- centeredAt x0 y0 = S.g ! A.transform (translate x0 y0)  +-- | Line segment+--+-- e.g. +-- > putStrLn $ renderSvg (line 0 0 1 1 0.1 C.blueviolet)+-- +-- <line x1="0.0" y1="0.0" x2="1.0" y2="1.0" stroke="#8a2be2" stroke-width="0.1" />+line :: Double -> Double -> Double -> Double -> Double -> C.Colour Double -> Svg+line x1 y1 x2 y2 sw col = S.line ! SA.x1 (vd x1) ! SA.y1 (vd y1) ! SA.x2 (vd x2)  ! SA.y2 (vd y2) ! SA.stroke (colourAttr col )! SA.strokeWidth (vd sw) -line x1 x2 y1 y2 = S.line ! S.x1 (vd x1) ! S.x2 (vd x2) ! S.y1 (vd y1) ! S.y2 (vd y2)+tick :: Axis -> Double -> Double -> C.Colour Double -> Point Double -> Svg+tick ax len sw col (Point x y) = line x1 y1 x2 y2 sw col where+  lh = len / 2+  (x1, y1, x2, y2)+    | ax == Y = (x, y-lh, x, y+lh)+    | otherwise = (x-lh, y, x+lh, y) +tickX, tickY ::+     Double          -- | Length+  -> Double          -- | Stroke width+  -> C.Colour Double -- | Stroke colour+  -> Point Double    -- | Center coordinates+  -> Svg+tickX = tick X+tickY = tick Y +-- | An array of axis-aligned identical segments (to be used as axis tickmarks), with centers given by the array of `Point`s+ticks :: Foldable t =>+               Axis                -- | Axis +               -> Double           -- | Length         +               -> Double           -- | Stroke width+               -> C.Colour Double  -- | Stroke colour+               -> t (Point Double) -- | Center coordinates+               -> Svg+ticks ax len sw col ps = forM_ ps (tick ax len sw col)+++-- | An axis with tickmarks+--+-- λ> putStrLn $ renderSvg $ axis X 200 2 C.red 0.05 (Point 150 10) [Point 50 1, Point 60 1, Point 70 1]+-- <line x1="50.0" y1="10.0" x2="250.0" y2="10.0" stroke="#ff0000" stroke-width="2.0" /><line x1="50.0" y1="5.0" x2="50.0" y2="15.0" stroke="#ff0000" stroke-width="2.0" /><line x1="60.0" y1="5.0" x2="60.0" y2="15.0" stroke="#ff0000" stroke-width="2.0" /><line x1="70.0" y1="5.0" x2="70.0" y2="15.0" stroke="#ff0000" stroke-width="2.0" />+axis :: (Functor t, Foldable t) =>+              Axis+              -> Double+              -> Double+              -> C.Colour Double+              -> Double+              -> Point Double+              -> t (Point Double)+              -> Svg+axis ax len sw col tickLenFrac p@(Point x y) ps = do+  tick ax len sw col p+  ticks (otherAxis ax) (tickLenFrac * len) sw col (f <$> ps)+  where+    f | ax == X = setPointY y+      | otherwise = setPointX x++++-- * text++-- | `text` renders text onto the SVG canvas. It is also possible to rotate and move the text, however the order of these modifier matters.+-- NB1: `x` and `y` determine the position of the bottom-left corner of the text box. If a nonzero rotation is applied, the whole text box will move in a circle of radius || x^2 + y^2 ||+-- NB2: the `rotate` and `translate` apply to the _center_ of the text box instead+--+-- > putStrLn $ renderSvg $ text (-45) C.red "hullo!" (V2 (-30) 0) (Point 0 20)+-- <text x="-30" y="0" transform="translate(0 20)rotate(-45)" fill="#ff0000">hullo!</text>+text :: (Show a, Show a1, S.ToValue a2) =>+              a1        -- | Rotation angle +     -> C.Colour Double -- | Font colour+     -> T.Text          -- | Text +     -> V2 a2           -- | Displacement+     -> Point a         -- | Initial center position of the text box+     -> Svg+text rot col te (V2 x y) (Point dx dy) = +  S.text_ (S.toMarkup te) ! SA.x (S.toValue x) ! SA.y (S.toValue y) ! SA.transform (S.translate dx dy <> S.rotate rot) ! SA.fill (colourAttr col)++++-- <polyline points="40 140 80 100 120 140" stroke="black" stroke-width="20" stroke-linecap="round" fill="none" stroke-linejoin="round"/>++-- <polyline points="20,20 40,25 60,40 80,120 120,140 200,180" style="fill:none;stroke:black;stroke-width:3" />++-- | Polyline (piecewise straight line)+-- e.g.+-- > putStrLn $ renderSvg (polyline [(1,1), (2,1), (2,2), (3,4)] 0.1 C.red)+--+-- <polyline points="1,1 2,1 2,2 3,4" fill="none" stroke="#ff0000" stroke-width="0.1" />+polyline :: (Show a1, Show a) => [(a1, a)] -> Double -> C.Colour Double -> Svg+polyline lis sw col = S.polyline ! SA.points (S.toValue $ unwords $ map showP2 lis) ! SA.fill none ! SA.stroke (colourAttr col )! SA.strokeWidth (vd sw) ! SA.strokeLinejoin (S.toValue ("round" :: String))++showP2 :: (Show a, Show a1) => (a1, a) -> String+showP2 (x, y) = show x ++ "," ++ show y +++none :: S.AttributeValue+none = S.toValue ("none" :: String)+++   -- * Helpers   -- | Given a point `x` in a range [x1min, x1max], map it by affine transformation onto the interval [x2min, x2max]+-- More precisely, first it maps `x` onto the unit interval and from this onto the interval of interest affine :: Fractional t => t -> t -> t -> t -> t -> t-affine x2min x2max x1min x1max x = (x - x1min)*d2/d1 + x2min where+affine = withAffine id++-- | Applies a function to the values in the unit interval+withAffine :: Fractional t => (t -> t) -> t -> t -> t -> t -> t -> t+withAffine f x2min x2max x1min x1max x = (f (x - x1min)/d1)*d2 + x2min where   d1 = x1max - x1min   d2 = x2max - x2min-     @@ -78,16 +177,23 @@ vi :: Int -> S.AttributeValue vi = S.toValue - -- | For use e.g. in `viewbox` vis :: [Int] -> S.AttributeValue vis = S.toValue . unwords . map show +-- Double vd :: Double -> S.AttributeValue vd = S.toValue +vds :: [Double] -> S.AttributeValue+vds = S.toValue . unwords . map show +-- Float+vf :: Float -> S.AttributeValue+vf = S.toValue +vfs :: [Float] -> S.AttributeValue+vfs = S.toValue . unwords . map show   --
+ src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}+{-# language TypeFamilies, FlexibleContexts #-}+{- |+This module provides functionality for working with affine transformations (i.e. in the unit square)+ +-}+module Graphics.Rendering.Plot.Light.Internal.Geometry where++import Graphics.Rendering.Plot.Light.Internal.Types++++-- | V2 is a vector in R^2+data V2 a = V2 a a deriving (Eq, Show)++-- | Vectors form a monoid w.r.t. vector addition+instance Num a => Monoid (V2 a) where+  mempty = V2 0 0+  (V2 a b) `mappend` (V2 c d) = V2 (a + b) (c + d)++-- | Additive group : +-- v ^+^ zero = zero ^+^ v = v+-- v ^-^ v == zero+class AdditiveGroup v where+  zero :: v+  (^+^) :: v -> v -> v+  (^-^) :: v -> v -> v++instance Num a => AdditiveGroup (V2 a) where+  zero = mempty+  (^+^) = mappend+  (V2 a b) ^-^ (V2 c d) = V2 (a - c) (b - d)++-- | Vector space : multiplication by a scalar quantity+class AdditiveGroup v => VectorSpace v where+  type Scalar v :: *+  (.*) :: Scalar v -> v -> v+  +instance Num a => VectorSpace (V2 a) where+  type Scalar (V2 a) = a+  n .* (V2 vx vy) = V2 (n*vx) (n*vy)++-- | Hermitian space : inner product+class VectorSpace v => Hermitian v where+  type InnerProduct v :: *+  (<.>) :: v -> v -> InnerProduct v++instance Num a => Hermitian (V2 a) where+  type InnerProduct (V2 a) = a+  (V2 a b) <.> (V2 c d) = (a*c) + (b*d)++-- | Euclidean (L^2) norm+norm2 ::+  (Hermitian v, Floating n, n ~ (InnerProduct v)) => v -> n+norm2 v = sqrt $ v <.> v++-- | Normalize a V2 w.r.t. its Euclidean norm+normalize2 :: (InnerProduct v ~ Scalar v, Floating (Scalar v), Hermitian v) =>+     v -> v+normalize2 v = (1/norm2 v) .* v+++-- | Create a V2 `v` from two endpoints p1, p2. That is `v` can be seen as pointing from `p1` to `p2`+mkV2fromEndpoints, (-.) :: Num a => Point a -> Point a -> V2 a+mkV2fromEndpoints (Point px py) (Point qx qy) = V2 (qx-px) (qy-py)+(-.) = mkV2fromEndpoints++-- | The origin of the axes, point (0, 0)+origin :: Num a => Point a+origin = Point 0 0+++-- | A Mat2 can be seen as a linear operator V2 -> V2+data Mat2 a = Mat2 a a a a deriving (Eq, Show)++-- | Linear maps, i.e. linear transformations of vectors+class Hermitian v => LinearMap m v where+  (#>) :: m -> v -> v++-- | Multiplicative matrix semigroup ("multiplying" two matrices together)+class MultiplicativeSemigroup m where+  (##) :: m -> m -> m++instance Num a => LinearMap (Mat2 a) (V2 a) where+  (Mat2 a00 a01 a10 a11) #> (V2 vx vy) = V2 (a00 * vx + a01 * vy) (a10 * vx + a11 * vy)++-- | A diagonal matrix+diagMat2 :: Num a => a -> a -> Mat2 a+diagMat2 rx ry = Mat2 rx 0 0 ry++-- | Diagonal matrices in R2 behave as scaling transformations+data DiagMat2 a = DMat2 a a deriving (Eq, Show)++-- | Create a diagonal matrix+mkDMat2 :: a -> a -> DiagMat2 a+mkDMat2 = DMat2++-- | The class of invertible linear transformations+class LinearMap m v => MatrixGroup m v where+  (<\>) :: m -> v -> v+  +instance Num a => MultiplicativeSemigroup (DiagMat2 a) where+  DMat2 a b ## DMat2 c d = DMat2 (a*c) (b*d)++-- | Diagonal matrices can always be inverted+instance Num a => LinearMap (DiagMat2 a) (V2 a) where+  DMat2 d1 d2 #> V2 vx vy = V2 (d1 * vx) (d2 * vy)+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)+v2fromPoint :: Num a => Point a -> V2 a+v2fromPoint p = origin -. p++-- | 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)++-- | Move a `LabeledPoint` along a vector+moveLabeledPointV2 :: Num a => V2 a -> LabeledPoint l a -> LabeledPoint l a+moveLabeledPointV2 = moveLabeledPoint . movePoint+++-- | The vector translation from a `Point` contained in a `Frame` onto the unit square+--+-- NB: we do not check that `p` is actually contained within the frame. This has to be supplied correctly by the user+toUnitSquare :: Fractional a => Frame a -> Point a -> Point a+toUnitSquare from p = movePoint vmove p+  where+    mm = mkDMat2 (width from) (height from)+    o1 = _fpmin from+    vmove = mm <\> (p -. o1)++-- | The vector translation from a `Point` contained in the unit square onto a `Frame`+--+-- NB: we do not check that `p` is actually contained in [0,1] x [0,1], This has to be supplied correctly by the user+fromUnitSquare :: Num a => Frame a -> Point a -> Point a+fromUnitSquare to p = movePoint vmove p+  where+    mm = mkDMat2 (width to) (height to)+    vo = v2fromPoint (_fpmin to)+    vmove = (mm #> v2fromPoint p) ^+^ vo+++-- | Coordinate unit vectors+e1, e2 :: Num a => V2 a+e1 = V2 1 0+e2 = V2 0 1+++++++-- class Located v where+--   type Coords v :: *+--   position :: v -> Coords v
src/Graphics/Rendering/Plot/Light/Internal/Types.hs view
@@ -1,7 +1,7 @@-module Graphics.Rendering.Plot.Light.Internal.Types where+module Graphics.Rendering.Plot.Light.Internal.Types  where  -data FigureData a d =+data FigureData a =   FigData {     _width :: a   , _height :: a@@ -9,12 +9,57 @@   , _xmax :: a   , _ymin :: a   , _ymax :: a-  , _figData :: d-      }+      } deriving (Eq, Show) --- | A LabeledPoint carries the information of where a point should be plotted, what label should it carry (e.g. for labelling the axes) and its function value -data LabeledPoint c l a =-  LabeledPoint { _coord :: c, _label :: l, _value :: a } -data P1 a = P1 a-data P2 a = P2 a a+-- | A `Point` defines a point in R2+data Point a = Point { _px :: a, _py :: a} deriving (Eq, Show)++mkPoint :: a -> a -> Point a+mkPoint = Point++-- | Overwrite either coordinate of a Point, to e.g. project on an axis+setPointCoord :: Axis -> a -> Point a -> Point a+setPointCoord axis c (Point x y)+  | axis == X = Point c y+  | otherwise = Point x c++setPointX, setPointY :: a -> Point a -> Point a+setPointX = setPointCoord X+setPointY = setPointCoord Y++-- | A `LabeledPoint` carries the information of where a point should be plotted, what label should it carry (e.g. for labelling the axes) and its function value +data LabeledPoint l a =+  LabeledPoint {+   _lp :: Point a,+   _lplabel :: l } deriving (Eq, Show)++moveLabeledPoint :: (Point a -> Point b) -> LabeledPoint l a -> LabeledPoint l b+moveLabeledPoint f (LabeledPoint p l) = LabeledPoint (f p) l++-- | A frame, i.e. a bounding box for objects+data Frame a = Frame {+   _fpmin :: Point a,+   _fpmax :: Point a} deriving (Eq, Show)++-- | Frame corner coordinates+xmin, xmax, ymin, ymax :: Frame a -> a+xmin = _px . _fpmin+xmax = _px . _fpmax+ymin = _py . _fpmin+ymax = _py . _fpmax++-- | The `width` is the extent in the `x` direction and `height` is the extent in the `y` direction+width, height :: Num a => Frame a -> a+width f = xmax f - xmin f+height f = ymax f - ymin f++++-- * Axis++data Axis = X | Y deriving (Eq, Show, Enum)++otherAxis :: Axis -> Axis+otherAxis X = Y+otherAxis _ = X
src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs view
@@ -10,7 +10,18 @@ import Data.TimeSeries.Forex  +-- | Compute the plotting coordinates of a timeseries point +-- | Preprocess the dataset for plotting +-- 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++++++-- * Helpers+ -- | Create a Tick from valid (year, month, day, hour, minute, second) mkTick :: Integer -> Int -> Int -> Int -> Int -> Pico -> Maybe Tick mkTick yy mm dd hr mi se = do@@ -22,44 +33,14 @@ -- | Map a Tick onto the rationals fromTick :: Tick -> Rational fromTick (Tick d t) = fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction t---+     --- | Transform the time coordinate of a timeseries point -mapToViewbox :: FigureData (Ratio Integer) d-                   -> Tick      -- | Lower bound-                   -> Tick      -- | Upper bound-                   -> TsPoint a -- | A point in the timeseries-                   -> LabeledPoint (Ratio Integer) Tick a-mapToViewbox fd tmin tmax p = LabeledPoint t' (_tick p) (_val p)-  where-    t' = toViewboxRange fd tmin tmax p+tspToTuple :: (a -> b) -> TsPoint a -> (Float, b)+tspToTuple f tsp = (tickToFloat tsp, f $ _val tsp)   --toViewboxRange ::-  FigureData Rational d -> Tick -> Tick -> TsPoint a -> Rational-toViewboxRange fd tmin tmax p =-  affine (_xmin fd) (_xmax fd) (fromTick tmin) (fromTick tmax) (fromTick $ _tick p)+tickToFloat :: TsPoint a -> Float+tickToFloat = fromRational . fromTick . _tick    --- SVG with text---- <?xml version="1.0" standalone="no"?>--- <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" ---   "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">--- <svg width="10cm" height="3cm" viewBox="0 0 1000 300"---      xmlns="http://www.w3.org/2000/svg" version="1.1">---   <desc>Example text01 - 'Hello, out there' in blue</desc>----   <text x="250" y="150" ---         font-family="Verdana" font-size="55" fill="blue" >---     Hello, out there---   </text>----   <!-- Show outline of canvas using 'rect' element -->---   <rect x="1" y="1" width="998" height="298"---         fill="none" stroke="blue" stroke-width="2" />--- </svg>
+ src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries/Candlestick.hs view
@@ -0,0 +1,5 @@+module Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries.Candlestick where+++import Graphics.Rendering.Plot.Light.Internal+import Graphics.Rendering.Plot.Light.Internal.Types
− src/Lib.hs
@@ -1,1 +0,0 @@-module Lib where