interactive-plot (empty) → 0.1.0.0
raw patch · 10 files changed
+1329/−0 lines, 10 filesdep +MonadRandomdep +basedep +containerssetup-changed
Dependencies added: MonadRandom, base, containers, data-default-class, interactive-plot, microlens, microlens-th, mtl, transformers, vty
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- README.md +61/−0
- Setup.hs +2/−0
- app/demo.hs +15/−0
- interactive-plot.cabal +65/−0
- src/Interactive/Plot.hs +51/−0
- src/Interactive/Plot/Core.hs +539/−0
- src/Interactive/Plot/Run.hs +402/−0
- src/Interactive/Plot/Series.hs +161/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# Changelog for interactive-plot++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Justin Le (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Justin Le nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,61 @@+[interactive-plot][]+====================++[interactive-plot]: https://hackage.haskell.org/package/interactive-plot++Quick time series terminal plotting for data exploration/in ghci.++Most commonly used imports should be available in *Interactive.Plot*.++Construct a `Series` from scratch using the raw data type, or use one of the+handy helpers:++1. `listSeries`: Create a series from a list or any foldable.+2. `tupleSeries`: Create a series from a list of ordered-pair tuples providing+ x and y locations.+3. `funcSeries`: Create a series from a function `Double -> Double`, given a+ range of `x`s to produce the `y`s.++Then simply "run" a list of series (or "automatic-styled series") using+`runPlotAuto` or `runPlot`:++```haskell+runPlotAuto+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts')+ -> Maybe String -- ^ optional title+ -> [AutoSeries] -- ^ uninitialized data of serieses+ -> IO ()+```++++These plots can be zoomed, stretched, scaled, panned interactively after+launch. If you quit, things resume back to the ghci session (or whatever point+in the program you launch from).++There are also options for rudimentary animations:++```haskell+animatePlot+ :: PlotOpts+ -> Double -- ^ update rate (frames per second)+ -> Maybe String -- ^ title+ -> [[Series]] -- ^ list of series data (potentially infinite)+ -> IO ()++animatePlotFunc+ :: PlotOpts+ -> Maybe String -- ^ title+ -> (Double -> Maybe [Series]) -- ^ function from time to plot. will quit+ -- as soon as 'Nothing' is returned.+ -> IO ()+```++++Todo+----++* Consider being able to use functions directly as a series, instead of+ converting them into ordered pairs based on a known x series.+* I'm sure usability could always be improved :)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/demo.hs view
@@ -0,0 +1,15 @@+import Interactive.Plot++cosTest, lineTest :: AutoSeries+cosTest = funcSeries cos (enumRange 100 (R (-5) 5)) mempty+lineTest = funcSeries id (enumRange 20 (R (-4) 4)) mempty++sinTest :: Double -> AutoSeries+sinTest t = funcSeries (sin . (+ t)) (enumRange 100 (R (-5) 5)) mempty++main :: IO ()+main = do+ runPlotAuto defaultPlotOpts (Just "simple test") [cosTest, lineTest]+ animatePlotFunc (defaultPlotOpts { _poFramerate = Just 20 }) (Just "animate test") $+ Just . fromAutoSeries . (:[]) . sinTest+
+ interactive-plot.cabal view
@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: cf947ccf209af0eda27250773d3b66c1d51014c28562f3bcaa6fd42224cd4074++name: interactive-plot+version: 0.1.0.0+synopsis: Interactive quick time series plotting+description: Quick time series terminal plotting for data exploration/in ghci. See+ documentation for "Interactive.Plot" and README for more information.+category: Interactive+homepage: https://github.com/mstksg/interactive-plot#readme+bug-reports: https://github.com/mstksg/interactive-plot/issues+author: Justin Le+maintainer: justin@jle.im+copyright: (c) Justin Le 2018+license: BSD3+license-file: LICENSE+tested-with: GHC >= 8.4 && < 8.8+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/mstksg/interactive-plot++library+ exposed-modules:+ Interactive.Plot+ Interactive.Plot.Core+ Interactive.Plot.Run+ Interactive.Plot.Series+ other-modules:+ Paths_interactive_plot+ hs-source-dirs:+ src+ ghc-options: -Wall -Wredundant-constraints -Werror=incomplete-patterns -Wcompat+ build-depends:+ MonadRandom+ , base >=4.11 && <5+ , containers >=0.5.11+ , data-default-class+ , microlens+ , microlens-th+ , mtl+ , transformers+ , vty+ default-language: Haskell2010++executable interactive-plot-demo+ main-is: demo.hs+ other-modules:+ Paths_interactive_plot+ hs-source-dirs:+ app+ ghc-options: -Wall -Wredundant-constraints -Werror=incomplete-patterns -Wcompat -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.11 && <5+ , interactive-plot+ default-language: Haskell2010
+ src/Interactive/Plot.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE PatternSynonyms #-}++-- |+-- Module : Interative.Plot+-- Copyright : (c) Justin Le 2018+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Simple interactive rendering of plots. See README for information on+-- usage.+--+-- The main way to use this library is to use 'runPlotAuto' or 'runPlot' on+-- some series you make using the series constructors ('listSeries',+-- 'funcSeries', etc.)+--+module Interactive.Plot (+ -- * Construct Series+ Auto(..)+ , Series, AutoSeries, SeriesF(..), sItems, sStyle+ -- ** Making common serieses+ , listSeries+ , tupleSeries+ , funcSeries+ , enumRange+ , toCoordMap+ , fromCoordMap+ -- ** Series from AutoSeroes+ , fromAutoSeries+ , fromAutoSeriesIO+ , fromAutoSeries_+ -- ** Types+ , PointStyle, pattern PointStyle, _psMarker, _psColor, AutoPointStyle, PointStyleF(..), psMarker, psColor+ , Coord(..), cX, cY+ , Range(..), _rMid, _rSize', rMin, rMax, rSize, rMid, _rSize+ -- * Run a Plot+ , runPlot+ , runPlotAuto+ -- ** Animated+ , animatePlot, lastForever+ , animatePlotFunc+ -- ** Options+ , PlotOpts(..), poTermRatio, poAspectRatio, poXRange, poYRange, poRange, poAutoMethod, poHelp, poFramerate, poDelay+ , defaultPlotOpts+ ) where++import Interactive.Plot.Core+import Interactive.Plot.Run+import Interactive.Plot.Series
+ src/Interactive/Plot/Core.hs view
@@ -0,0 +1,539 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : Interative.Plot.Core+-- Copyright : (c) Justin Le 2018+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Core rendering functionality for the library.+--+module Interactive.Plot.Core (+ Coord(..), cX, cY+ , Range(.., RAbout), _rMid, _rSize', rMin, rMax, rSize, rMid, _rSize+ , Auto(..)+ , PointStyle, pattern PointStyle, _psMarker, _psColor, PointStyleF(..), AutoPointStyle, psMarker, psColor+ , Series, SeriesF(..), AutoSeries, sItems, sStyle, toCoordMap, fromCoordMap+ , Alignment(..)+ , PlotOpts(..), poTermRatio, poAspectRatio, poXRange, poYRange, poRange, poAutoMethod, poHelp, poFramerate, poDelay, poDescription+ , defaultPlotOpts+ , renderPlot+ -- * Internal+ , plotRange+ , OrdColor(..)+ , renderPoint+ , hzToDelay+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Random+import Data.Coerce+import Data.Default.Class+import Data.Foldable+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Maybe+import Data.Ord+import GHC.Generics (Generic)+import Graphics.Vty hiding ((<|>))+import Lens.Micro+import Lens.Micro.TH+import Text.Printf+import qualified Data.Map as M+import qualified Data.Set as S++-- | Newtype wrapper providing an 'Ord' instance for 'Color'.+newtype OrdColor = OC { getOC :: Color }+ deriving Eq++instance Ord OrdColor where+ compare = coerce compareColor+ where+ compareColor = \case+ ISOColor c -> \case+ ISOColor d -> compare c d+ Color240 _ -> LT+ Color240 c -> \case+ ISOColor _ -> GT+ Color240 d -> compare c d++-- | An ordered pair in @a@.+data Coord a = C { _cX :: a -- ^ Access @x@.+ , _cY :: a -- ^ Access @y@.+ }+ deriving (Show, Functor, Foldable, Traversable, Eq, Ord)++-- | Getter/setter lens to the @x@ position in a 'Coord'.+cX :: Lens' (Coord a) a+cX f (C x y) = (`C` y) <$> f x++-- | Getter/setter lens to the @x@ position in a 'Coord'.+cY :: Lens' (Coord a) a+cY f (C x y) = C x <$> f y++instance Num a => Num (Coord a) where+ (+) = liftA2 (+)+ (-) = liftA2 (-)+ (*) = liftA2 (*)+ negate = fmap negate+ abs = fmap abs+ signum = fmap signum+ fromInteger = pure . fromInteger++instance Applicative Coord where+ pure x = C x x+ C f g <*> C x y = C (f x) (g y)++-- | Basically the same as @Reader 'Bool'@, for @x@ and @y@.+instance Monad Coord where+ return x = C x x+ C x y >>= f = C (_cX (f x)) (_cY (f y))++-- | A specification for a range. Using 'R', contains the minimum and+-- maximum. Using 'RAbout', contains the midpoint and size.+data Range a = R { _rMin :: a -- ^ Minimum of range.+ , _rMax :: a -- ^ Maximum of range.+ }+ deriving (Show, Functor, Foldable, Traversable)+++-- | Getter/setter lens to the minimum value in a 'Range'.+rMin :: Lens' (Range a) a+rMin f (R x y) = (`R` y) <$> f x++-- | Getter/setter lens to the maximum value in a 'Range'.+rMax :: Lens' (Range a) a+rMax f (R x y) = R x <$> f y++-- | "Zipping" behavior on minimum and maximum+instance Applicative Range where+ pure x = R x x+ R f g <*> R x y = R (f x) (g y)++-- | Basically the same as @Reader 'Bool'@, for minimum and maximum+-- fields.+instance Monad Range where+ return x = R x x+ R x y >>= f = R (_rMin (f x)) (_rMax (f y))++-- | Used to specify fields in 'PointStyle' and 'Series': Use 'Auto' for+-- automatic inference, and 'Given' to provide a specific value.+--+-- Its 'Semigroup' instance keeps the last 'Given'.+data Auto a = Auto | Given a+ deriving (Show, Eq, Ord, Generic, Functor)++-- | Keeps the final 'Given': like 'Data.Monoid.Last'+instance Semigroup (Auto a) where+ (<>) = \case+ Auto -> id+ Given x -> \case Auto -> Given x; Given y -> Given y++instance Monoid (Auto a) where+ mempty = Auto+ mappend = (<>)++instance Applicative Auto where+ pure = Given+ (<*>) = \case+ Auto -> const Auto+ Given f -> \case+ Auto -> Auto+ Given x -> Given (f x)++instance Monad Auto where+ return = Given+ (>>=) = \case+ Auto -> const Auto+ Given x -> ($ x)++-- | Opposite behavior of 'Semigroup' instance: like 'Maybe's 'Alternative'+-- instance, or 'Data.Monoid.First'.+instance Alternative Auto where+ empty = Auto+ (<|>) = \case+ Auto -> id+ Given x -> const (Given x)++-- | Opposite behavior of 'Semigroup' instance: like 'Maybe's 'Alternative'+-- instance, or 'Data.Monoid.First'.+instance MonadPlus Auto++-- | A parameterized version of 'PointStyle' to unify functions in+-- "Interactive.Plot.Series".+--+-- Mainly you will be using either 'PointStyle' or 'AutoPointStyle'.+data PointStyleF f = PointStyleF+ { _psMarkerF :: f Char -- ^ Marker character.+ , _psColorF :: f Color -- ^ Marker color.+ }+ deriving (Generic)++-- | Getter/setter lens to the marker field of a 'PointStyleF'+psMarkerF :: Lens' (PointStyleF f) (f Char)+psMarkerF f (PointStyleF x y) = (`PointStyleF` y) <$> f x++-- | Getter/setter lens to the color field of a 'PointStyleF'+psColorF :: Lens' (PointStyleF f) (f Color)+psColorF f (PointStyleF x y) = PointStyleF x <$> f y++-- | Specification of a style for a point.+--+-- Construct this wiht the 'PointStyle' pattern synonym.+type PointStyle = PointStyleF Identity++-- | A version of 'PointStyle' where you can leave the marker or color+-- blank, to be automatically inferred.+--+-- You can construct this with the 'PointStyleF' constructor.+--+-- It has a very convenient 'Monoid' instance: 'mempty' gives+-- a 'PointStyle' where every field is 'Auto', and '<>' combines+-- 'PointStyle's field-by-field, keeping the last 'Given'.+type AutoPointStyle = PointStyleF Auto++-- | Pattern synonym/constructor for 'PointStyle'.+--+-- This comes with two record fields, '_psMarker' and '_psColor'.+pattern PointStyle :: Char -> Color -> PointStyle+pattern PointStyle { _psMarker, _psColor } = PointStyleF (Identity _psMarker) (Identity _psColor)+{-# COMPLETE PointStyle #-}++instance (Semigroup (f Char), Semigroup (f Color)) => Semigroup (PointStyleF f) where+ PointStyleF m1 c1 <> PointStyleF m2 c2 = PointStyleF (m1 <> m2) (c1 <> c2)+instance (Monoid (f Char), Monoid (f Color)) => Monoid (PointStyleF f) where+ mempty = PointStyleF mempty mempty++deriving instance (Show (f Char), Show (f Color)) => Show (PointStyleF f)+deriving instance (Eq (f Char), Eq (f Color)) => Eq (PointStyleF f)+instance (Ord (f Char), Ord (f OrdColor), Functor f, Eq (f Color)) => Ord (PointStyleF f) where+ compare = comparing $ \case PointStyleF m1 c1 -> (m1, OC <$> c1)++_Identity :: Lens (Identity a) (Identity b) a b+_Identity f (Identity x) = Identity <$> f x++psMarker :: Lens' PointStyle Char+psMarker = psMarkerF . _Identity++psColor :: Lens' PointStyle Color+psColor = psColorF . _Identity++-- | A parameterized version of 'Series' to unify functions in+-- "Interactive.Plot.Series".+--+-- Mainly you will be using either 'Series' or 'AutoSeries'.+data SeriesF f = Series { _sItems :: M.Map Double (S.Set Double) -- ^ A map of @x@ positions to @y@ points at that position+ , _sStyle :: PointStyleF f -- ^ The style of points. For 'Series', this is 'PointStyle'; for 'AutoSeries', this is 'AutoPointStyle'.+ }++deriving instance (Show (f Char), Show (f Color)) => Show (SeriesF f)++-- | Data for a single series: contains the coordinate map with the point+-- style for the series.+type Series = SeriesF Identity++-- | A version of 'Series' where you can leave the marker or color blank,+-- to be automatically inferred.+type AutoSeries = SeriesF Auto++-- | Getter/setter lens to the items field of a 'SeriesF'+sItems :: Lens' (SeriesF f) (M.Map Double (S.Set Double))+sItems f (Series x y) = (`Series` y) <$> f x++-- | Getter/setter lens to the style field of a 'SeriesF'+--+-- @+-- 'sStyle' :: Lens 'Series' 'PointStyle'+-- 'sStyle' :: Lens 'AutoSeries' 'AutoPointStyle'+-- @+sStyle :: Lens' (SeriesF f) (PointStyleF f)+sStyle f (Series x y) = Series x <$> f y++-- | Alignment specification.+data Alignment = ALeft+ | ACenter+ | ARight++-- | Options used for running the plot interactively in a terminal.+data PlotOpts = PO+ { _poTermRatio :: Double -- ^ character width ratio of terminal (H/W). Default is 2.1.+ , _poAspectRatio :: Maybe Double -- ^ plot aspect ratio (H/W). Use 'Nothing' for automatic. Default is @'Just' 1@.+ , _poXRange :: Maybe (Range Double) -- ^ X Range. Use 'Nothing' for automatic. Default is 'Nothing'.+ , _poYRange :: Maybe (Range Double) -- ^ Y Range. Use 'Nothing' for automatic. Default is 'Nothing'.+ , _poAutoMethod :: Maybe StdGen -- ^ How to fill in missing+ -- values when run using+ -- 'Interactive.Plot.Run.runPlotAuto'.+ -- 'Nothing' for IO, 'Just'+ -- for deterministic seed.+ -- Ignored when using+ -- 'Interactive.Plot.Run.runPlot'.+ -- Default is an arbitrarily+ -- selected seed.+ , _poHelp :: Bool -- ^ Whether or not to show help box initially. Box can always be toggled with @?@. (Default is 'True')+ , _poFramerate :: Maybe Double -- ^ Updates per second; 'Nothing' for no updates. Use 'poDelay' to treat this as a microsecond delay instead. (default: 'Nothing')+ , _poDescription :: Maybe Image -- ^ Initial extra information in description box. Ignored if directly using 'runPlotDynamic'. Default is 'Nothing'+ }++makeLenses ''PlotOpts++-- | Sensible defaults for most terminals.+defaultPlotOpts :: PlotOpts+defaultPlotOpts = PO+ { _poTermRatio = 2.1+ , _poAspectRatio = Just 1+ , _poXRange = Nothing+ , _poYRange = Nothing+ , _poAutoMethod = Just $ mkStdGen 28922710942259+ , _poHelp = True+ , _poFramerate = Nothing+ , _poDescription = Nothing+ }++instance Default PlotOpts where+ def = defaultPlotOpts++-- | An alternative "constructor" for 'R', which takes a midpoint and size+-- instead of a min and max.+--+-- This comes with record fields, '_rMid' and '_rSize''.+pattern RAbout :: Fractional a => a -> a -> Range a+pattern RAbout { _rMid, _rSize' } <- (\case R{..} -> ((_rMin + _rMax) / 2, _rMax - _rMin)->(_rMid, _rSize'))+ where+ RAbout rM rS = R (rM - rS2) (rM + rS2)+ where+ rS2 = rS / 2+{-# COMPLETE RAbout #-}++-- | Gets the size of a 'Range'.+--+-- A version of '_rSize'' that works for any instance of 'Num'.+_rSize :: Num a => Range a -> a+_rSize R{..} = _rMax - _rMin++-- | Lens into the size of a 'Range' Modifying this size results in+-- a scaling about the midpoint of the range.+--+-- @+-- view rSize (R 2 4)+-- -- 2+-- over rSize (* 2) (R 2 4)+-- -- R 1 5+-- @+rSize :: Fractional a => Lens' (Range a) a+rSize f (RAbout m s) = RAbout m <$> f s++-- | Lens into the midpoint of a 'Range'. Modifying this midpoint shifts+-- the range to a new midpoint, preserving the size.+--+-- @+-- view rMid (R 2 4)+-- -- 3+-- over rMid (+ 3) (R 2 4)+-- -- R 5 7+-- @+rMid :: Fractional a => Lens' (Range a) a+rMid f (RAbout m s) = (`RAbout` s) <$> f m++-- | Check if a point is within the 'Range' (inclusive).+within :: Ord a => a -> Range a -> Bool+within x r = x >= r ^. rMin && x <= r ^. rMax++-- | Lens into a 'PlotOpts' getting its range X and range Y settings.+poRange :: Lens' PlotOpts (Maybe (Range Double), Maybe (Range Double))+poRange f (PO r a x y s h t d) = (\(x', y') -> PO r a x' y' s h t d) <$> f (x, y)++-- | Lens into microsecond delay between frames, specified by a 'PlotOpts'.+poDelay :: Lens' PlotOpts (Maybe Int)+poDelay = poFramerate . hzToDelay++-- | Used for 'poDelay': a lens into a microsecond delay given+-- a framerate. Should technically be an isomorphism, but this isn't+-- supported by microlens.+hzToDelay :: Lens' (Maybe Double) (Maybe Int)+hzToDelay f md = fmap back <$> f (fmap forward md)+ where+ back d = 1000000 / fromIntegral d+ forward p = round $ 1000000 / p++-- | Compute plot axis ranges based on a list of points and the size of the+-- display region.+plotRange+ :: PlotOpts+ -> Coord (Range Int) -- ^ display region+ -> [Series] -- ^ Points+ -> Coord (Range Double) -- ^ actual plot axis range+plotRange PO{..} dr ss = case _poAspectRatio of+ Just rA ->+ let displayRatio = fromIntegral (dr ^. cY . to _rSize)+ / (fromIntegral (dr ^. cX . to _rSize) / _poTermRatio)+ * rA+ in case (_poXRange, _poYRange) of+ (Nothing, Nothing) -> case compare pointRangeRatio displayRatio of+ LT -> pointRange+ & cY . rSize .~ pointRange ^. cX . rSize * displayRatio+ EQ -> pointRange+ GT -> pointRange+ & cX . rSize .~ pointRange ^. cY . rSize / displayRatio+ (Just x , Nothing) -> pointRange+ & cX .~ x+ & cY . rSize .~ x ^. rSize * displayRatio+ (Nothing, Just y ) -> pointRange+ & cX . rSize .~ y ^. rSize / displayRatio+ & cY .~ y+ (Just x , Just y ) -> C x y+ Nothing -> case (_poXRange, _poYRange) of+ (Nothing, Nothing) -> pointRange+ (Just x , Nothing) -> pointRange & cX .~ x+ (Nothing, Just y ) -> pointRange & cY .~ y+ (Just x , Just y ) -> C x y+ where+ unZero :: Range Double -> Range Double+ unZero r+ | r ^. rSize == 0 = R (subtract 1) (+ 1) <*> r+ | otherwise = r+ pointRangeRatio :: Double+ pointRangeRatio = pointRange ^. cY . rSize / pointRange ^. cX . rSize+ -- TODO: can this be computed only for points in view?+ pointRange :: Coord (Range Double)+ pointRange = fmap unZero+ . foldl' (liftA2 go) (C (R 0 0) (R 0 0))+ $ ss ^.. traverse . sItems . folding fromCoordMap+ where+ go oldR x = R min max <*> pure x <*> oldR++-- | Render serieses based on a display region and plot axis ranges.+renderPlot+ :: Coord (Range Int) -- ^ display region+ -> Coord (Range Double) -- ^ plot axis range+ -> [Series]+ -> [Image]+renderPlot dr pr = overlayAxis dr pr+ . concatMap (renderSeries dr pr)++overlayAxis+ :: Coord (Range Int) -- ^ display region+ -> Coord (Range Double) -- ^ plot axis range+ -> [Image] -- ^ thing to overlay over+ -> [Image]+overlayAxis dr pr is = foldMap toList axisBounds ++ is ++ axisLines+ where+ origin = placeImage dr pr (C ACenter ACenter) (C 0 0) $+ char defAttr '+'+ xAxis = placeImage dr pr (C ALeft ACenter) (C (pr ^. cX . rMin) 0 ) $+ charFill defAttr '-' (dr ^. cX . to _rSize) 1+ yAxis = placeImage dr pr (C ACenter ALeft ) (C 0 (pr ^. cY . rMax)) $+ charFill defAttr '|' 1 (dr ^. cY . to _rSize)+ axisLines = [origin, xAxis, yAxis]+ axisBounds :: Coord (Range Image)+ axisBounds = getCompose $ do+ pos <- Compose pr+ coords <- Compose $ C (pure $ \d -> C d 0) (pure $ \d -> C 0 d)+ xAlign <- Compose $ C (R ALeft ARight ) (R ACenter ACenter)+ yAlign <- Compose $ C (R ACenter ACenter) (R ARight ALeft )+ pure $ placeImage dr pr (C xAlign yAlign) (coords pos)+ (string defAttr $ printf "%.2f" pos)++placeImage+ :: Coord (Range Int) -- ^ Display region+ -> Coord (Range Double) -- ^ Plot axis range+ -> Coord Alignment -- ^ Alignment+ -> Coord Double -- ^ Position in plot space+ -> Image -- ^ Image to place+ -> Image+placeImage dr pr (C aX aY) r i = translate x' (dr ^. cY . to _rSize - y') i+ where+ dr' = (fmap . fmap) fromIntegral dr+ scaled = lerp <$> pr <*> dr' <*> r+ C x' y' = (round <$> scaled) + C (aligner aX (imageWidth i))+ (negate (aligner aY (imageHeight i)))+ aligner = \case+ ALeft -> const 0+ ACenter -> negate . (`div` 2)+ ARight -> negate++lerp+ :: Fractional a+ => Range a -- ^ input range+ -> Range a -- ^ output range+ -> a+ -> a+lerp rOld rNew x =+ rNew ^. rMin + (x - rOld ^. rMin) / (rOld ^. rSize) * (rNew ^. rSize)++-- | Render a single series as a set of points.+renderSeries+ :: Coord (Range Int) -- ^ Display region+ -> Coord (Range Double) -- ^ Plot axis range+ -> Series -- ^ Series to plot+ -> [Image]+renderSeries dr pr Series{..} =+ M.foldMapWithKey (\x -> foldMap (maybeToList . go . C x))+ $ validPoints pr _sItems+ where+ go :: Coord Double -> Maybe Image+ go r = placeImage dr pr (C ACenter ACenter) r (renderPoint _sStyle)+ <$ guard (and $ within <$> r <*> pr)++validPoints+ :: Ord k+ => Coord (Range k)+ -> M.Map k (S.Set k)+ -> M.Map k (S.Set k)+validPoints pr = fmap (setRange (pr ^. cY))+ . mapRange (pr ^. cX)+ where+ mapRange r m = M.unions $ m''+ : maybeToList (M.singleton (r ^. rMin) <$> mMin)+ ++ maybeToList (M.singleton (r ^. rMax) <$> mMax)+ where+ (_ , mMin, m') = M.splitLookup (r ^. rMin) m+ (m'', mMax, _ ) = M.splitLookup (r ^. rMax) m'+ setRange r s = S.unions $ s''+ : (S.singleton (r ^. rMin) <$ guard sMin)+ ++ (S.singleton (r ^. rMax) <$ guard sMax)+ where+ (_ , sMin, s') = S.splitMember (r ^. rMin) s+ (s'', sMax, _ ) = S.splitMember (r ^. rMax) s'++-- | Turn a set of coordinates into a map of x's to the y's found in+-- the set.+--+-- Note that this forms an isomorphism with 'fromCoordMap'.+toCoordMap+ :: Eq a+ => S.Set (Coord a)+ -> M.Map a (S.Set a)+toCoordMap = fmap (S.fromDistinctAscList . ($ []))+ . M.fromAscListWith (.)+ . foldMap (\case C x y -> [(x, (y:))])++-- | Convert a map of x's to y's into a set of x-y coordinates.+--+-- Note that this forms an isomorphism with 'toCoordMap'.+fromCoordMap+ :: M.Map a (S.Set a)+ -> S.Set (Coord a)+fromCoordMap = S.fromDistinctAscList+ . M.foldMapWithKey (\k -> foldMap ((:[]) . C k))++-- | Render a single according to a 'PointStyle'.+renderPoint+ :: PointStyle+ -> Image+renderPoint PointStyle{..} = char (defAttr `withForeColor` _psColor) _psMarker
+ src/Interactive/Plot/Run.hs view
@@ -0,0 +1,402 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : Interative.Plot.Run+-- Copyright : (c) Justin Le 2018+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Run plots interactively in the terminal.+module Interactive.Plot.Run (+ -- * Simple+ runPlot+ , runPlotAuto+ -- * Animated+ , animatePlot, lastForever+ , animatePlotFunc+ , animatePlotMoore, Moore(..)+ -- * Custom+ , runPlotDynamic+ , PlotData(..), pdTitle, pdSerieses, pdDesc++ ) where++import Control.Applicative+import Control.Concurrent+import Control.Monad+import Control.Monad.Trans.Maybe+import Data.Foldable+import Data.IORef+import Data.List+import Data.Maybe+import Graphics.Vty hiding ((<|>))+import Interactive.Plot.Core+import Interactive.Plot.Series+import Lens.Micro+import Lens.Micro.TH+import Text.Printf+import qualified Data.List.NonEmpty as NE++data PEvent = PEQuit+ | PEZoom (Coord Double)+ | PEPan (Coord Double)+ | PEResize (Coord Int)+ | PEHelp+ | PEReset+ | PETick++processEvent :: Event -> Maybe PEvent+processEvent = \case+ EvKey KEsc [] -> Just PEQuit+ EvKey (KChar 'c') [MCtrl] -> Just PEQuit+ EvKey (KChar 'q') [] -> Just PEQuit+ EvKey (KChar 'r') [] -> Just PEReset+ EvKey (KChar 'R') [] -> Just PEReset+ EvKey (KChar '=') [] -> Just $ PEZoom (C (sqrt 0.5) (sqrt 0.5))+ EvKey (KChar '+') [] -> Just $ PEZoom (C (sqrt 0.5) (sqrt 0.5))+ EvKey (KChar '-') [] -> Just $ PEZoom (C (sqrt 2 ) (sqrt 2 ))+ EvKey (KChar '_') [] -> Just $ PEZoom (C (sqrt 2 ) (sqrt 2 ))+ EvKey (KChar 'h') [] -> Just $ PEPan (C (-0.2) 0 )+ EvKey (KChar 'j') [] -> Just $ PEPan (C 0 (-0.2))+ EvKey (KChar 'k') [] -> Just $ PEPan (C 0 0.2 )+ EvKey (KChar 'l') [] -> Just $ PEPan (C 0.2 0 )+ EvKey (KChar 'w') [] -> Just $ PEPan (C (-0.2) 0 )+ EvKey (KChar 'a') [] -> Just $ PEPan (C 0 (-0.2))+ EvKey (KChar 's') [] -> Just $ PEPan (C 0 0.2 )+ EvKey (KChar 'd') [] -> Just $ PEPan (C 0.2 0 )+ EvKey KLeft [] -> Just $ PEPan (C (-0.2) 0 )+ EvKey KDown [] -> Just $ PEPan (C 0 (-0.2))+ EvKey KUp [] -> Just $ PEPan (C 0 0.2 )+ EvKey KRight [] -> Just $ PEPan (C 0.2 0 )+ EvKey (KChar 'v') [] -> Just $ PEZoom (C 1 (sqrt 2 ))+ EvKey (KChar '^') [] -> Just $ PEZoom (C 1 (sqrt 0.5))+ EvKey (KChar '<') [] -> Just $ PEZoom (C (sqrt 2 ) 1 )+ EvKey (KChar '>') [] -> Just $ PEZoom (C (sqrt 0.5) 1 )+ EvKey (KChar '?') [] -> Just PEHelp+ EvKey (KChar '/') [] -> Just PEHelp+ EvResize ht wd -> Just $ PEResize (C ht wd)+ _ -> Nothing++data PlotState = PlotState+ { _psRange :: Coord (Range Double)+ , _psHelp :: Bool+ }++makeClassy ''PlotState++displayRange :: Output -> IO (Coord (Range Int))+displayRange o = do+ (wd, ht) <- displayBounds o+ pure $ C (R 0 wd) (R 0 ht)++-- | Dynamically adjustable plot data.+data PlotData = PlotData+ { _pdTitle :: Maybe String+ , _pdDesc :: Maybe Image+ , _pdSerieses :: [Series]+ }++-- | Getter/setter lens to the title field of a 'PlotData'+pdTitle :: Lens' PlotData (Maybe String)+pdTitle f (PlotData x y z) = (\x' -> PlotData x' y z) <$> f x++-- | Getter/setter lens to the description box field of a 'PlotData'+pdDesc :: Lens' PlotData (Maybe Image)+pdDesc f (PlotData x y z) = (\y' -> PlotData x y' z) <$> f y++-- | Getter/setter lens to the serieses field of a 'PlotData'+pdSerieses :: Lens' PlotData [Series]+pdSerieses f (PlotData x y z) = PlotData x y <$> f z++-- | Display fixed plot and title interactively, filling in default values.+--+-- See 'runPlotDynamic' for more control.+runPlotAuto+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts')+ -> Maybe String -- ^ title+ -> [AutoSeries] -- ^ uninitialized series data+ -> IO ()+runPlotAuto po t s = case po ^. poAutoMethod of+ Nothing -> runPlot po t =<< fromAutoSeriesIO s+ Just g -> runPlot po t $ fromAutoSeries_ g s++-- | Display fixed plot and title interactively.+--+-- See 'runPlotDynamic' for more control.+runPlot+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts')+ -> Maybe String -- ^ title+ -> [Series] -- ^ series data+ -> IO ()+runPlot po t s = runPlotDynamic po+ (const (pure True))+ (pure (Just (PlotData t (_poDescription po) s)))++-- | Display a series of plots (@['Series']@) with a time delay between+-- each one. Will quit when the last plot is displayed. Use 'lastForever'+-- on the input list to repeat the last item indefinitely, or 'cycle' to+-- cycle through the list forever.+--+-- Note that this behavior is pretty simple; more advanced functionality+-- can be achieved with 'runPlotDynamic' directly.+animatePlot+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts')+ -> Double -- ^ update rate (frames per second)+ -> Maybe String -- ^ title+ -> [[Series]] -- ^ list of series data (potentially infinite)+ -> IO ()+animatePlot po fps t ss = do+ ssRef <- newEmptyMVar+ rateMult <- newIORef 0+ tid <- forkIO $ do+ forM_ ss $ \s -> do+ putMVar ssRef (Just s)+ threadDelay . mkDelay =<< readIORef rateMult+ takeMVar ssRef+ putMVar ssRef Nothing+ runPlotDynamic po' (updateFr rateMult) (mkData rateMult ssRef)+ killThread tid+ where+ mkDelay i = round $ 1000000 / (fps * (2 ** (fromIntegral i / 2)))+ mkData rateMult ssRef = do+ ss' <- readMVar ssRef+ desc <- animateDesc (_poDescription po) <$> readIORef rateMult+ pure $ PlotData t desc <$> ss'+ po' = po & poFramerate %~ (<|> Just (max fps 10))+ updateFr :: IORef Int -> Event -> IO Bool+ updateFr rateMult = \case+ EvKey (KChar '[') [] -> True <$ modifyIORef rateMult (subtract 1)+ EvKey (KChar ']') [] -> True <$ modifyIORef rateMult (+ 1)+ _ -> pure True++-- | Handy function to use with 'animatePlot' to extend the last frame into+-- eternity.+lastForever :: [a] -> [a]+lastForever [] = []+lastForever [x] = repeat x+lastForever (x:xs@(_:_)) = x : lastForever xs++animateDesc :: Maybe Image -> Int -> Maybe Image+animateDesc d r = desc' <|> Just desc+ where+ desc = string defAttr $ "[/] rate" ++ rString+ desc' = (`vertJoin` desc) . (`vertJoin` char defAttr ' ') <$> d+ rString+ | r == 0 = ""+ | otherwise = printf " (x%.2f)" $ 2 ** (fromIntegral @_ @Double r / 2)+++-- | Animate (according to the framerate in the 'PlotOpts') a function+-- @'Double' -> 'Maybe' [Series]@, where the input is the current time in+-- seconds and the output is the plot to display at that time. Will quit+-- as soon as 'Nothing' is given.+--+-- Remember to give a 'PlotOpts' with a 'Just' framerate.+--+-- This is a simple wrapper over 'animatePlotMoore' with a stateless+-- function. For more advanced functionality, use 'animatePlotMoore' or+-- 'runPlotDynamic' directly.+animatePlotFunc+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts', but remember to set a framerate)+ -> Maybe String -- ^ title+ -> (Double -> Maybe [Series]) -- ^ function from time to plot. will quit as soon as 'Nothing' is returned.+ -> IO ()+animatePlotFunc po t f = animatePlotMoore po t $ Moore+ { moInitVal = f 0+ , moInitState = 0+ , moUpdate = \dt tt ->+ let t' = tt + dt+ in pure $ (, t') <$> f t'+ }++-- | Used for 'animatePlotMoore' to specify how a plot evolves over time+-- with some initial state.+data Moore a = forall s. Moore+ { -- | initial value of plot. 'Nothing' for a non-starter.+ moInitVal :: Maybe a+ -- | initial state of plot+ , moInitState :: s+ -- | Given change in time since last render and old state, return new+ -- plot and state. Return 'Nothing' to quit.+ , moUpdate :: Double -> s -> IO (Maybe (a, s))+ }++deriving instance Functor Moore++-- | Animate (according to the framerate in the 'PlotOpts') a "Moore+-- machine" description of a plot evolving over time with some initial+-- state.+--+-- Remember to give a 'PlotOpts' with a 'Just' framerate.+--+-- For a simplified version of a stateless function, see 'animatePlotFunc'.+-- This is implemented in terms of 'runPlotDynamic', but the representation+-- of an animation in terms of a moore machine is powerful enough to+-- represent a very general class of animations.+animatePlotMoore+ :: PlotOpts -- ^ options (can be 'defaultPlotOpts', but remember to set a framerate)+ -> Maybe String -- ^ title+ -> Moore [Series] -- ^ moore machine representing progression of plot from an initial state+ -> IO ()+animatePlotMoore po t Moore{..} = do+ ssRef <- newIORef moInitVal+ rateMult <- newIORef 0+ currState <- newIORef moInitState+ tid <- forkIO . void . runMaybeT . many . MaybeT . fmap guard $ do+ threadDelay td+ dt <- mkDT <$> readIORef rateMult+ s <- readIORef currState+ moUpdate dt s >>= \case+ Nothing -> False <$ writeIORef ssRef Nothing+ Just (xs, s') -> True <$ do+ writeIORef ssRef (Just xs)+ writeIORef currState s'+ runPlotDynamic po (updateFr rateMult) (mkData rateMult ssRef)+ killThread tid+ where+ fps = fromMaybe 1 $ po ^. poFramerate+ td = fromMaybe 1000000 $ po ^. poDelay+ mkDT i = 1 / (fps * (2 ** (- fromIntegral i / 2)))+ mkData rateMult ssRef = do+ ss' <- readIORef ssRef+ desc <- animateDesc (_poDescription po) <$> readIORef rateMult+ pure $ PlotData t desc <$> ss'+ updateFr :: IORef Int -> Event -> IO Bool+ updateFr rateMult = \case+ EvKey (KChar '[') [] -> True <$ modifyIORef rateMult (subtract 1)+ EvKey (KChar ']') [] -> True <$ modifyIORef rateMult (+ 1)+ _ -> pure True+++-- | Version of 'runPlot' that allows you to vary the plotted data and the+-- title. It will execute the @'IO' PlotData@ to get the current plot+-- data; you can use this with i.e. an 'IORef' to adjust the data in+-- real-time.+runPlotDynamic+ :: PlotOpts+ -> (Event -> IO Bool) -- ^ process VTY events (return 'False' to trigger quit)+ -> IO (Maybe PlotData) -- ^ action to "get" the plot data every frame. if 'Nothing', quit.+ -> IO ()+runPlotDynamic po pe ssRef = do+ vty <- mkVty =<< standardIOConfig+ pdmaybe <- ssRef+ forM_ pdmaybe $ \initPD -> do+ psRef <- newIORef =<< initPS vty initPD+ peChan <- newChan+ tPE <- forkIO . forever $ do+ e <- nextEvent vty+ q <- pe e+ unless q $ writeChan peChan PEQuit+ traverse_ (writeChan peChan) $ processEvent e+ tTick <- forM (po ^. poDelay) $ \td ->+ forkIO . forever $ do+ threadDelay td+ writeChan peChan PETick++ void . runMaybeT . many . MaybeT . fmap guard $+ plotLoop vty peChan psRef+ killThread tPE+ traverse_ killThread tTick+ shutdown vty+ where+ initPS :: Vty -> PlotData -> IO PlotState+ initPS vty PlotData{..} = do+ dr <- displayRange $ outputIface vty+ pure $ PlotState+ { _psRange = plotRange po dr _pdSerieses+ , _psHelp = po ^. poHelp+ }+ plotLoop+ :: Vty+ -> Chan PEvent+ -> IORef PlotState+ -> IO Bool+ plotLoop vty peChan psRef = do+ dr <- displayRange $ outputIface vty+ ps <- readIORef psRef+ pdmaybe <- ssRef+ fmap or . forM pdmaybe $ \pd@PlotData{..} -> do+ let titleBox = fmap (vertCat . intersperse (char defAttr ' ') . toList) . NE.nonEmpty . catMaybes $+ [ string (withStyle defAttr bold) <$> _pdTitle+ , _pdDesc+ ]+ uiText = case (titleBox, _psHelp ps) of+ (Nothing, False) -> id+ (Just t , False) -> (box t ++)+ (Nothing, True ) -> (box helpBox ++)+ (Just t , True ) -> (box (vertCat [t, char defAttr ' ', helpBox]) ++)+ imgs = uiText $ renderPlot dr (_psRange ps) _pdSerieses++ update vty $ picForLayers imgs+ hideCursor . outputIface $ vty+ readChan peChan >>= \case+ PEQuit -> pure False+ PEZoom d -> do+ let scaler s = over rSize (* s)+ writeIORef psRef $+ ps & psRange %~ (<*>) (scaler <$> d)+ pure True+ PEPan d -> do+ let panner s r = fmap (+ (r ^. rSize * s)) r+ writeIORef psRef $+ ps & psRange %~ (<*>) (panner <$> d)+ pure True+ PEResize newDim -> do+ let oldDim = _rSize <$> dr+ newRange = do+ d0 <- oldDim+ d1 <- newDim+ r0 <- _psRange ps+ pure $ r0 & rSize %~ (* (fromIntegral d1 / fromIntegral d0))+ writeIORef psRef $+ ps & psRange .~ newRange+ pure True+ PEHelp -> do+ writeIORef psRef $+ ps & psHelp %~ not+ pure True+ PEReset -> do+ writeIORef psRef =<< initPS vty pd+ pure True+ PETick -> pure True++helpText :: [(String, String)]+helpText =+ [ ("-/+" , "zoom")+ , ("arrows", "pan")+ , ("v/^" , "vert stretch")+ , ("</>" , "horiz stretch")+ , ("r" , "reset disp")+ , ("?" , "show help")+ , ("q" , "quit")+ ]++helpBox :: Image+helpBox = vertCat (string defAttr . (++ " ") <$> x)+ `horizJoin` vertCat (string defAttr <$> y)+ where+ (x,y) = unzip helpText++box :: Image -> [Image]+box (pad 1 0 1 0 -> i) = [boxed, charFill defAttr ' ' (imageWidth i + 1) (imageHeight i + 1)]+ where+ lr = charFill defAttr '|' 1 (imageHeight i)+ tb = charFill defAttr '-' (imageWidth i) 1+ c = char defAttr '+'+ boxed = vertCat . map horizCat $+ [ [c , tb, c ]+ , [lr, i , lr]+ , [c , tb, c ]+ ]
+ src/Interactive/Plot/Series.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module : Interative.Plot.Series+-- Copyright : (c) Justin Le 2018+-- License : BSD3+--+-- Maintainer : justin@jle.im+-- Stability : experimental+-- Portability : non-portable+--+-- Create common serieses.+module Interactive.Plot.Series (+ Series, AutoSeries, SeriesF(..)+ , PointStyle, AutoPointStyle, PointStyleF(..)+ -- * Create common 'Series'+ , listSeries+ , tupleSeries+ , funcSeries+ , enumRange+ -- * Create a 'Series' from an 'AutoSeries'.+ , fromAutoSeries+ , fromAutoSeriesIO+ , fromAutoSeries_+ , defaultStyles+ ) where++import Control.Monad.Random+import Control.Monad.State+import Data.Foldable+import Data.Maybe+import Graphics.Vty+import Interactive.Plot.Core+import Lens.Micro+import qualified Data.Set as S++-- | Construct a series from any foldable container of y-values. The+-- x-values are automatically assigned to 0, 1, 2, 3 ... etc.+--+-- Note that this is polymorphic over both 'PointStyle' and+-- 'AutoPointStyle':+--+-- @+-- 'listSeries' :: Foldable t => t Double -> 'PointStyle' -> 'Series'+-- 'listSeries' :: Foldable t => t Double -> 'AutoPointStyle' -> 'AutoSeries'+-- @+listSeries :: Foldable t => t Double -> PointStyleF f -> SeriesF f+listSeries xs = Series (toCoordMap . S.fromList . zipWith C [0..] . toList $ xs)++-- | Construct a series from any foldable container of x-y tuples.+--+-- Note that this is polymorphic over both 'PointStyle' and+-- 'AutoPointStyle':+--+-- @+-- 'tupleSeries' :: Foldable t => t (Double, Double) -> 'PointStyle' -> 'Series'+-- 'tupleSeries' :: Foldable t => t (Double, Double) -> 'AutoPointStyle' -> 'AutoSeries'+-- @+tupleSeries :: Foldable t => t (Double, Double) -> PointStyleF f -> SeriesF f+tupleSeries xs = Series (toCoordMap . S.fromList . foldMap ((:[]) . uncurry C) $ xs)++-- | @'enumRange' n ('R' a b)@ generates a list of @n@ equally spaced values+-- between @a@ and @b@.+enumRange+ :: Fractional a+ => Int -- ^ Number of points+ -> Range a -- ^ Range to generate the points over+ -> [a]+enumRange n r = (+ r ^. rMin) . (* s) . fromIntegral <$> [0 .. (n - 1)]+ where+ s = r ^. rSize / fromIntegral (n - 1)++-- | Construct a series from a function x to y, given a foldable container+-- of x values.+--+-- Note that this is polymorphic over both 'PointStyle' and+-- 'AutoPointStyle':+--+-- @+-- 'funcSeries' :: Foldable t => (Double -> Double) -> t Double -> 'PointStyle' -> 'Series'+-- 'funcSeries' :: Foldable t => (Double -> Double) -> t Double -> 'AutoPointStyle' -> 'AutoSeries'+-- @+funcSeries+ :: Foldable t+ => (Double -> Double)+ -> t Double+ -> PointStyleF f+ -> SeriesF f+funcSeries f xs = tupleSeries [ (x, f x) | x <- toList xs ]++-- | A set of default markers.+defaultMarkers :: S.Set Char+defaultMarkers = S.fromList "o*+~.,=#`x-"++-- | A set of default colors.+defaultColors :: S.Set OrdColor+defaultColors = S.fromList $ OC <$> [white, yellow, blue, red, green, cyan, magenta]++-- | A set of default point styles+defaultStyles :: S.Set PointStyle+defaultStyles = combinePointStyles defaultMarkers defaultColors++combinePointStyles+ :: S.Set Char+ -> S.Set OrdColor+ -> S.Set PointStyle+combinePointStyles ms cs = combine `S.map` S.cartesianProduct ms cs+ where+ combine (m, OC c) = PointStyle m c++-- | Turn an 'AutoSeries' into a 'Series', assigning styles from+-- a pre-specified "shuffled" order.+fromAutoSeries :: [AutoSeries] -> [Series]+fromAutoSeries = fromAutoSeries_ $+ fromMaybe (mkStdGen 28922710942259) (_poAutoMethod defaultPlotOpts)++-- | Turn an 'AutoSeries' into a 'Series', drawing styles randomly in IO.+fromAutoSeriesIO :: [AutoSeries] -> IO [Series]+fromAutoSeriesIO as = (`fromAutoSeries_` as) <$> getStdGen++-- | Turn an 'AutoSeries' into a 'Series', shuffling the default styles in+-- a deterministic way from a given seed.+fromAutoSeries_ :: StdGen -> [AutoSeries] -> [Series]+fromAutoSeries_ seed = flip evalRand seed . flip evalStateT S.empty . mapM go+ where+ go :: AutoSeries -> StateT (S.Set PointStyle) (Rand StdGen) Series+ go (Series is ps) = Series is <$> pickPs+ where+ pickPs = case ps of+ PointStyleF Auto Auto -> do+ picked <- get+ samp <- sampleSet $ defaultStyles S.\\ picked+ case samp of+ Nothing -> fromJust <$> sampleSet defaultStyles+ Just s -> s <$ put (s `S.insert` picked)+ PointStyleF (Given m) Auto -> do+ picked <- get+ let allDefaults = combinePointStyles (S.singleton m) defaultColors+ samp <- sampleSet $ allDefaults S.\\ picked+ case samp of+ Nothing -> fromJust <$> sampleSet allDefaults+ Just s -> s <$ put (s `S.insert` picked)+ PointStyleF Auto (Given c) -> do+ picked <- get+ let allDefaults = combinePointStyles defaultMarkers (S.singleton (OC c))+ samp <- sampleSet $ allDefaults S.\\ picked+ case samp of+ Nothing -> fromJust <$> sampleSet allDefaults+ Just s -> s <$ put (s `S.insert` picked)+ PointStyleF (Given m) (Given c) -> pure $ PointStyle m c++sampleSet+ :: (MonadRandom m)+ => S.Set a+ -> m (Maybe a)+sampleSet xs+ | S.null xs = pure Nothing+ | otherwise = do+ i <- getRandomR (0, S.size xs - 1)+ pure $ Just (i `S.elemAt` xs)+