hvega-0.5.0.0: tests/CompositeTests.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
--
-- Based on the Elm VegaLite CompositeTests.elm as of version 1.12.0
--
module CompositeTests (testSpecs) where
import qualified Data.Text as T
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Graphics.Vega.VegaLite
testSpecs :: [(String, VegaLite)]
testSpecs = [ ("boxplot1", boxplot1)
, ("boxplot2", boxplot2)
, ("boxplot3", boxplot3)
, ("errorband1", errorband1)
, ("errorband2", errorband2)
, ("errorbar1", errorbar1)
, ("errorbar2", errorbar2)
, ("errorbar3", errorbar3)
, ("errorbar4", errorbar4)
, ("errorbar5", errorbar5)
, ("errorbar6", errorbar6)
, ("errorbar7", errorbar7)
]
-- help in converting from the Elm version
pName :: T.Text -> PositionChannel
pName = PName
pOrdinal, pQuant :: PositionChannel
pOrdinal = PmType Ordinal
pQuant = PmType Quantitative
bPlot :: MarkErrorExtent -> VegaLite
bPlot ext =
let
pop =
dataFromUrl "https://vega.github.io/vega-lite/data/population.json" []
enc =
encoding
. position X [ PName "age", PmType Ordinal ]
. position Y [ PName "people", PmType Quantitative, PAxis [ AxTitle "Population" ] ]
in
toVegaLite [ pop, mark Boxplot [ MExtent ext ], enc [] ]
boxplot1 :: VegaLite
boxplot1 = bPlot ExRange
boxplot2 :: VegaLite
boxplot2 = bPlot (IqrScale 2)
boxplot3 :: VegaLite
boxplot3 =
let
pop =
dataFromUrl "https://vega.github.io/vega-lite/data/population.json" []
enc =
encoding
. position X [ PName "age", PmType Ordinal ]
. position Y [ PName "people", PmType Quantitative, PAxis [ AxTitle "Population" ] ]
in
toVegaLite
[ pop
, mark Boxplot
[ MExtent (IqrScale 0.5)
, MBox [ MColor "firebrick" ]
, MOutliers [ MColor "black", MStrokeWidth 0.3, MSize 10 ]
, MMedian [ MSize 18, MFill "black", MStrokeWidth 0 ]
, MRule [ MStrokeWidth 0.4 ]
, MTicks [ MSize 8 ]
]
, enc []
]
-- Note: at present only called with ci or stdev arguments
eBand :: T.Text -> VegaLite
eBand ext =
let
cars =
dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
label =
case ext of
"ci" ->
"(95% CI)"
"stdev" ->
"(1 stdev)"
"stderr" ->
"(1 std Error)"
"range" ->
"(min to max)"
_ ->
"(IQR)"
summary =
case ext of
"ci" ->
ConfidenceInterval
"stdev" ->
StdDev
"stderr" ->
StdErr
{-
"range" ->
ExRange
-}
_ ->
Iqr
enc =
encoding
. position X [ PName "Year", PmType Temporal, PTimeUnit Year ]
. position Y
[ PName "Miles_per_Gallon"
, PmType Quantitative
, PScale [ SZero False ]
, PTitle ("Miles per Gallon " <> label)
]
mopts = [ MExtent summary, MInterpolate Monotone, MBorders [] ]
in
toVegaLite [ cars
, mark ErrorBand mopts
, enc [] ]
errorband1 :: VegaLite
errorband1 =
eBand "ci"
errorband2 :: VegaLite
errorband2 =
eBand "stdev"
eBar :: MarkErrorExtent -> VegaLite
eBar ext =
let
barley =
dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" []
enc =
encoding
. position X [ PName "yield", PmType Quantitative
, PScale [ SZero False ] ]
. position Y
[ PName "variety"
, PmType Ordinal
]
mopts = [ MExtent ext, MTicks [ MStroke "blue" ] ]
in
toVegaLite [ barley
, mark ErrorBar mopts
, enc [] ]
errorbar1 :: VegaLite
errorbar1 =
eBar ConfidenceInterval
errorbar2 :: VegaLite
errorbar2 =
eBar StdDev
errorbar3 :: VegaLite
errorbar3 =
let
des =
description "Error bars with color encoding"
specErrorBars =
asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
encErrorBars =
encoding
. position X [ PName "yield", PmType Quantitative
, PScale [ SZero False ] ]
. position Y [ PName "variety", PmType Ordinal ]
. color [ MString "#4682b4" ]
specPoints =
asSpec [ mark Point [ MFilled True, MColor "black" ], encPoints [] ]
encPoints =
encoding
. position X [ PName "yield", PmType Quantitative
, PAggregate Mean ]
. position Y [ PName "variety", PmType Ordinal ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/barley.json" []
, layer [ specErrorBars, specPoints ]
]
yieldData :: [DataColumn] -> Data
yieldData =
dataFromColumns []
. dataColumn "yieldError" (Numbers [ 7.55, 6.98, 3.92, 11.97 ])
. dataColumn "yieldError2" (Numbers [ -10.55, -3.98, -0.92, -15.97 ])
. dataColumn "yield" (Numbers [ 32.4, 30.97, 33.96, 30.45 ])
. dataColumn "variety" (Strings [ "Glabron", "Manchuria", "No. 457", "No. 462" ])
errorbar4 :: VegaLite
errorbar4 =
let des = description "Symetric error bars encoded with xError channel"
specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
encErrorBars = encoding
. position X [ pName "yield", pQuant
, PScale [ SZero False ] ]
. position Y [ pName "variety", pOrdinal ]
. position XError [ pName "yieldError" ]
specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
, encPoints [] ]
encPoints = encoding
. position X [ pName "yield", pQuant ]
. position Y [ pName "variety", pOrdinal ]
in toVegaLite [ des, yieldData []
, layer [ specErrorBars, specPoints ]
]
errorbar5 :: VegaLite
errorbar5 =
let des = description "Asymetric error bars encoded with xError and xError2 channels"
specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ]
, encErrorBars [] ]
encErrorBars =
encoding
. position X [ pName "yield", pQuant, PScale [ SZero False ] ]
. position Y [ pName "variety", pOrdinal ]
. position XError [ pName "yieldError" ]
. position XError2 [ pName "yieldError2" ]
specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
, encPoints [] ]
encPoints = encoding
. position X [ pName "yield", pQuant ]
. position Y [ pName "variety", pOrdinal ]
in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]
errorbar6 :: VegaLite
errorbar6 =
let des = description "Symetric error bars encoded with yError channel"
specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
encErrorBars = encoding
. position Y [ pName "yield", pQuant, PScale [ SZero False ] ]
. position X [ pName "variety", pOrdinal ]
. position YError [ pName "yieldError" ]
specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
, encPoints [] ]
encPoints = encoding
. position Y [ pName "yield", pQuant ]
. position X [ pName "variety", pOrdinal ]
in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]
errorbar7 :: VegaLite
errorbar7 =
let des = description "Asymetric error bars encoded with yError and yError2 channels"
specErrorBars = asSpec [ mark ErrorBar [ MTicks [] ], encErrorBars [] ]
encErrorBars = encoding
. position Y [ pName "yield", pQuant, PScale [ SZero False ] ]
. position X [ pName "variety", pOrdinal ]
. position YError [ pName "yieldError" ]
. position YError2 [ pName "yieldError2" ]
specPoints = asSpec [ mark Point [ MFilled True, MColor "black" ]
, encPoints [] ]
encPoints = encoding
. position Y [ pName "yield", pQuant ]
. position X [ pName "variety", pOrdinal ]
in toVegaLite [ des, yieldData [], layer [ specErrorBars, specPoints ] ]