{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
module Plots.Types.Pie
(
PieState
, piePlot
, piePlot'
, onWedges
, wedgeKeys
, Wedge
, mkWedge
, HasWedge (..)
, wedgePlot
) where
import Control.Monad.State.Lazy
import Data.Typeable
import qualified Data.Foldable as F
import qualified Data.List as List
import Diagrams.Coordinates.Isomorphic
import Diagrams.Coordinates.Polar
import Diagrams.Prelude hiding (r2)
import Plots.Style
import Plots.Types
import Plots.Axis
data Wedge n = Wedge
{ sEndR :: n
, sStartR :: n
, sOffset :: n
, sDir :: Direction V2 n
, sWidth :: Angle n
} deriving Typeable
type instance V (Wedge n) = V2
type instance N (Wedge n) = n
instance RealFloat n => Enveloped (Wedge n) where
getEnvelope Wedge {..} = getEnvelope shape # translate off where
shape
| sStartR == 0 = wedge sEndR sDir sWidth :: Path V2 n
| otherwise = annularWedge sEndR sStartR sDir sWidth
off
| sOffset == 0 = zero
| otherwise = sOffset *^ fromDir (rotate (sWidth ^/ 2) sDir)
instance (TypeableFloat n, Renderable (Path V2 n) b)
=> Plotable (Wedge n) b where
renderPlotable s sty Wedge {..} =
shape
# applyAreaStyle sty
# translate off
# transform (s^.specTrans)
where
shape
| sStartR == 0 = wedge sEndR sDir sWidth
| otherwise = annularWedge sEndR sStartR sDir sWidth
off
| sOffset == 0 = zero
| otherwise = sOffset *^ fromDir (rotate (sWidth ^/ 2) sDir)
defLegendPic sty Wedge {..}
= square 5 # applyAreaStyle sty
mkWedge
:: Num n
=> Direction V2 n
-> Angle n
-> Wedge n
mkWedge d theta = Wedge
{ sEndR = 1
, sStartR = 0
, sOffset = 0
, sDir = d
, sWidth = theta
}
class HasWedge f a where
pieWedge :: LensLike' f a (Wedge (N a))
wedgeOuterRadius :: Functor f => LensLike' f a (N a)
wedgeOuterRadius = pieWedge . lens sEndR (\p r -> p {sEndR = r})
wedgeInnerRadius :: Functor f => LensLike' f a (N a)
wedgeInnerRadius = pieWedge . lens sStartR (\p r -> p {sStartR = r})
wedgeOffset :: Functor f => LensLike' f a (N a)
wedgeOffset = pieWedge . lens sOffset (\p x -> p {sOffset = x})
wedgeWidth :: Functor f => LensLike' f a (Angle (N a))
wedgeWidth = pieWedge . lens sWidth (\p x -> p {sWidth = x})
wedgeDirection :: Functor f => LensLike' f a (Direction V2 (N a))
wedgeDirection = pieWedge . lens sDir (\p x -> p {sDir = x})
instance HasWedge f (Wedge n) where
pieWedge = id
instance (Functor f, HasWedge f a) => HasWedge f (Plot a b) where
pieWedge = rawPlot . pieWedge
instance Applicative f => HasWedge f (PieState b n a) where
pieWedge = stateMods . traversed . _2 . pieWedge
instance (Applicative f, Typeable b, v ~ V2, Typeable n)
=> HasWedge f (DynamicPlot b v n) where
pieWedge = (dynamicPlot :: Traversal' (DynamicPlot b v n) (Plot (Wedge n) b))
. pieWedge
instance (v ~ V2, Applicative f, Typeable n)
=> HasWedge f (StyledPlot b v n) where
pieWedge = (styledPlot :: Traversal' (StyledPlot b v n) (Wedge n))
instance (BaseSpace c ~ V2, Settable f, Typeable n)
=> HasWedge f (Axis b c n) where
pieWedge = finalPlots . pieWedge
data PieState b n a = PieState
{ psMods :: [(a, Plot (Wedge n) b)]
}
type instance V (PieState b n a) = V2
type instance N (PieState b n a) = n
stateMods :: Lens' (PieState b n a) [(a, Plot (Wedge n) b)]
stateMods = lens psMods (\ps ms -> ps {psMods = ms})
onWedges :: (a -> State (Plot (Wedge n) b) ()) -> State (PieState b n a) ()
onWedges f = stateMods %= map (\(a, p) -> (a, execState (f a) p))
wedgeKeys :: Num n => (a -> String) -> State (PieState b n a) ()
wedgeKeys f = onWedges $ \a -> key (f a)
piePlot
:: (MonadState (Axis b Polar n) m,
Plotable (Wedge n) b,
F.Foldable f)
=> f a
-> (a -> n)
-> State (PieState b n a) ()
-> m ()
piePlot (F.toList -> as) f st = F.forM_ ps addPlot
where
ns = map f as
x = F.sum ns
wedges = snd $ List.mapAccumR wedgeAccum xDir as
wedgeAccum d a = (d', wdg)
where theta = (f a / x) @@ turn
d' = d # rotate theta
wdg = mkWedge d theta
ps = map snd . psMods $ execState st ps0
ps0 = PieState { psMods = zip as (map mkPlot wedges) }
piePlot'
:: (MonadState (Axis b Polar n) m,
Plotable (Wedge n) b,
F.Foldable f)
=> f n
-> m ()
piePlot' ns = piePlot ns id (return ())
wedgePlot
:: (v ~ BaseSpace c, v ~ V2,
PointLike v n (Polar n),
MonadState (Axis b c n) m,
Plotable (Wedge n) b
)
=> Direction V2 n -> Angle n -> State (Plot (Wedge n) b) () -> m ()
wedgePlot r theta = addPlotable (mkWedge r theta)