{-# LANGUAGE OverloadedStrings #-}
--
-- Based on the Elm VegaLite ConditionalTests.elm as of version 1.12.0
--
module ConditionalTests (testSpecs) where
import Graphics.Vega.VegaLite
import Data.Function ((&))
import Prelude hiding (filter)
testSpecs :: [(String, VegaLite)]
testSpecs = [ ("markCondition1", markCondition1)
, ("markCondition2", markCondition2)
, ("axisCondition1", axisCondition1)
, ("axisCondition2", axisCondition2)
, ("axisCondition3", axisCondition3)
, ("axisconditionlabeloffset", axisConditionLabelOffset)
, ("axisDateCondition1", axisDateCondition1)
, ("selectionCondition1", selectionCondition1)
, ("selectionCondition2", selectionCondition2)
, ("selectionCondition3", selectionCondition3)
, ("selectionCondition4", selectionCondition4)
, ("selectionCondition5", selectionCondition5)
, ("bindScales1", bindScales1)
, ("bindScales2", bindScales2)
]
movieData, carData :: Data
movieData = dataFromUrl "https://vega.github.io/vega-lite/data/movies.json" []
carData = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
rtRating :: BuildEncodingSpecs
rtRating = position Y [ PName "Rotten_Tomatoes_Rating", PmType Quantitative ]
encCars :: [EncodingSpec] -> PropertySpec
encCars = encoding
. position Y [ PName "Origin", PmType Ordinal ]
. position X [ PName "Cylinders", PmType Ordinal ]
encHorses :: [EncodingSpec] -> PropertySpec
encHorses = encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
markCondition1 :: VegaLite
markCondition1 =
let
config =
configure
. configuration (MarkStyle [ MRemoveInvalid False ])
enc =
encoding
. position X [ PName "IMDB_Rating", PmType Quantitative ]
. rtRating
. color
[ MDataCondition
[ ( Or (Expr "datum.IMDB_Rating === null")
(Expr "datum.Rotten_Tomatoes_Rating === null")
, [ MString "#ddd" ]
)
]
[ MString "#0099ee" ]
]
in
toVegaLite [ config []
, movieData
-- Vega-Lite 4 turned off tooltips by default, so
-- enable them here
, mark Point [ MTooltip TTEncoding ]
, enc [] ]
markCondition2 :: VegaLite
markCondition2 =
let
dataVals =
dataFromColumns []
. dataColumn "value" (Numbers [ 10, 20, 30, 40, 50, 60 ])
enc =
encoding
. position X [ PName "value", PmType Ordinal ]
. color
[ MDataCondition
[ ( Expr "datum.value < 40", [ MString "blue" ] )
, ( Expr "datum.value < 50", [ MString "red" ] )
, ( Expr "datum.value < 60", [ MString "yellow" ] )
]
[ MString "black" ]
]
in
toVegaLite [ width 400, dataVals [], mark Circle [ MSize 800 ], enc [] ]
axisTest :: [AxisProperty] -> VegaLite
axisTest axConds =
let enc = encoding
. position X
[ PName "IMDB_Rating"
, PmType Quantitative
, PAxis (AxTickCount 20 : axConds)
]
. rtRating
in toVegaLite [ width 600, height 600, movieData, mark Point [ MOpacity 0.1 ], enc [] ]
axisCondition1 :: VegaLite
axisCondition1 =
axisTest [ AxDataCondition (Expr "datum.value <= 5") (CAxGridDash [ 5, 5 ] [])
, AxDataCondition (Expr "datum.value <= 7") (CAxGridColor "green" "red")
]
axisCondition2 :: VegaLite
axisCondition2 =
axisTest [ AxDataCondition (Expr "datum.value <= 2") (CAxTickColor "red" "blue")
, AxDataCondition (Expr "datum.value >=8") (CAxTickOpacity 0.3 0.8)
, AxDataCondition (Expr "datum.label =='4.0'") (CAxTickWidth 5 2)
, AxDataCondition (Expr "(datum.value >= 5) && (datum.value <= 8)")
(CAxTickDash [2, 2] [])
{- Vega-Embed (Early Jan 2020) doesn't seem to display this well
, AxDataCondition (Expr "(datum.value >= 3) && (datum.value <= 7)")
(CAxTickDashOffset 4 0)
-}
, AxDataCondition (Expr "(datum.value > 0) && (datum.value < 3)")
(CAxTickSize 20 5)
, AxDataCondition (Expr "(datum.value >= 1) && (datum.value <= 4)")
(CAxLabelPadding 20 5)
]
axisCondition3 :: VegaLite
axisCondition3 =
axisTest [ AxDataCondition (Expr "datum.value <= 2") (CAxLabelColor "red" "blue")
, AxDataCondition (Expr "datum.value <= 1") (CAxLabelAlign AlignRight AlignLeft)
, AxDataCondition (Expr "datum.value <= 3") (CAxLabelBaseline AlignTop AlignBottom)
, AxDataCondition (Expr "datum.value <= 4") (CAxLabelFont "serif" "sans-serif")
, AxDataCondition (Expr "datum.value <= 6") (CAxLabelFontSize 12 18)
, AxDataCondition (Expr "datum.value <=8") (CAxLabelFontStyle "normal" "italic")
, AxDataCondition (Expr "datum.label =='4.0'") (CAxLabelFontWeight Bold W100)
, AxDataCondition (Expr "datum.value >=9") (CAxLabelOpacity 0.3 0.8)
]
-- Vega Lite 4.5.0 or later
axisConditionLabelOffset :: VegaLite
axisConditionLabelOffset =
axisTest [ AxDataCondition (Expr "datum.value <= 5") (CAxLabelOffset 10 5) ]
-- add a basic test of date handling (so that I can check the example given in the
-- documentation, or at least one similar to it, even if in this case it affects
-- all grid lines).
--
axisDateCondition1 :: VegaLite
axisDateCondition1 =
let enc =
encoding
. position X [ PName "Year"
, PmType Temporal
, PTimeUnit Year
, PAxis [ AxDataCondition
(FEqual "value" (DateTime [DTMonth Jan, DTDate 1])
& FilterOpTrans (MTimeUnit MonthDate))
(CAxGridWidth 4 1)
]
]
. position Y [ PName "Miles_per_Gallon"
, PmType Quantitative
, PScale [ SZero False ]
]
mopts = [ MExtent Iqr, MInterpolate Monotone, MBorders [] ]
in toVegaLite [ width 600, carData, enc [], mark ErrorBand mopts ]
selectionCondition1 :: VegaLite
selectionCondition1 =
let sel =
selection
. select "alex"
Interval
[ On "[mousedown[!event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
]
. select "morgan"
Interval
[ On "[mousedown[event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[event.shiftKey], mouseup] > mousemove"
, SelectionMark [ SMFill "#fdbb84", SMFillOpacity 0.5, SMStroke "#e34a33" ]
]
enc = encCars
. color [ MAggregate Count, MName "*", MmType Quantitative ]
in
toVegaLite
[ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]
selectionCondition2 :: VegaLite
selectionCondition2 =
let sel =
selection
. select "alex"
Interval
[ On "[mousedown[!event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
]
. select "morgan"
Interval
[ On "[mousedown[event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[event.shiftKey], mouseup] > mousemove"
, SelectionMark [ SMFill "#fdbb84", SMFillOpacity 0.5, SMStroke "#e34a33" ]
]
enc = encCars
. color
[ MSelectionCondition
(And (SelectionName "alex") (SelectionName "morgan"))
[ MAggregate Count, MName "*", MmType Quantitative ]
[ MString "gray" ]
]
in
toVegaLite
[ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]
selectionCondition3 :: VegaLite
selectionCondition3 =
let trans =
transform
. filter (FCompose (And (Selection "brush") (Expr "datum.Weight_in_lbs > 3000")))
sel =
selection
. select "brush" Interval []
spec1 =
asSpec [ sel [], mark Point [], encHorses [] ]
enc2 =
encoding
. position X [ PName "Acceleration", PmType Quantitative, PScale [ SDomain (DNumbers [ 0, 25 ]) ] ]
. position Y [ PName "Displacement", PmType Quantitative, PScale [ SDomain (DNumbers [ 0, 500 ]) ] ]
spec2 =
asSpec [ trans [], mark Point [], enc2 [] ]
in
toVegaLite
[ carData, vConcat [ spec1, spec2 ] ]
selectionCondition4 :: VegaLite
selectionCondition4 =
let sel =
selection
. select "mySelection"
Interval
[ Clear ""
, On "[mousedown[!event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
]
enc = encCars
. color
[ MSelectionCondition
(SelectionName "mySelection")
[ MAggregate Count, MName "*", MmType Quantitative ]
[ MString "gray" ]
]
in
toVegaLite
[ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]
selectionCondition5 :: VegaLite
selectionCondition5 =
let sel =
selection
. select "mySelection"
Interval
[ Clear "mouseup"
, Empty
, On "[mousedown[!event.shiftKey], mouseup] > mousemove"
, Translate "[mousedown[!event.shiftKey], mouseup] > mousemove"
]
enc = encCars
. color
[ MSelectionCondition
(SelectionName "mySelection")
[ MAggregate Count, MName "*", MmType Quantitative ]
[ MString "gray" ]
]
in
toVegaLite
[ carData, sel [], mark Rect [ MCursor CGrab ], enc [] ]
bindScales1 :: VegaLite
bindScales1 =
let sel =
selection
. select "myZoomPan" Interval [ BindScales ]
in
toVegaLite
[ width 300, height 300, carData, sel [], mark Circle [], encHorses [] ]
bindScales2 :: VegaLite
bindScales2 =
let sel =
selection
. select "myZoomPan"
Interval
[ BindScales, Clear "click[event.shiftKey]" ]
in
toVegaLite
[ width 300, height 300, carData, sel [], mark Circle [], encHorses [] ]