{-|
Functions to build Traces from standard data. Generated traces can still be
customized with lenses.
-}
module Graphics.Plotly.Simple where

import Data.Aeson
import Data.Text (Text)
import Lens.Micro

import Graphics.Plotly.Base


-- |Generate a scatterplot from pairs
scatterPlot :: (ToJSON a, ToJSON b) => [(a, b)] -> Trace
scatterPlot :: forall a b. (ToJSON a, ToJSON b) => [(a, b)] -> Trace
scatterPlot [(a, b)]
xys = Trace
scatter
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((a, b) -> Value) -> [(a, b)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> ((a, b) -> a) -> (a, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
xys
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((a, b) -> Value) -> [(a, b)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> Value
forall a. ToJSON a => a -> Value
toJSON (b -> Value) -> ((a, b) -> b) -> (a, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd) [(a, b)]
xys
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Mode] -> Identity (Maybe [Mode]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Mode])
mode  ((Maybe [Mode] -> Identity (Maybe [Mode]))
 -> Trace -> Identity Trace)
-> [Mode] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Mode
Markers]


-- |Generate a line plot from pairs
linePlot :: (ToJSON a, ToJSON b) => [(a, b)] -> Trace
linePlot :: forall a b. (ToJSON a, ToJSON b) => [(a, b)] -> Trace
linePlot [(a, b)]
xys = Trace
scatter
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((a, b) -> Value) -> [(a, b)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> ((a, b) -> a) -> (a, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
xys
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((a, b) -> Value) -> [(a, b)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> Value
forall a. ToJSON a => a -> Value
toJSON (b -> Value) -> ((a, b) -> b) -> (a, b) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
forall a b. (a, b) -> b
snd) [(a, b)]
xys
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Mode] -> Identity (Maybe [Mode]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Mode])
mode  ((Maybe [Mode] -> Identity (Maybe [Mode]))
 -> Trace -> Identity Trace)
-> [Mode] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Mode
Lines]


-- |Generate a horizontal bar chart from pairs of text and value.
hbarChart :: [(Text, Double)] -> Trace
hbarChart :: [(Text, Double)] -> Trace
hbarChart [(Text, Double)]
tvs = Trace
bars
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y             ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Text, Double) -> Value) -> [(Text, Double)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> ((Text, Double) -> Text) -> (Text, Double) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Text
forall a b. (a, b) -> a
fst) [(Text, Double)]
tvs
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x             ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Text, Double) -> Value) -> [(Text, Double)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value)
-> ((Text, Double) -> Double) -> (Text, Double) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
tvs
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe Orientation -> Identity (Maybe Orientation))
-> Trace -> Identity Trace
Lens' Trace (Maybe Orientation)
orientation   ((Maybe Orientation -> Identity (Maybe Orientation))
 -> Trace -> Identity Trace)
-> Orientation -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Orientation
Horizontal


-- |Generate a horizontal bar chart from pairs of text and value.
vbarChart :: [(Text, Double)] -> Trace
vbarChart :: [(Text, Double)] -> Trace
vbarChart [(Text, Double)]
tvs = Trace
bars
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x             ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Text, Double) -> Value) -> [(Text, Double)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> ((Text, Double) -> Text) -> (Text, Double) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Text
forall a b. (a, b) -> a
fst) [(Text, Double)]
tvs
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y             ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ((Text, Double) -> Value) -> [(Text, Double)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Double -> Value)
-> ((Text, Double) -> Double) -> (Text, Double) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
tvs
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe Orientation -> Identity (Maybe Orientation))
-> Trace -> Identity Trace
Lens' Trace (Maybe Orientation)
orientation   ((Maybe Orientation -> Identity (Maybe Orientation))
 -> Trace -> Identity Trace)
-> Orientation -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Orientation
Vertical


-- |Generate a fan plot with a given width in standard deviations and
--  (x,(y,sd)) data
fanPlot :: Double -> [(Double, (Double, Double))] -> Trace
fanPlot :: Double -> [(Double, (Double, Double))] -> Trace
fanPlot Double
sdCount [(Double, (Double, Double))]
tmnsds = Trace
scatter
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
x     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Double -> Value) -> [Double] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Value
forall a. ToJSON a => a -> Value
toJSON [Double]
xs
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe [Value] -> Identity (Maybe [Value]))
-> Trace -> Identity Trace
Lens' Trace (Maybe [Value])
y     ((Maybe [Value] -> Identity (Maybe [Value]))
 -> Trace -> Identity Trace)
-> [Value] -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (Double -> Value) -> [Double] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Value
forall a. ToJSON a => a -> Value
toJSON [Double]
ys
    Trace -> (Trace -> Trace) -> Trace
forall a b. a -> (a -> b) -> b
& (Maybe Fill -> Identity (Maybe Fill)) -> Trace -> Identity Trace
Lens' Trace (Maybe Fill)
fill  ((Maybe Fill -> Identity (Maybe Fill)) -> Trace -> Identity Trace)
-> Fill -> Trace -> Trace
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Fill
ToZeroY
  where
    xs :: [Double]
xs = ((Double, (Double, Double)) -> Double)
-> [(Double, (Double, Double))] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, (Double, Double)) -> Double
forall a b. (a, b) -> a
fst [(Double, (Double, Double))]
tmnsds [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double] -> [Double]
forall a. [a] -> [a]
reverse (((Double, (Double, Double)) -> Double)
-> [(Double, (Double, Double))] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, (Double, Double)) -> Double
forall a b. (a, b) -> a
fst [(Double, (Double, Double))]
tmnsds)
    ys :: [Double]
ys = ((Double, (Double, Double)) -> Double)
-> [(Double, (Double, Double))] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\(Double
m, Double
sd) -> Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sdCount Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sd) ((Double, Double) -> Double)
-> ((Double, (Double, Double)) -> (Double, Double))
-> (Double, (Double, Double))
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Double, Double)) -> (Double, Double)
forall a b. (a, b) -> b
snd) [(Double, (Double, Double))]
tmnsds
            [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double] -> [Double]
forall a. [a] -> [a]
reverse (((Double, (Double, Double)) -> Double)
-> [(Double, (Double, Double))] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\(Double
m, Double
sd) -> Double
m Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
sdCount Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sd) ((Double, Double) -> Double)
-> ((Double, (Double, Double)) -> (Double, Double))
-> (Double, (Double, Double))
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, (Double, Double)) -> (Double, Double)
forall a b. (a, b) -> b
snd) [(Double, (Double, Double))]
tmnsds)