{-# 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 ] ]