{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Plots.Types.Scatter
(
ScatterPlot
, ScatterOptions
, HasScatterOptions (..)
, HasConnectingLine (..)
, scatterPlot
, scatterPlot'
, scatterPlotOf
, scatterPlotOf'
, scatterOptions
, bubblePlot
, bubblePlot'
, bubblePlotOf
, bubblePlotOf'
, BubbleOptions
, bubbleOptions
, bubbleTransform
, bubbleStyle
, gscatterPlot
, gscatterOptionsFor
, mkScatterOptions
) where
import Control.Lens hiding (lmap, transform, ( # ))
import Control.Monad.State.Lazy
import qualified Data.Foldable as F
import Data.Typeable
import Diagrams.Coordinates.Isomorphic
import Diagrams.Prelude hiding (view)
import Plots.Axis
import Plots.Style
import Plots.Types
data ScatterPlot v n where
ScatterPlot :: Typeable a => ScatterOptions v n a -> ScatterPlot v n
deriving Typeable
type instance V (ScatterPlot v n) = v
type instance N (ScatterPlot v n) = n
data ScatterOptions v n a = ScatterOptions
{ oData :: [a]
, oPos :: a -> Point v n
, oTr :: a -> Transformation v n
, oSty :: a -> Style v n
, oLine :: Bool
} deriving Typeable
type instance V (ScatterOptions v n a) = v
type instance N (ScatterOptions v n a) = n
instance (Metric v, OrderedField n) => Enveloped (ScatterPlot v n) where
getEnvelope (ScatterPlot (ScatterOptions {..})) = getEnvelope (map oPos oData)
instance (TypeableFloat n, Renderable (Path V2 n) b)
=> Plotable (ScatterPlot V2 n) b where
renderPlotable s sty (ScatterPlot (ScatterOptions {..})) =
markers <> line
where
markers = F.foldMap mk oData # applyMarkerStyle sty
mk a = marker # transform (oTr a)
# applyStyle (oSty a)
# moveTo (specPoint s $ oPos a)
marker = sty ^. plotMarker
line
| not oLine = mempty
| otherwise = fromVertices points # applyLineStyle sty
points = map (specPoint s . oPos) oData
defLegendPic sty (ScatterPlot (ScatterOptions {..})) =
sty ^. plotMarker
& applyMarkerStyle sty
mkScatterOptions
:: (PointLike v n p, F.Foldable f, Fractional n)
=> f a
-> (a -> p)
-> ScatterOptions v n a
mkScatterOptions xs pf = ScatterOptions
{ oData = F.toList xs
, oPos = view unpointLike . pf
, oTr = mempty
, oSty = const (_Wrapped ## mempty)
, oLine = False
}
class HasConnectingLine f a where
connectingLine :: Functor f => LensLike' f a Bool
instance HasConnectingLine f (ScatterOptions v n a) where
connectingLine = lens oLine (\o b -> o {oLine = b})
instance HasConnectingLine f (ScatterPlot v n) where
connectingLine f (ScatterPlot o@(ScatterOptions {..}))
= f oLine <&> \b -> ScatterPlot o {oLine = b}
instance HasConnectingLine f p => HasConnectingLine f (Plot p b) where
connectingLine = rawPlot . connectingLine
instance (Applicative f, Typeable b, Typeable v, Typeable n)
=> HasConnectingLine f (DynamicPlot b v n) where
connectingLine = (dynamicPlot :: Traversal' (DynamicPlot b v n) (Plot (ScatterPlot v n) b))
. connectingLine
instance (Applicative f, Typeable v, Typeable n)
=> HasConnectingLine f (StyledPlot b v n) where
connectingLine = (styledPlot :: Traversal' (StyledPlot b v n) (ScatterPlot v n))
. connectingLine
instance (Settable f, Typeable (BaseSpace c), Typeable n)
=> HasConnectingLine f (Axis b c n) where
connectingLine = finalPlots . connectingLine
class HasScatterOptions f a d where
gscatterOptions :: LensLike' f a (ScatterOptions (V a) (N a) d)
scatterTransform :: Functor f => LensLike' f a (d -> Transformation (V a) (N a))
scatterTransform = gscatterOptions . lens oTr (\o tr -> o {oTr = tr})
scatterStyle :: Functor f => LensLike' f a (d -> Style (V a) (N a))
scatterStyle = gscatterOptions . lens oSty (\o sty -> o {oSty = sty})
scatterPosition :: Functor f => LensLike' f a (d -> Point (V a) (N a))
scatterPosition = gscatterOptions . lens oPos (\o pos -> o {oPos = pos})
instance d ~ d' => HasScatterOptions f (ScatterOptions v n d) d' where
gscatterOptions = id
instance (Applicative f, Typeable v, Typeable n, Typeable d)
=> HasScatterOptions f (ScatterPlot v n) d where
gscatterOptions f s@(ScatterPlot p) =
case eq p of
Just Refl -> ScatterPlot <$> f p
Nothing -> pure s
where
eq :: Typeable a => a -> Maybe (a :~: ScatterOptions v n d)
eq _ = eqT
instance (Functor f, HasScatterOptions f p a) => HasScatterOptions f (Plot p b) a where
gscatterOptions = rawPlot . gscatterOptions
instance (Applicative f, Typeable b, Typeable v, Typeable n, Typeable a)
=> HasScatterOptions f (DynamicPlot b v n) a where
gscatterOptions = dynamicPlot . rawPlot
instance (Applicative f, Typeable b, Typeable (BaseSpace c), Typeable n, Typeable a)
=> HasScatterOptions f (Axis b c n) a where
gscatterOptions = axisPlots . traverse . gscatterOptions
scatterOptions :: (InSpace v n a, HasScatterOptions f a (Point v n))
=> LensLike' f a (ScatterOptions v n (Point v n))
scatterOptions = gscatterOptions
scatterPlot
:: (BaseSpace c ~ v,
PointLike v n p,
Typeable n,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
F.Foldable f)
=> f p
-> State (Plot (ScatterOptions v n (Point v n)) b) ()
-> m ()
scatterPlot xs = gscatterPlot (xs ^.. folded . unpointLike) id
scatterPlot'
:: (BaseSpace c ~ v,
PointLike v n p,
Typeable n,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
F.Foldable f)
=> f p
-> m ()
scatterPlot' xs = scatterPlot xs (return ())
scatterPlotOf
:: (BaseSpace c ~ v,
PointLike v n p,
Typeable n,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b)
=> Fold s p
-> s
-> State (Plot (ScatterOptions v n (Point v n)) b) ()
-> m ()
scatterPlotOf f s = scatterPlot (toListOf f s)
scatterPlotOf'
:: (BaseSpace c ~ v,
PointLike v n p,
Typeable n,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b)
=> Fold s p
-> s
-> m ()
scatterPlotOf' f s = scatterPlot' (toListOf f s)
type BubbleOptions v n = ScatterOptions v n (n, Point v n)
bubblePlot
:: (BaseSpace c ~ v,
PointLike v n p,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
Typeable n,
F.Foldable f)
=> f (n, p)
-> State (Plot (BubbleOptions v n) b) ()
-> m ()
bubblePlot xs s =
gscatterPlot (xs ^.. folded . mapping unpointLike) snd $ do
bubbleTransform .= scaling
s
bubblePlot'
:: (v ~ BaseSpace c,
PointLike v n p,
Typeable n,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
F.Foldable f)
=> f (n, p)
-> m ()
bubblePlot' xs = bubblePlot xs (return ())
bubblePlotOf
:: (BaseSpace c ~ v,
PointLike v n p,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
Typeable n)
=> Fold s (n,p)
-> s
-> State (Plot (BubbleOptions v n) b) ()
-> m ()
bubblePlotOf f s = bubblePlot (toListOf f s)
bubblePlotOf'
:: (BaseSpace c ~ v,
PointLike v n p,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
Typeable n)
=> Fold s (n,p)
-> s
-> State (Plot (BubbleOptions v n) b) ()
-> m ()
bubblePlotOf' f s = bubblePlot (toListOf f s)
bubbleOptions :: (InSpace v n a, HasScatterOptions f a (n, Point v n))
=> LensLike' f a (BubbleOptions v n)
bubbleOptions = gscatterOptions
bubbleTransform
:: (InSpace v n a, HasScatterOptions f a (n, Point v n), Settable f)
=> LensLike' f a (n -> Transformation v n)
bubbleTransform = bubbleOptions . scatterTransform . sets nOnly
where nOnly f g (n,p) = f (\n' -> g (n', p)) n
bubbleStyle :: (InSpace v n a, Settable f, HasScatterOptions f a (n, Point v n))
=> LensLike' f a (n -> Style v n)
bubbleStyle = bubbleOptions . scatterStyle . sets nOnly
where nOnly f g (n,p) = f (\n' -> g (n', p)) n
gscatterPlot
:: (BaseSpace c ~ v,
PointLike v n p,
MonadState (Axis b c n) m,
Plotable (ScatterPlot v n) b,
Typeable d,
F.Foldable f)
=> f d
-> (d -> p)
-> State (Plot (ScatterOptions v n d) b) ()
-> m ()
gscatterPlot xs pf s = addPlot $ over rawPlot ScatterPlot p1
where
p1 = execState s p0
p0 = mkPlot $ mkScatterOptions xs (view unpointLike . pf)
gscatterOptionsFor
:: (InSpace v n a, HasScatterOptions f a d)
=> proxy d -> LensLike' f a (ScatterOptions v n d)
gscatterOptionsFor _ = gscatterOptions