diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ + 0.2.9 + Bumped attoparsec-time to >= 1 to reflect module structure change diff --git a/app/timeseries/Main.hs b/app/timeseries/Main.hs --- a/app/timeseries/Main.hs +++ b/app/timeseries/Main.hs @@ -7,7 +7,7 @@ import Graphics.Rendering.Plot.Light.PlotTypes import qualified Data.Attoparsec.Text as A -import qualified Attoparsec.Time as AT +import qualified Attoparsec.Time.Text as AT import qualified Data.Text as T import qualified Data.Text.IO as T (readFile, writeFile) import Data.Scientific (Scientific, toRealFloat) diff --git a/doc/fig/scatter.png b/doc/fig/scatter.png deleted file mode 100644 Binary files a/doc/fig/scatter.png and /dev/null differ 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.2.7 +version: 0.2.9 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 general purpose 2D geometry library. homepage: https://github.com/ocramz/plot-light @@ -11,6 +11,7 @@ category: Graphics build-type: Simple extra-source-files: README.md + CHANGELOG.md extra-doc-files: doc/fig/*.png cabal-version: >=1.18 tested-with: GHC == 8.0.2 @@ -20,12 +21,13 @@ library default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -Wno-missing-signatures -Wno-type-defaults -Wno-name-shadowing hs-source-dirs: src exposed-modules: Graphics.Rendering.Plot.Light Data.TimeSeries Graphics.Rendering.Plot.Light.PlotTypes other-modules: Graphics.Rendering.Plot.Light.Internal + Graphics.Rendering.Plot.Light.Internal.Layout Graphics.Rendering.Plot.Light.PlotTypes.Heatmap Graphics.Rendering.Plot.Light.PlotTypes.Scatter Graphics.Rendering.Plot.Light.PlotTypes.Histogram @@ -34,17 +36,20 @@ Graphics.Rendering.Plot.Light.Internal.Geometry Graphics.Rendering.Plot.Light.Internal.Utils Data.Parsers - build-depends: base >= 4.7 && < 5 + build-depends: attoparsec + , base >= 4.7 && < 5 + , blaze-svg + , colour + , containers >= 0.5.7.1 , mtl - , time + , palette , scientific , text - , colour - , palette - , blaze-svg - , attoparsec - -- , hspec - -- , QuickCheck + , time + , data-default + -- * DEBUG + , hspec + , QuickCheck executable scatter @@ -68,7 +73,7 @@ build-depends: base , plot-light , attoparsec - , attoparsec-time + , attoparsec-time >= 1 , time , text , colour @@ -83,7 +88,6 @@ build-depends: base , plot-light , attoparsec - , attoparsec-time , time , text , colour 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 @@ -1,4 +1,4 @@ -{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, FlexibleInstances, DeriveGeneric #-} {- | This module provides functionality for working with affine transformations (i.e. in the unit square) @@ -7,12 +7,19 @@ import Data.Monoid ((<>)) +import GHC.Generics +import Data.Default + -- | A `Point` object defines a point in the plane data Point a = Point { _px :: a, - _py :: a } deriving (Eq) + _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 + instance Show a => Show (Point a) where show (Point x y) = show x ++ "," ++ show y @@ -23,10 +30,12 @@ lift2Point :: (a -> b -> c) -> Point a -> Point b -> Point c lift2Point f (Point a b) (Point c d) = Point (f a c) (f b d) -pointMin, pointMax :: (Ord a) => Point a -> Point a -> Point a -pointMin = lift2Point min -pointMax = lift2Point max +pointInf, pointSup :: (Ord a) => Point a -> Point a -> Point a +pointInf = lift2Point min +pointSup = lift2Point max + + -- | 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) @@ -65,12 +74,14 @@ data Frame a = Frame { _fpmin :: Point a, _fpmax :: Point a - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) +instance Default a => Default (Frame a) where + -- | 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 mempty = Frame (Point 0 0) (Point 0 0) - mappend (Frame p1min p1max) (Frame p2min p2max) = Frame (pointMin p1min p2min) (pointMax p1max p2max) + mappend (Frame p1min p1max) (Frame p2min p2max) = Frame (pointInf p1min p2min) (pointSup p1max p2max) mkFrame :: Point a -> Point a -> Frame a mkFrame = Frame @@ -297,6 +308,12 @@ [Point x y | x <- take nx $ subdivSegment xmi xma nx, y <- take ny $ subdivSegment ymi yma ny] + +data MeshGrid a = MeshGrid (Frame a) Int Int deriving (Eq, Show, Generic) + +instance Default a => Default (MeshGrid a) where + + -- subdivSegment -- :: (Enum a, RealFrac a) => a -> a -> Int -> [a] diff --git a/src/Graphics/Rendering/Plot/Light/Internal/Layout.hs b/src/Graphics/Rendering/Plot/Light/Internal/Layout.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/Plot/Light/Internal/Layout.hs @@ -0,0 +1,105 @@ +{-# language TypeFamilies, DeriveFunctor #-} +module Graphics.Rendering.Plot.Light.Internal.Layout where + +import qualified Data.IntMap as IM + +import Graphics.Rendering.Plot.Light.Internal.Geometry +import Graphics.Rendering.Plot.Light.Internal + +import qualified Data.Colour as C +import qualified Data.Text as T + + +{- | + +YADG : Yet another DSL for graphics + +Design : + +* add dataset to Plot +* add Plot to WindowState (e.g. side by side plots, inset ... by specifying a RelativeFrame for it) +* compute all viewpanes (i.e. `to` frames) +* compute data transformations from viewpanes + +-} + +data PlotType = HeatMap | Scatter | TimeSeries + + + + +-- | A `RelativeFrame` is given by two set of parameters: +-- +-- 0 <= `rfX`, `rfY` <= 1 : normalized coordinates of the anchor point (top-left corner) +-- 0 <= `rfHeight`, `rfWidth` <= 1 : normalized width and height +data RelativeFrame a = RelFrame + { rfX :: a + , rfY :: a + , rfWidth :: a + , rfHeight :: a + } deriving (Eq, Show) + +mkRelativeFrame :: (Ord a, Num a) => a -> a -> a -> a -> RelativeFrame a +mkRelativeFrame x y w h + | all bounded01 [x,y,w,h] = RelFrame x y w h + | otherwise = RelFrame 0 0 1 1 + +bounded01 :: (Ord a, Num a) => a -> Bool +bounded01 x = 0 <= x && x <= 1 + + +-- data PlotAxis a = PlotAxis +-- { axType :: Axis +-- , axColour :: C.Colour Double +-- , axLabelFontSize :: Int +-- , axRangeMin :: a +-- , axRangeMax :: a +-- , axNTicks :: Int +-- , axTicks :: a -> T.Text -- `a` is position parameter `0 <= lambda <= 1` +-- } + +-- data Plot c a = Plot +-- { plRelativeFrame :: RelativeFrame a +-- , plAxisX :: PlotAxis a +-- , plAxisY :: PlotAxis a +-- , plContents :: c +-- } + + + + + + + +-- data Window c a = W +-- { wWidth :: a +-- , wHeight :: a +-- , wState :: IM.IntMap (IM.IntMap (Plot c a)) +-- } + +-- data Layout c a s = +-- AddPlot (Window c a) (RelativeFrame a) (Window c a -> s) +-- deriving Functor + + + + +-- addPlot +-- :: Window c a -> RelativeFrame a -> Free (Layout c a) (Window c a) +-- addPlot w rf = liftF (AddPlot w rf id) + + + + +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 diff --git a/src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs b/src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs --- a/src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs +++ b/src/Graphics/Rendering/Plot/Light/PlotTypes/Scatter.hs @@ -35,21 +35,21 @@ -- 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) - -> (l -> b -> a) - -> (l -> C.Colour Double -> C.Colour Double) - -> ScatterPointData b - -> t (LabeledPoint l 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) scatterLP1 :: (Show a, RealFrac a) => - (l -> b -> a) - -> (l -> b -> a) - -> (l -> C.Colour Double -> C.Colour Double) - -> ScatterPointData b + (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) @@ -61,16 +61,16 @@ scatterLPBar :: (RealFrac t, Enum t, RealFrac b, Show b) => FigureData b - -> b - -> t - -> t - -> Int - -> LegendPosition_ - -> b - -> (t -> b -> b) - -> (t -> b -> b) - -> (t -> C.Colour Double -> C.Colour Double) - -> ScatterPointData 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 wglyph = spSize spdat 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 @@ -2,24 +2,24 @@ {-# language FlexibleContexts #-} module Graphics.Rendering.Plot.Light.PlotTypes.TimeSeries where -import Control.Monad (forM, forM_) +import Control.Monad (forM_) -import GHC.Real -import Data.Fixed (Pico) -import Data.Time -import Data.Scientific +-- import GHC.Real +-- import Data.Fixed (Pico) +-- import Data.Time +-- import Data.Scientific import qualified Data.Text as T import Graphics.Rendering.Plot.Light.Internal -import Graphics.Rendering.Plot.Light.Internal.Utils +-- import Graphics.Rendering.Plot.Light.Internal.Utils import Data.TimeSeries -- For debugging import Text.Blaze.Svg import qualified Data.Colour as C import qualified Data.Colour.Names as C -import Text.Blaze.Svg.Renderer.String (renderSvg) +-- import Text.Blaze.Svg.Renderer.String (renderSvg) @@ -29,24 +29,9 @@ -- 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 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 --- 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 -- :: (Functor t, Foldable t, Show a, RealFrac a) => -- FigureData a