-- |
-- Module     :  Graphics.Rendering.Chart.Plot.AreaSpots
-- Copyright  :  (c) Malcolm Wallace 2009
-- License    :  BSD-style (see COPYRIGHT file)
--
-- Area spots are a collection of unconnected filled circles,
-- with x,y position, and an independent z value to be represented
-- by the relative area of the spots.

{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.AreaSpots
  ( AreaSpots(..)

  , area_spots_title
  , area_spots_linethick
  , area_spots_linecolour
  , area_spots_fillcolour
  , area_spots_opacity
  , area_spots_max_radius
  , area_spots_values

  , AreaSpots4D(..)

  , area_spots_4d_title
  , area_spots_4d_linethick
  , area_spots_4d_palette
  , area_spots_4d_opacity
  , area_spots_4d_max_radius
  , area_spots_4d_values
  ) where

import Graphics.Rendering.Chart.Geometry hiding (scale, x0, y0)
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Graphics.Rendering.Chart.Axis
import Control.Lens
import Data.Colour hiding (over)
import Data.Colour.Names
import Data.Default.Class

import Control.Monad

-- | A collection of unconnected spots, with x,y position, and an
--   independent z value to be represented by the area of the spot.
data AreaSpots z x y = AreaSpots
  { forall z x y. AreaSpots z x y -> String
_area_spots_title      :: String
  , forall z x y. AreaSpots z x y -> Double
_area_spots_linethick  :: Double
  , forall z x y. AreaSpots z x y -> AlphaColour Double
_area_spots_linecolour :: AlphaColour Double
  , forall z x y. AreaSpots z x y -> Colour Double
_area_spots_fillcolour :: Colour Double
  , forall z x y. AreaSpots z x y -> Double
_area_spots_opacity    :: Double
  , forall z x y. AreaSpots z x y -> Double
_area_spots_max_radius :: Double   -- ^ the largest size of spot
  , forall z x y. AreaSpots z x y -> [(x, y, z)]
_area_spots_values     :: [(x,y,z)]
  }

instance Default (AreaSpots z x y) where
  def :: AreaSpots z x y
def = AreaSpots
    { _area_spots_title :: String
_area_spots_title      = String
""
    , _area_spots_linethick :: Double
_area_spots_linethick  = Double
0.1
    , _area_spots_linecolour :: AlphaColour Double
_area_spots_linecolour = forall a. Num a => Colour a -> AlphaColour a
opaque forall a. (Ord a, Floating a) => Colour a
blue
    , _area_spots_fillcolour :: Colour Double
_area_spots_fillcolour = forall a. (Ord a, Floating a) => Colour a
blue
    , _area_spots_opacity :: Double
_area_spots_opacity    = Double
0.2
    , _area_spots_max_radius :: Double
_area_spots_max_radius = Double
20  -- in pixels
    , _area_spots_values :: [(x, y, z)]
_area_spots_values     = []
    }

instance (PlotValue z) => ToPlot (AreaSpots z) where
    toPlot :: forall x y. AreaSpots z x y -> Plot x y
toPlot AreaSpots z x y
p = Plot { _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = forall z x y.
PlotValue z =>
AreaSpots z x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots AreaSpots z x y
p
                    , _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [(forall z x y. AreaSpots z x y -> String
_area_spots_title AreaSpots z x y
p, forall z x y. AreaSpots z x y -> Rect -> BackendProgram ()
renderSpotLegend AreaSpots z x y
p)]
                    , _plot_all_points :: ([x], [y])
_plot_all_points = ( forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1) (forall z x y. AreaSpots z x y -> [(x, y, z)]
_area_spots_values AreaSpots z x y
p)
                                         , forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2) (forall z x y. AreaSpots z x y -> [(x, y, z)]
_area_spots_values AreaSpots z x y
p) )
                    }

renderAreaSpots  :: (PlotValue z) => AreaSpots z x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots :: forall z x y.
PlotValue z =>
AreaSpots z x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots AreaSpots z x y
p PointMapFn x y
pmap = 
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall z x y.
PlotValue z =>
Double -> [(x, y, z)] -> [(x, y, Double)]
scaleMax (forall z x y. AreaSpots z x y -> Double
_area_spots_max_radius AreaSpots z x y
pforall a b. (Num a, Integral b) => a -> b -> a
^(Integer
2::Integer))
                    (forall z x y. AreaSpots z x y -> [(x, y, z)]
_area_spots_values AreaSpots z x y
p))
          (\ (x
x,y
y,Double
z)-> do
              let radius :: Double
radius = forall a. Floating a => a -> a
sqrt Double
z
              let psSpot :: PointStyle
psSpot = Double -> AlphaColour Double -> PointStyle
filledCircles Double
radius forall a b. (a -> b) -> a -> b
$
                                                    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity 
                                                      (forall z x y. AreaSpots z x y -> Double
_area_spots_opacity AreaSpots z x y
p) forall a b. (a -> b) -> a -> b
$
                                                    forall z x y. AreaSpots z x y -> Colour Double
_area_spots_fillcolour AreaSpots z x y
p
              PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psSpot (PointMapFn x y
pmap (forall a. a -> Limit a
LValue x
x, forall a. a -> Limit a
LValue y
y))
              let psOutline :: PointStyle
psOutline = Double -> Double -> AlphaColour Double -> PointStyle
hollowCircles Double
radius
                                                      (forall z x y. AreaSpots z x y -> Double
_area_spots_linethick AreaSpots z x y
p)
                                                      (forall z x y. AreaSpots z x y -> AlphaColour Double
_area_spots_linecolour AreaSpots z x y
p)
              PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psOutline (PointMapFn x y
pmap (forall a. a -> Limit a
LValue x
x, forall a. a -> Limit a
LValue y
y))
          )
  where
    scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]
    scaleMax :: forall z x y.
PlotValue z =>
Double -> [(x, y, z)] -> [(x, y, Double)]
scaleMax Double
n [(x, y, z)]
points = let largest :: Double
largest  = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field3 s t a b => Lens s t a b
_3forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. PlotValue a => a -> Double
toValue) [(x, y, z)]
points)
                            scale :: a -> Double
scale a
v  = Double
n forall a. Num a => a -> a -> a
* forall a. PlotValue a => a -> Double
toValue a
v forall a. Fractional a => a -> a -> a
/ Double
largest
                        in forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mappedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field3 s t a b => Lens s t a b
_3) forall a. PlotValue a => a -> Double
scale [(x, y, z)]
points

renderSpotLegend :: AreaSpots z x y -> Rect -> BackendProgram ()
renderSpotLegend :: forall z x y. AreaSpots z x y -> Rect -> BackendProgram ()
renderSpotLegend AreaSpots z x y
p (Rect Point
p1 Point
p2) = do
    let radius :: Double
radius = forall a. Ord a => a -> a -> a
min (forall a. Num a => a -> a
abs (Point -> Double
p_y Point
p1 forall a. Num a => a -> a -> a
- Point -> Double
p_y Point
p2)) (forall a. Num a => a -> a
abs (Point -> Double
p_x Point
p1 forall a. Num a => a -> a -> a
- Point -> Double
p_x Point
p2))
        centre :: Point
centre = Point -> Point -> Point
linearInterpolate Point
p1 Point
p2
        psSpot :: PointStyle
psSpot = Double -> AlphaColour Double -> PointStyle
filledCircles Double
radius forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity 
                                        (forall z x y. AreaSpots z x y -> Colour Double
_area_spots_fillcolour AreaSpots z x y
p)
                                        (forall z x y. AreaSpots z x y -> Double
_area_spots_opacity AreaSpots z x y
p)
        psOutline :: PointStyle
psOutline = Double -> Double -> AlphaColour Double -> PointStyle
hollowCircles Double
radius (forall z x y. AreaSpots z x y -> Double
_area_spots_linethick AreaSpots z x y
p)
                                         (forall z x y. AreaSpots z x y -> AlphaColour Double
_area_spots_linecolour AreaSpots z x y
p)
    PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psSpot Point
centre
    PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psOutline Point
centre
  where
    linearInterpolate :: Point -> Point -> Point
linearInterpolate (Point Double
x0 Double
y0) (Point Double
x1 Double
y1) =
        Double -> Double -> Point
Point (Double
x0 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs(Double
x1forall a. Num a => a -> a -> a
-Double
x0)forall a. Fractional a => a -> a -> a
/Double
2) (Double
y0 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs(Double
y1forall a. Num a => a -> a -> a
-Double
y0)forall a. Fractional a => a -> a -> a
/Double
2)

-- | A collection of unconnected spots, with x,y position, an
--   independent z value to be represented by the area of the spot,
--   and in addition, a fourth variable t to be represented by a colour
--   from a given palette.  (A linear transfer function from t to palette
--   is assumed.)
data AreaSpots4D z t x y = AreaSpots4D
  { forall z t x y. AreaSpots4D z t x y -> String
_area_spots_4d_title      :: String
  , forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_linethick  :: Double
  , forall z t x y. AreaSpots4D z t x y -> [Colour Double]
_area_spots_4d_palette    :: [Colour Double]
  , forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_opacity    :: Double
  , forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_max_radius :: Double        -- ^ the largest size of spot
  , forall z t x y. AreaSpots4D z t x y -> [(x, y, z, t)]
_area_spots_4d_values     :: [(x,y,z,t)]
  }

instance Default (AreaSpots4D z t x y) where
  def :: AreaSpots4D z t x y
def = AreaSpots4D
    { _area_spots_4d_title :: String
_area_spots_4d_title      = String
""
    , _area_spots_4d_linethick :: Double
_area_spots_4d_linethick  = Double
0.1
    , _area_spots_4d_palette :: [Colour Double]
_area_spots_4d_palette    = [ forall a. (Ord a, Floating a) => Colour a
blue, forall a. (Ord a, Floating a) => Colour a
green, forall a. (Ord a, Floating a) => Colour a
yellow, forall a. (Ord a, Floating a) => Colour a
orange, forall a. (Ord a, Floating a) => Colour a
red ]
    , _area_spots_4d_opacity :: Double
_area_spots_4d_opacity    = Double
0.2
    , _area_spots_4d_max_radius :: Double
_area_spots_4d_max_radius = Double
20  -- in pixels
    , _area_spots_4d_values :: [(x, y, z, t)]
_area_spots_4d_values     = []
    }

instance (PlotValue z, PlotValue t, Show t) => ToPlot (AreaSpots4D z t) where
    toPlot :: forall x y. AreaSpots4D z t x y -> Plot x y
toPlot AreaSpots4D z t x y
p = Plot { _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = forall z t x y.
(PlotValue z, PlotValue t, Show t) =>
AreaSpots4D z t x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots4D AreaSpots4D z t x y
p
                    , _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [ (forall z t x y. AreaSpots4D z t x y -> String
_area_spots_4d_title AreaSpots4D z t x y
p
                                       , forall z t x y. AreaSpots4D z t x y -> Rect -> BackendProgram ()
renderSpotLegend4D AreaSpots4D z t x y
p) ]
                    , _plot_all_points :: ([x], [y])
_plot_all_points = ( forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1) (forall z t x y. AreaSpots4D z t x y -> [(x, y, z, t)]
_area_spots_4d_values AreaSpots4D z t x y
p)
                                         , forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field2 s t a b => Lens s t a b
_2) (forall z t x y. AreaSpots4D z t x y -> [(x, y, z, t)]
_area_spots_4d_values AreaSpots4D z t x y
p) )
                    }

renderAreaSpots4D  :: (PlotValue z, PlotValue t, Show t) =>
                      AreaSpots4D z t x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots4D :: forall z t x y.
(PlotValue z, PlotValue t, Show t) =>
AreaSpots4D z t x y -> PointMapFn x y -> BackendProgram ()
renderAreaSpots4D AreaSpots4D z t x y
p PointMapFn x y
pmap = 
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall z t x y.
(PlotValue z, PlotValue t, Show t) =>
Double -> Int -> [(x, y, z, t)] -> [(x, y, Double, Int)]
scaleMax (forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_max_radius AreaSpots4D z t x y
pforall a b. (Num a, Integral b) => a -> b -> a
^(Integer
2::Integer))
                    (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall z t x y. AreaSpots4D z t x y -> [Colour Double]
_area_spots_4d_palette AreaSpots4D z t x y
p))
                    (forall z t x y. AreaSpots4D z t x y -> [(x, y, z, t)]
_area_spots_4d_values AreaSpots4D z t x y
p))
          (\ (x
x,y
y,Double
z,Int
t)-> do
              let radius :: Double
radius  = forall a. Floating a => a -> a
sqrt Double
z
              let colour :: Colour Double
colour  = forall z t x y. AreaSpots4D z t x y -> [Colour Double]
_area_spots_4d_palette AreaSpots4D z t x y
p forall a. [a] -> Int -> a
!! Int
t 
              let psSpot :: PointStyle
psSpot
                    = Double -> AlphaColour Double -> PointStyle
filledCircles Double
radius forall a b. (a -> b) -> a -> b
$
                          forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity Colour Double
colour (forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_opacity AreaSpots4D z t x y
p)
              PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psSpot (PointMapFn x y
pmap (forall a. a -> Limit a
LValue x
x, forall a. a -> Limit a
LValue y
y))
              let psOutline :: PointStyle
psOutline
                    = Double -> Double -> AlphaColour Double -> PointStyle
hollowCircles Double
radius (forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_linethick AreaSpots4D z t x y
p)
                                           (forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
colour)
              PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psOutline (PointMapFn x y
pmap (forall a. a -> Limit a
LValue x
x, forall a. a -> Limit a
LValue y
y))
          )
  where
    scaleMax :: (PlotValue z, PlotValue t, Show t) =>
                Double -> Int -> [(x,y,z,t)] -> [(x,y,Double,Int)]
    scaleMax :: forall z t x y.
(PlotValue z, PlotValue t, Show t) =>
Double -> Int -> [(x, y, z, t)] -> [(x, y, Double, Int)]
scaleMax Double
n Int
c [(x, y, z, t)]
points = let largest :: Double
largest  = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field3 s t a b => Lens s t a b
_3forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. PlotValue a => a -> Double
toValue) [(x, y, z, t)]
points)
                              scale :: a -> Double
scale a
v  = Double
n forall a. Num a => a -> a -> a
* forall a. PlotValue a => a -> Double
toValue a
v forall a. Fractional a => a -> a -> a
/ Double
largest
                              colVals :: [Double]
colVals  = forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall s t a b. Field4 s t a b => Lens s t a b
_4forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. PlotValue a => a -> Double
toValue) [(x, y, z, t)]
points
                              colMin :: Double
colMin   = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
colVals
                              colMax :: Double
colMax   = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
colVals
                              select :: a -> Int
select a
t = forall a. Ord a => a -> a -> a
min (Int
cforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ 
                                         forall a b. (RealFrac a, Integral b) => a -> b
truncate ( forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c
                                                       forall a. Num a => a -> a -> a
* (forall a. PlotValue a => a -> Double
toValue a
tforall a. Num a => a -> a -> a
-Double
colMin)
                                                       forall a. Fractional a => a -> a -> a
/ (Double
colMaxforall a. Num a => a -> a -> a
-Double
colMin))
                          in forall a b. (a -> b) -> [a] -> [b]
map (\ (x
x,y
y,z
z,t
t) -> (x
x,y
y, forall a. PlotValue a => a -> Double
scale z
z, forall {a}. PlotValue a => a -> Int
select t
t))
                                 [(x, y, z, t)]
points

renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> BackendProgram ()
renderSpotLegend4D :: forall z t x y. AreaSpots4D z t x y -> Rect -> BackendProgram ()
renderSpotLegend4D AreaSpots4D z t x y
p (Rect Point
p1 Point
p2) = do
    let radius :: Double
radius = forall a. Ord a => a -> a -> a
min (forall a. Num a => a -> a
abs (Point -> Double
p_y Point
p1 forall a. Num a => a -> a -> a
- Point -> Double
p_y Point
p2)) (forall a. Num a => a -> a
abs (Point -> Double
p_x Point
p1 forall a. Num a => a -> a -> a
- Point -> Double
p_x Point
p2))
        centre :: Point
centre = Point -> Point -> Point
linearInterpolate Point
p1 Point
p2
        palCol :: Colour Double
palCol = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall z t x y. AreaSpots4D z t x y -> [Colour Double]
_area_spots_4d_palette AreaSpots4D z t x y
p
        psSpot :: PointStyle
psSpot = Double -> AlphaColour Double -> PointStyle
filledCircles Double
radius forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> a -> AlphaColour a
withOpacity Colour Double
palCol
                                        (forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_opacity AreaSpots4D z t x y
p)
        psOutline :: PointStyle
psOutline = Double -> Double -> AlphaColour Double -> PointStyle
hollowCircles Double
radius (forall z t x y. AreaSpots4D z t x y -> Double
_area_spots_4d_linethick AreaSpots4D z t x y
p)
                                         (forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
palCol)
    PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psSpot Point
centre
    PointStyle -> Point -> BackendProgram ()
drawPoint PointStyle
psOutline Point
centre
  where
    linearInterpolate :: Point -> Point -> Point
linearInterpolate (Point Double
x0 Double
y0) (Point Double
x1 Double
y1) =
        Double -> Double -> Point
Point (Double
x0 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs(Double
x1forall a. Num a => a -> a -> a
-Double
x0)forall a. Fractional a => a -> a -> a
/Double
2) (Double
y0 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs(Double
y1forall a. Num a => a -> a -> a
-Double
y0)forall a. Fractional a => a -> a -> a
/Double
2)

$( makeLenses ''AreaSpots )
$( makeLenses ''AreaSpots4D )