{-# LANGUAGE FlexibleContexts #-}
module Interactive.Plot.Series (
Series, AutoSeries, SeriesF(..)
, PointStyle, AutoPointStyle, PointStyleF(..)
, listSeries
, tupleSeries
, funcSeries
, enumRange
, 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
listSeries :: Foldable t => t Double -> PointStyleF f -> SeriesF f
listSeries xs = Series (toCoordMap . S.fromList . zipWith C [0..] . toList $ xs)
tupleSeries :: Foldable t => t (Double, Double) -> PointStyleF f -> SeriesF f
tupleSeries xs = Series (toCoordMap . S.fromList . foldMap ((:[]) . uncurry C) $ xs)
enumRange
:: Fractional a
=> Int
-> Range a
-> [a]
enumRange n r = (+ r ^. rMin) . (* s) . fromIntegral <$> [0 .. (n - 1)]
where
s = r ^. rSize / fromIntegral (n - 1)
funcSeries
:: Foldable t
=> (Double -> Double)
-> t Double
-> PointStyleF f
-> SeriesF f
funcSeries f xs = tupleSeries [ (x, f x) | x <- toList xs ]
defaultMarkers :: S.Set Char
defaultMarkers = S.fromList "o*+~.,=#`x-"
defaultColors :: S.Set OrdColor
defaultColors = S.fromList $ OC <$> [white, yellow, blue, red, green, cyan, magenta]
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
fromAutoSeries :: [AutoSeries] -> [Series]
fromAutoSeries = fromAutoSeries_ $
fromMaybe (mkStdGen 28922710942259) (_poAutoMethod defaultPlotOpts)
fromAutoSeriesIO :: [AutoSeries] -> IO [Series]
fromAutoSeriesIO as = (`fromAutoSeries_` as) <$> getStdGen
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)