plot-light 0.1.0.5 → 0.1.0.6
raw patch · 8 files changed
+324/−190 lines, 8 files
Files
- README.md +16/−3
- plot-light.cabal +6/−6
- src/Graphics/Rendering/Plot/Light.hs +13/−15
- src/Graphics/Rendering/Plot/Light/Internal.hs +172/−88
- src/Graphics/Rendering/Plot/Light/Internal/Geometry.hs +110/−7
- src/Graphics/Rendering/Plot/Light/Internal/Types.hs +0/−66
- src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs +3/−0
- src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs +4/−5
README.md view
@@ -4,7 +4,6 @@ [](https://travis-ci.org/ocramz/plot-light) [](https://hackage.haskell.org/package/plot-light)- [](http://stackage.org/lts/package/plot-light) [](http://stackage.org/nightly/package/plot-light) @@ -17,6 +16,20 @@ ## Usage -To use this project you just need to import this module qualified (to avoid name clashes with any other modules you might have loaded on the side), for example as follows :+To use this project you just need `import Graphics.Rendering.Plot.Light`. If GHC complains of name clashes you can import the module in "qualified" form. -`import Graphics.Rendering.Plot.Light as P`++## Documentation++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.+++## License++BSD-3, see LICENSE file
plot-light.cabal view
@@ -1,5 +1,5 @@ name: plot-light-version: 0.1.0.5+version: 0.1.0.6 synopsis: A lightweight plotting library, exporting to SVG description: A lightweight plotting library, exporting to SVG homepage: https://github.com/ocramz/plot-light@@ -22,14 +22,13 @@ ghc-options: -Wall hs-source-dirs: src exposed-modules: Graphics.Rendering.Plot.Light - other-modules:- Graphics.Rendering.Plot.Light.Internal+ other-modules: Graphics.Rendering.Plot.Light.Internal Graphics.Rendering.Plot.Light.IO.Text Graphics.Rendering.Plot.Light.PlotTypes.Heatmap+ Graphics.Rendering.Plot.Light.PlotTypes.Scatter Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries 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@@ -41,8 +40,9 @@ , colour , palette , blaze-svg- , hspec- , QuickCheck + -- , hspec + -- , QuickCheck+ executable plot-light default-language: Haskell2010
src/Graphics/Rendering/Plot/Light.hs view
@@ -7,28 +7,27 @@ -- Maintainer : Marco Zocca <zocca marco gmail> -- -- `plot-light` provides functionality for rendering vector--- graphics in SVG format. It is geared in particular towards scientific plotting,--- and it is termed "light" because it only requires few native Haskell dependencies.------ It builds upon `blaze-svg` by adding type-safe combinators,--- geometry primitives and related functions.+-- graphics in SVG format. It is geared in particular towards scientific plotting, and it is termed "light" because it only requires a few common Haskell dependencies and no external libraries. -- -- == Usage ----- To use this project you just need to import this module qualified (to avoid name clashes with any other modules you might have loaded on the side), for example as follows :------ @import Graphics.Rendering.Plot.Light as P@+-- To use this project you just need `import Graphics.Rendering.Plot.Light`. If GHC complains of name clashes you can import the module in "qualified" form. ----- If you wish to try out the examples in this page, you will need to have `renderSvg` in scope as well:+-- If you wish to try out the examples in this page, you will need to have these additional import statements: -- -- @import Text.Blaze.Svg.Renderer.String (renderSvg)@+-- +-- @import qualified Data.Colour.Names as C@ module Graphics.Rendering.Plot.Light ( -- * Graphical elements- rectCentered, line, axis, text, polyline,+ rectCentered, circle, line, axis, text, polyline,+ -- ** Element attributes+ LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..),+ -- ** SVG utilities+ svgHeader, -- * Types- FigureData(..), Point(..), LabeledPoint(..), Axis(..),- mkFigureData, svgHeader,+ Frame(..), Point(..), LabeledPoint(..), Axis(..), -- * Geometry -- ** Vectors V2(..),@@ -39,11 +38,11 @@ -- ** Vector operations norm2, normalize2, -- ** Vector construction- mkV2fromEndpoints, v2fromPoint, + v2fromEndpoints, v2fromPoint, -- ** Operations on points movePoint, moveLabeledPointV2, fromUnitSquare, toUnitSquare, -- ** Typeclasses- AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..)+ AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..) ) where -- import Data.Foldable@@ -58,7 +57,6 @@ import qualified Data.Colour as C import qualified Data.Colour.Names as C import qualified Data.Colour.SRGB as C- import Graphics.Rendering.Plot.Light.Internal
src/Graphics/Rendering/Plot/Light/Internal.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}-module Graphics.Rendering.Plot.Light.Internal (FigureData(..), Point(..), LabeledPoint(..), Axis(..), mkFigureData, svgHeader, rectCentered, line, tick, ticks, axis, text, polyline, V2(..), Mat2(..), DiagMat2(..), diagMat2, AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), norm2, normalize2, mkV2fromEndpoints, v2fromPoint, origin, movePoint, moveLabeledPointV2, fromUnitSquare, toUnitSquare, e1, e2) where+module Graphics.Rendering.Plot.Light.Internal (Frame(..), Point(..), LabeledPoint(..), 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, fromUnitSquare, toUnitSquare, e1, e2) where import Data.Monoid ((<>))+import qualified Data.Foldable as F (toList)+import Data.List import Control.Arrow ((&&&), (***)) import Control.Monad (forM, forM_) import Data.Semigroup (Min(..), Max(..))@@ -23,100 +25,110 @@ import GHC.Real -import Graphics.Rendering.Plot.Light.Internal.Types import Graphics.Rendering.Plot.Light.Internal.Geometry --- | Create a `FigureData` structure from the top-left corner point and its side lengths-mkFigureData :: Num a =>- Point a - -> a- -> a- -> FigureData a-mkFigureData (Point xmi ymi) xlen ylen =- FigData xlen ylen xmi (xmi + xlen) ymi (ymi + ylen)------ | Create the SVG header from `FigureData`-svgHeader :: FigureData Int -> Svg -> Svg+-- | Create the SVG header from a `Frame`+svgHeader :: Frame Int -> Svg -> Svg svgHeader fd = S.docTypeSvg ! 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])+ ! SA.width (vi $ width fd)+ ! SA.height (vi $ height fd)+ ! SA.viewbox (vis [xmin fd, ymin fd, xmax fd, ymax fd]) --- | A filled rectangle-rectCentered- :: Point Double -- ^ Center coordinates - -> Double -- ^ Width- -> Double -- ^ Height- -> C.Colour Double -- ^ Colour++-- | A rectangle, defined by its center coordinates and side lengths+--+-- > > putStrLn $ renderSvg $ rectCentered (Point 20 30) 15 30 (Just C.blue) (Just C.red)+-- > <g transform="translate(12.5 15.0)"><rect width="15.0" height="30.0" fill="#ff0000" stroke="#0000ff" /></g>+rectCentered :: (Show a, RealFrac a) =>+ Point a -- ^ Center coordinates + -> a -- ^ Width+ -> a -- ^ Height+ -> Maybe (C.Colour Double) -- ^ Stroke colour+ -> Maybe (C.Colour Double) -- ^ Fill colour -> Svg-rectCentered (Point 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+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 x0c = x0 - (wid / 2) y0c = y0 - (hei / 2) -- | Line segment between two `Point`s -- --- > > putStrLn $ renderSvg (line 0 0 1 1 0.1 C.blueviolet)+-- > > putStrLn $ renderSvg $ line (Point 0 0) (Point 1 1) 0.1 Continuous C.blueviolet -- > <line x1="0.0" y1="0.0" x2="1.0" y2="1.0" stroke="#8a2be2" stroke-width="0.1" />-line ::- Point Double -- ^ First point- -> Point Double -- ^ Second point- -> Double -- ^ Stroke width+--+-- > > putStrLn $ renderSvg (line (Point 0 0) (Point 1 1) 0.1 (Dashed [0.2, 0.3]) C.blueviolet)+-- > <line x1="0.0" y1="0.0" x2="1.0" y2="1.0" stroke="#8a2be2" stroke-width="0.1" stroke-dasharray="0.2, 0.3" />+line :: (Show a, RealFrac a) =>+ Point a -- ^ First point+ -> Point a -- ^ Second point+ -> a -- ^ Stroke width+ -> LineStroke_ a -- ^ Stroke type -> C.Colour Double -- ^ Stroke colour -> Svg-line (Point x1 y1) (Point 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 (Point x1 y1) (Point x2 y2) sw Continuous 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 (Point x1 y1) (Point x2 y2) sw (Dashed d) 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) ! strokeDashArray d -tick :: Axis -> Double -> Double -> C.Colour Double -> Point Double -> Svg-tick ax len sw col (Point x y) = line (Point x1 y1) (Point x2 y2) sw col where+strokeDashArray :: Real a => [a] -> S.Attribute+strokeDashArray sz = SA.strokeDasharray (S.toValue str) where+ str = intercalate ", " $ map (show . real) sz++-- | Specify a continuous or dashed stroke+data LineStroke_ a = Continuous | Dashed [a] deriving (Eq, Show)++++tick :: (Show a, RealFrac a) => Axis -> a -> a -> C.Colour Double -> LineStroke_ a -> Point a -> Svg+tick ax len sw col ls (Point x y) = line (Point x1 y1) (Point x2 y2) sw ls 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+tickX, tickY :: (Show a, RealFrac a) =>+ a -- ^ Length+ -> a -- ^ Stroke width -> C.Colour Double -- ^ Stroke colour- -> Point Double -- ^ Center coordinates+ -> LineStroke_ a+ -> Point a -- ^ 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 =>+ticks :: (Foldable t, Show a, RealFrac a) => Axis -- ^ Axis - -> Double -- ^ Length - -> Double -- ^ Stroke width+ -> a -- ^ Length + -> a -- ^ Stroke width -> C.Colour Double -- ^ Stroke colour- -> t (Point Double) -- ^ Center coordinates+ -> LineStroke_ a+ -> t (Point a) -- ^ Center coordinates -> Svg-ticks ax len sw col ps = forM_ ps (tick ax len sw col)+ticks ax len sw col ls ps = forM_ ps (tick ax len sw col ls) -- | 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]+-- > > putStrLn $ renderSvg $ axis X 200 2 C.red 0.05 (Point 150 10) Continuous [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 -- ^ Axis (i.e. either `X` or `Y`)- -> Double -- ^ Length- -> Double -- ^ Stroke width- -> C.Colour Double -- ^ Stroke colour- -> Double -- ^ Tick length fraction (w.r.t axis length)- -> Point Double -- ^ Axis center coordinate- -> t (Point Double) -- ^ Tick center coordinates+axis :: (Functor t, Foldable t, Show a, RealFrac a) =>+ Axis -- ^ Axis (i.e. either `X` or `Y`)+ -> a -- ^ Length+ -> a -- ^ Stroke width+ -> C.Colour Double -- ^ Stroke colour+ -> a -- ^ Tick length fraction (w.r.t axis length)+ -> Point a -- ^ Axis center coordinate+ -> LineStroke_ a+ -> t (Point a) -- ^ Tick center coordinates -> 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)+axis ax len sw col tickLenFrac p@(Point x y) ls ps = do+ tick ax len sw col ls p+ ticks (otherAxis ax) (tickLenFrac * len) sw col ls (f <$> ps) where f | ax == X = setPointY y | otherwise = setPointX x@@ -125,49 +137,99 @@ -- * text --- | `text` renders text onto the SVG canvas. It is also possible to rotate and move the text, however the order of these modifiers matters.--- --- NB1: The `Point` parameter `p` determines the /initial/ position of the bottom-left corner of the text box. If a nonzero rotation is applied, the whole text box will move on a circle of radius || x^2 + y^2 || centered at `p`.+-- | `text` renders text onto the SVG canvas ----- NB2: the `rotate` and `translate` attributes apply to the /center/ of the visible text instead.+-- == Conventions ----- > > 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 +-- The `Point` argument `p` refers to the /lower-left/ corner of the text box.+--+-- After the text is rendered, its text box can be rotated by `rot` degrees around `p` and then optionally anchored.+--+-- The user can supply an additional `V2` displacement which will be applied /after/ rotation and anchoring and refers to the rotated text box frame.+--+-- > > putStrLn $ renderSvg $ text (-45) C.green TAEnd "blah" (V2 (- 10) 0) (Point 250 0)+-- > <text x="-10.0" y="0.0" transform="translate(250.0 0.0)rotate(-45.0)" fill="#008000" text-anchor="end">blah</text>+text :: (Show a, Real a) =>+ a -- ^ Rotation angle of the frame -> C.Colour Double -- ^ Font colour+ -> TextAnchor_ -> T.Text -- ^ Text - -> V2 a2 -- ^ Displacement- -> Point a -- ^ Initial center position of the text box+ -> V2 a -- ^ Displacement w.r.t. rotated frame+ -> Point a -- ^ Reference frame origin 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)+text rot col ta te (V2 vx vy) (Point x y) = S.text_ (S.toMarkup te) ! SA.x (vd vx) ! SA.y (vd vy) ! SA.transform (S.translate (real x) (real y) <> S.rotate (real rot)) ! SA.fill (colourAttr col) ! textAnchor ta +-- | Specify at which end should the text be anchored to its current point+data TextAnchor_ = TAStart | TAMiddle | TAEnd deriving (Eq, Show) +textAnchor :: TextAnchor_ -> S.Attribute+textAnchor TAStart = SA.textAnchor (vs "start")+textAnchor TAMiddle = SA.textAnchor (vs "middle")+textAnchor TAEnd = SA.textAnchor (vs "end") --- <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" /> ++-- | 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" />+circle+ :: (Real a1, Real a) =>+ Point a1 -- ^ Center+ -> a -- ^ Radius+ -> 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+++++ -- | Polyline (piecewise straight line) -- --- > > 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)] -- ^ Data- -> Double -- ^ Stroke width+-- > > putStrLn $ renderSvg (polyline [Point 100 50, Point 120 20, Point 230 50] 4 (Dashed [3, 5]) Round C.blueviolet)+-- > <polyline points="100.0,50.0 120.0,20.0 230.0,50.0" fill="none" stroke="#8a2be2" stroke-width="4.0" stroke-linejoin="round" stroke-dasharray="3.0, 5.0" />+polyline :: (Foldable t, Show a1, Show a, RealFrac a, RealFrac a1) =>+ t (Point a) -- ^ Data+ -> a1 -- ^ Stroke width+ -> LineStroke_ a+ -> StrokeLineJoin_ -> C.Colour Double -- ^ Stroke colour -> 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 -+polyline lis sw Continuous slj col = S.polyline ! SA.points (S.toValue $ unwords $ map show $ F.toList lis) ! SA.fill none ! SA.stroke (colourAttr col ) ! SA.strokeWidth (vd sw) ! strokeLineJoin slj+polyline lis sw (Dashed d) slj col = S.polyline ! SA.points (S.toValue $ unwords $ map show $ F.toList lis) ! SA.fill none ! SA.stroke (colourAttr col ) ! SA.strokeWidth (vd sw) ! strokeLineJoin slj ! 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)+++-- | Specify the type of connection between line segments+data StrokeLineJoin_ = Miter | Round | Bevel | Inherit deriving (Eq, Show)++strokeLineJoin :: StrokeLineJoin_ -> S.Attribute+strokeLineJoin slj = SA.strokeLinejoin (S.toValue str) where+ str | slj == Miter = "miter" :: String+ | slj == Round = "round"+ | slj == Bevel = "bevel"+ | otherwise = "inherit"+++++++ -- * Helpers @@ -177,6 +239,14 @@ -- ** Conversion from primitive numerical types to AttributeValue++-- String++vs :: String -> S.AttributeValue+vs x = S.toValue (x :: String)++-- Int+ vi :: Int -> S.AttributeValue vi = S.toValue @@ -185,18 +255,32 @@ vis = S.toValue . unwords . map show -- Double-vd :: Double -> S.AttributeValue-vd = S.toValue+vd0 :: Double -> S.AttributeValue+vd0 = S.toValue -vds :: [Double] -> S.AttributeValue-vds = S.toValue . unwords . map show+vd :: Real a => a -> S.AttributeValue +vd = vd0 . real --- Float-vf :: Float -> S.AttributeValue-vf = S.toValue+real :: (Real a, Fractional b) => a -> b+real = fromRational . toRational -vfs :: [Float] -> S.AttributeValue-vfs = S.toValue . unwords . map show+showd :: Real a => a -> String+showd = show . real++-- 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
@@ -1,16 +1,91 @@-{-# LANGUAGE MultiParamTypeClasses #-}--- {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}-{-# language TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances #-} {- | 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+import Data.Monoid ((<>)) +-- | A `Point` defines a point in R2+data Point a = Point { _px :: a,+ _py :: a } deriving (Eq) +instance Show a => Show (Point a) where+ show (Point x y) = show x ++ "," ++ show y +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 a "label" (i.e. any additional information such as a text tag, or any other data structure), in addition to position information. Data points on a plot are `LabeledPoint`s.+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)++otherAxis :: Axis -> Axis+otherAxis X = Y+otherAxis _ = X++++-- * Dataset+++-- data Dataset l a = Dataset+-- {+-- dsdat :: [LabeledPoint l a]+-- , dsframe ::Frame a+-- } deriving (Eq, Show)++-- instance Monoid (Dataset l a) where++++++ +++ -- | V2 is a vector in R^2 data V2 a = V2 a a deriving (Eq, Show) @@ -70,9 +145,9 @@ -- | 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+v2fromEndpoints, (-.) :: Num a => Point a -> Point a -> V2 a+v2fromEndpoints (Point px py) (Point qx qy) = V2 (qx-px) (qy-py)+(-.) = v2fromEndpoints -- | The origin of the axes, point (0, 0) origin :: Num a => Point a@@ -156,12 +231,40 @@ vmove = (mm #> v2fromPoint p) ^+^ vo +-- * HasFrame : things which have a bounding box +class HasFrame v where+ type UnitInterval v :: *+ type FrameType v :: *+ fromFrame :: v -> UnitInterval v+ toFrame :: UnitInterval v -> v+++ -- | X-aligned unit vector e1 :: Num a => V2 a e1 = V2 1 0 -- | Y-aligned unit vector e2 :: Num a => V2 a e2 = V2 0 1++++-- | Numerical equality +class Eps a where+ -- | Comparison within numerical precision+ (~=) :: a -> a -> Bool++instance Eps Double where+ a ~= b = abs (a - b) <= 1e-12++instance Eps Float where+ a ~= b = abs (a - b) <= 1e-6++instance Eps (V2 Double) where+ v1 ~= v2 = norm2 (v1 ^-^ v2) <= 1e-8+ +instance Eps (V2 Float) where+ v1 ~= v2 = norm2 (v1 ^-^ v2) <= 1e-3
− src/Graphics/Rendering/Plot/Light/Internal/Types.hs
@@ -1,66 +0,0 @@-module Graphics.Rendering.Plot.Light.Internal.Types where--data FigureData a =- FigData {- _width :: a- , _height :: a- , _xmin :: a- , _xmax :: a- , _ymin :: a- , _ymax :: a- } deriving (Eq, Show)----- | 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 a "label" (i.e. any additional information such as a text tag, or any other data structure), in addition to position information. Data points on a plot are `LabeledPoint`s.-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/Scatter.hs view
@@ -0,0 +1,3 @@+module Graphics.Rendering.Plot.Light.PlotTypes.Scatter where++import Graphics.Rendering.Plot.Light.Internal
src/Graphics/Rendering/Plot/Light/PlotTypes/TimeSeries.hs view
@@ -6,7 +6,6 @@ import qualified Data.Text as T import Graphics.Rendering.Plot.Light.Internal-import Graphics.Rendering.Plot.Light.Internal.Types import Data.TimeSeries.Forex @@ -30,10 +29,6 @@ return $ Tick d tim --- | Map a Tick onto the rationals-fromTick :: Tick -> Rational-fromTick (Tick d t) = fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction t- tspToTuple :: (a -> b) -> TsPoint a -> (Float, b) tspToTuple f tsp = (tickToFloat tsp, f $ _val tsp)@@ -41,6 +36,10 @@ tickToFloat :: TsPoint a -> Float tickToFloat = fromRational . fromTick . _tick +-- | Map a Tick onto the rationals+fromTick :: Tick -> Rational+fromTick (Tick d t) = fromIntegral (toModifiedJulianDay d) + timeOfDayToDayFraction t+