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.3.1 +version: 0.3.2 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. @@ -16,7 +16,7 @@ extra-doc-files: doc/fig/heatmap.png doc/fig/scatter.png cabal-version: >=1.18 -tested-with: GHC == 8.0.2, GHC == 8.4.1 +tested-with: GHC == 8.0.2, GHC == 8.2.2 library @@ -26,6 +26,7 @@ exposed-modules: Graphics.Rendering.Plot.Light Data.TimeSeries Graphics.Rendering.Plot.Light.PlotTypes + Graphics.Rendering.Plot.Light.Internal.Geometry other-modules: Graphics.Rendering.Plot.Light.Internal Graphics.Rendering.Plot.Light.Internal.Layout Graphics.Rendering.Plot.Light.PlotTypes.Heatmap @@ -33,7 +34,6 @@ Graphics.Rendering.Plot.Light.PlotTypes.Histogram Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries.Candlestick - Graphics.Rendering.Plot.Light.Internal.Geometry Graphics.Rendering.Plot.Light.Internal.Utils Data.Parsers build-depends: base >= 4.7 && < 5 @@ -44,7 +44,7 @@ , scientific , text , time - , data-default + , data-default-class -- -- * DEBUG -- , hspec -- , QuickCheck 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 @@ -139,33 +139,18 @@ axes, toPlot, FigureData(..), -- ** Element attributes LineStroke_(..), StrokeLineJoin_(..), TextAnchor_(..), LegendPosition_(..), + -- ** Operations on frames + frameFromPoints, frameFromFigData, mkFrame, mkFrameOrigin, width, height, figFWidth, figFHeight, -- ** Colour utilities blendTwo, palette, pickColour, -- ** SVG utilities - svgHeader, translateSvg, + svgHeader, translateSvg, toSvgFrame, toSvgFrameLP, -- * Types Frame(..), Point(..), LabeledPoint(..), labelPoint, mapLabel, Axis(..), - -- * Geometry - -- ** Vectors - V2(..), - -- ** Matrices - Mat2(..), DiagMat2(..), diagMat2, - -- ** Primitive elements - origin, e1, e2, - -- ** Vector norm operations - norm2, normalize2, - -- ** Vector construction - v2fromEndpoints, v2fromPoint, - -- ** Operations on points - movePoint, moveLabeledPointV2, moveLabeledPointBwFrames, (-.), toSvgFrame, toSvgFrameLP, pointRange, - -- ** Operations on vectors - frameToFrame, - -- ** Operations on frames - frameFromPoints, frameFromFigData, mkFrame, mkFrameOrigin, width, height, figFWidth, figFHeight, - -- ** Typeclasses - AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), -- ** Helpers - meshGrid, toFloat, wholeDecimal + meshGrid, + -- *** Misc. + toFloat, wholeDecimal ) where -- import qualified Data.Text as T 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,7 @@ -{-# LANGUAGE OverloadedStrings, DeriveFunctor #-} -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) where +{-# 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) + where import Data.Monoid ((<>)) import qualified Data.Foldable as F (toList) @@ -25,7 +27,9 @@ import qualified Data.Colour.SRGB as C 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 @@ -50,9 +54,10 @@ -- , figAxisStrokeWidth :: a -- | Tick label font size , figLabelFontSize :: Int - } deriving (Eq, Show, Functor) - + } 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 @@ -105,20 +110,48 @@ y0c = y0 - (hei / 2) - +-- | A square, defined by its center coordinates and side length squareCentered :: (Show a, RealFrac a) => - a - -> a - -> Maybe (C.Colour Double) - -> Maybe (C.Colour Double) - -> Point a + a -- ^ Side length + -> a -- ^ Stroke width + -> Maybe (C.Colour Double) -- ^ Stroke colour + -> Maybe (C.Colour Double) -- ^ Fill colour + -> Point a -- ^ Center coordinates -> Svg squareCentered w = rectCentered w w +newtype Col = Col { unCol :: C.Colour Double} deriving (Eq, Show, Generic) +instance Default Col where + def = Col C.blue +data LineOptions a = LineOptions { + loStrokeWidth :: a -- ^ Stroke width + , loStrokeType :: LineStroke_ a -- ^ Stroke type + , loColour :: Col -- ^ Stroke colour + } deriving (Eq, Show, Generic) +-- | 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 = + let + strTys = + 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] + nc = length cols + in + LineOptions <$> + repeat lw <*> + strTys <*> + cols + +instance (Default a, Num a) => Default (LineOptions a) where + def = LineOptions 2 def def + + -- | Line segment between two `Point`s -- -- > > putStrLn $ renderSvg $ line (Point 0 0) (Point 1 1) 0.1 Continuous C.blueviolet @@ -133,15 +166,21 @@ -> LineStroke_ a -- ^ Stroke type -> C.Colour Double -- ^ Stroke colour -> Svg -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 +line (Point x1 y1) (Point x2 y2) sw lstr col = + let + svg0 = 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) + in case lstr of Continuous -> svg0 + Dashed d -> svg0 ! strokeDashArray d + 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) +data LineStroke_ a = Continuous | Dashed [a] deriving (Eq, Show, Generic) +instance Default (LineStroke_ a) where + def = Continuous @@ -194,7 +233,7 @@ -> Int -- ^ Font size -> a -- ^ Label angle -> TextAnchor_ - -> (t -> T.Text) -- ^ Label rendering + -> (t -> T.Text) -- ^ Label rendering function -> V2 a -- ^ Label shift -> LabeledPoint t a -> Svg @@ -396,8 +435,11 @@ -> C.Colour Double -- ^ Stroke colour -> t (Point a) -- ^ Data -> Svg -polyline sw Continuous slj col lis = 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 sw (Dashed d) slj col lis = 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 +polyline sw strTy slj col lis = + let + svg0 = 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 + in case strTy of Continuous -> svg0 + Dashed d -> svg0 ! strokeDashArray d none :: S.AttributeValue none = S.toValue ("none" :: String) 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 @@ -3,12 +3,42 @@ This module provides functionality for working with affine transformations (i.e. in the unit square) -} -module Graphics.Rendering.Plot.Light.Internal.Geometry where +module Graphics.Rendering.Plot.Light.Internal.Geometry + ( + -- * Geometry + -- ** Point + Point(..), mkPoint, setPointX, setPointY, + -- ** LabeledPoint + LabeledPoint(..), mkLabeledPoint, labelPoint, moveLabeledPoint, mapLabel, + -- ** Frame + Frame(..), mkFrame, frameFromPoints, mkFrameOrigin, height, width, xmin, xmax, ymin, ymax, + -- ** Axis + Axis(..), otherAxis, + -- ** Vectors + V2(..), pointFromV2, + -- ** Matrices + Mat2(..), DiagMat2(..), diagMat2, + -- ** Primitive elements + origin, oneOne, e1, e2, + -- ** Vector norm operations + norm2, normalize2, + -- ** Vector construction + v2fromEndpoints, v2fromPoint, + -- ** Operations on points + movePoint, moveLabeledPointV2, moveLabeledPointBwFrames, (-.), pointRange, + -- ** Operations on vectors + frameToFrame, frameToFrameValue, + -- ** Typeclasses + AdditiveGroup(..), VectorSpace(..), Hermitian(..), LinearMap(..), MultiplicativeSemigroup(..), MatrixGroup(..), Eps(..), + -- ** Utilities + meshGrid, subdivSegment, interpolateBilinear + ) +where import Data.Monoid ((<>)) import GHC.Generics -import Data.Default +import Data.Default.Class @@ -91,7 +121,8 @@ _fpmax :: Point a } deriving (Eq, Show, Generic) -instance Default a => Default (Frame a) where +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, Num a) => Monoid (Frame a) where @@ -370,17 +401,9 @@ data MeshGrid a = MeshGrid (Frame a) Int Int deriving (Eq, Show, Generic) -instance Default a => Default (MeshGrid a) where +instance (Default a, Num a) => Default (MeshGrid a) where - --- subdivSegment --- :: (Enum a, RealFrac a) => a -> a -> Int -> [a] --- subdivSegment x1 x2 n = [xmin, xmin + dx ..] where --- dx = fromRational . toRational $ l / fromIntegral n --- xmin = min x1 x2 --- xmax = max x1 x2 --- l = xmax - xmin subdivSegment :: (Real a, Enum b, RealFrac b) => a -> a -> Int -> [b] subdivSegment x1 x2 n = f <$> [0, 1 ..] where diff --git a/test/LibSpec.hs b/test/LibSpec.hs --- a/test/LibSpec.hs +++ b/test/LibSpec.hs @@ -6,6 +6,7 @@ import Test.QuickCheck import Graphics.Rendering.Plot.Light +import Graphics.Rendering.Plot.Light.Internal.Geometry import Data.TimeSeries main :: IO ()