hvega-0.5.0.0: tests/Gallery/Interaction.hs
{-# LANGUAGE OverloadedStrings #-}
--
-- Based on the Elm VegaLite GalleryInteraction.elm (from development of version
-- 1.13.0)
--
module Gallery.Interaction (testSpecs) where
import qualified Data.Text as T
import Graphics.Vega.VegaLite
import Prelude hiding (filter, lookup)
testSpecs :: [(String, VegaLite)]
testSpecs = [ ("interaction1", interaction1)
, ("interaction2", interaction2)
, ("interaction3", interaction3)
, ("interaction4", interaction4)
, ("interaction5", interaction5)
, ("interaction6", interaction6)
, ("interaction7", interaction7)
, ("interaction8", interaction8)
, ("interaction9", interaction9)
, ("interaction10", interaction10)
, ("interaction11a", interaction11a)
, ("interaction11b", interaction11b)
, ("interaction11c", interaction11c)
, ("interaction11d", interaction11d)
]
pQuant :: T.Text -> [PositionChannel]
pQuant n = [ PName n, PmType Quantitative ]
interaction1 :: VegaLite
interaction1 =
let
des =
description "A bar chart with highlighting on hover and selecting on click. Inspired by Tableau's interaction style."
config =
configure
. configuration (Scale [ SCBandPaddingInner 0.2 ])
dvals =
dataFromColumns []
. dataColumn "a" (Strings [ "A", "B", "C", "D", "E", "F", "G", "H", "I" ])
. dataColumn "b" (Numbers [ 28, 55, 43, 91, 81, 53, 19, 87, 52 ])
sel =
selection
. select "highlight" Single [ On "mouseover", Empty ]
. select "select" Multi []
enc =
encoding
. position X [ PName "a", PmType Ordinal ]
. position Y [ PName "b", PmType Quantitative ]
. fillOpacity [ MSelectionCondition (SelectionName "select") [ MNumber 1 ] [ MNumber 0.3 ] ]
. strokeWidth
[ MDataCondition
[ ( And (Selection "select") (Expr "length(data(\"select_store\"))"), [ MNumber 2 ] )
, ( Selection "highlight", [ MNumber 1 ] )
]
[ MNumber 0 ]
]
in
toVegaLite
[ des
, config []
, dvals []
, sel []
, mark Bar [ MFill "#4C78A8", MStroke "black", MCursor CPointer ]
, enc []
]
interaction2 :: VegaLite
interaction2 =
let
des =
description "Scatterplot with external links and tooltips"
trans =
transform
. calculateAs "'https://www.google.com/search?q=' + datum.Name" "url"
enc =
encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
. color [ MName "Origin", MmType Nominal ]
. tooltip [ TName "Name", TmType Nominal ]
. hyperlink [ HName "url", HmType Nominal ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, trans []
, mark Point []
, enc []
]
interaction3 :: VegaLite
interaction3 =
let
des =
description "Drag out a rectangular brush to highlight points"
sel =
selection . select "myBrush" Interval []
enc =
encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
. color
[ MSelectionCondition (SelectionName "myBrush")
[ MName "Cylinders", MmType Ordinal ]
[ MString "grey" ]
]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, mark Point []
, sel []
, enc []
]
interaction4 :: VegaLite
interaction4 =
let
des =
description "Area chart with rectangular brush"
trans =
transform
. filter (FSelection "myBrush")
sel =
selection . select "myBrush" Interval [ Encodings [ ChX ] ]
enc =
encoding
. position X [ PName "date", PmType Temporal, PTimeUnit YearMonth ]
. position Y [ PName "count", PmType Quantitative, PAggregate Sum ]
specBackground =
asSpec [ mark Area [], sel [] ]
specHighlight =
asSpec [ mark Area [ MColor "goldenrod" ], trans [] ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/unemployment-across-industries.json" []
, enc []
, layer [ specBackground, specHighlight ]
]
interaction5 :: VegaLite
interaction5 =
let
des =
description "Mouse over individual points or select multiple points with the shift key"
sel =
selection . select "myPaintbrush" Multi [ On "mouseover", Nearest True ]
enc =
encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
. size
[ MSelectionCondition (SelectionName "myPaintbrush")
[ MNumber 300 ]
[ MNumber 50 ]
]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, mark Point []
, sel []
, enc []
]
interaction6 :: VegaLite
interaction6 =
let
des =
description "Drag to pan. Zoom in or out with mousewheel/zoom gesture."
sel =
selection . select "myGrid" Interval [ BindScales ]
enc =
encoding
. position X [ PName "Horsepower", PmType Quantitative, PScale [ SDomain (DNumbers [ 75, 150 ]) ] ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative, PScale [ SDomain (DNumbers [ 20, 40 ]) ] ]
. size [ MName "Cylinders", MmType Quantitative ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, mark Circle []
, sel []
, enc []
]
interaction7 :: VegaLite
interaction7 =
let
des =
description "Drag the sliders to highlight points"
trans =
transform
. calculateAs "year(datum.Year)" "Year"
sel1 =
selection
. select "CylYr"
Single
[ Fields [ "Cylinders", "Year" ]
, SInit [ ( "Cylinders", Number 4 ), ( "Year", Number 1977 ) ]
, Bind
[ IRange "Cylinders" [ InName "Cylinders ", InMin 3, InMax 8, InStep 1 ]
, IRange "Year" [ InName "Year ", InMin 1969, InMax 1981, InStep 1 ]
]
]
encPosition =
encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
enc1 =
encoding
. color
[ MSelectionCondition (SelectionName "CylYr")
[ MName "Origin", MmType Nominal ]
[ MString "grey" ]
]
spec1 =
asSpec [ sel1 [], mark Circle [], enc1 [] ]
trans2 =
transform
. filter (FSelection "CylYr")
enc2 =
encoding
. color [ MName "Origin", MmType Nominal ]
. size [ MNumber 100 ]
spec2 =
asSpec [ trans2 [], mark Circle [], enc2 [] ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, trans []
, encPosition []
, layer [ spec1, spec2 ]
]
interaction8 :: VegaLite
interaction8 =
let
des =
description "Drag over bars to update selection average"
sel =
selection . select "myBrush" Interval [ Encodings [ ChX ] ]
encPosition =
encoding . position Y [ PName "precipitation", PmType Quantitative, PAggregate Mean ]
enc1 =
encoding
. position X [ PName "date", PmType Ordinal, PTimeUnit Month ]
. opacity
[ MSelectionCondition (SelectionName "myBrush")
[ MNumber 1 ]
[ MNumber 0.7 ]
]
spec1 =
asSpec [ sel [], mark Bar [], enc1 [] ]
trans =
transform
. filter (FSelection "myBrush")
enc2 =
encoding
. color [ MString "firebrick" ]
. size [ MNumber 3 ]
spec2 =
asSpec [ des, trans [], mark Rule [], enc2 [] ]
in
toVegaLite
[ dataFromUrl "https://vega.github.io/vega-lite/data/seattle-weather.csv" []
, encPosition []
, layer [ spec1, spec2 ]
]
interaction9 :: VegaLite
interaction9 =
let
desc =
description "Displays tooltips for all stock prices of the hovered time"
enc1 =
encoding
. position X [ PName "date", PmType Temporal ]
. position Y [ PName "price", PmType Quantitative ]
. color [ MName "symbol", MmType Nominal ]
spec1 =
asSpec
[ enc1 []
, layer
[ asSpec [ mark Line [] ]
, asSpec [ mark Point [], sel1_2 [], enc1_2 [] ]
]
]
enc1_2 =
encoding
. opacity [ MSelectionCondition (Expr "myTooltip") [ MNumber 1 ] [ MNumber 0 ] ]
sel1_2 =
selection
. select "myTooltip"
Single
[ Nearest True
, On "mouseover"
, Encodings [ ChX ]
, Empty
]
spec2 =
asSpec [ trans2 [], layer [ spec2_1, spec2_2 ] ]
trans2 =
transform . filter (FSelection "myTooltip")
spec2_1 =
asSpec [ mark Rule [ MColor "gray" ], enc2_1 [] ]
enc2_1 =
encoding . position X [ PName "date", PmType Temporal ]
spec2_2 =
asSpec [ mark Text [ MAlign AlignLeft, MdX 5, MdY (-5) ], enc2_2 [] ]
enc2_2 =
encoding
. position X [ PName "date", PmType Temporal ]
. position Y [ PName "price", PmType Quantitative ]
. text [ TName "price", TmType Quantitative ]
. color [ MName "symbol", MmType Nominal ]
in
toVegaLite
[ width 800
, height 400
, desc
, dataFromUrl "https://vega.github.io/vega-lite/data/stocks.csv" [ Parse [ ( "date", FoDate "" ) ] ]
, layer [ spec1, spec2 ]
]
interaction10 :: VegaLite
interaction10 =
let
desc =
description "Multi Series Line Chart with Tooltip"
config =
configure
. configuration (AxisY [ MinExtent 30 ])
enc =
encoding
. position X [ PName "date", PmType Temporal, PTimeUnit YearMonthDate ]
. tooltips
[ [ TName "date", TmType Temporal, TTimeUnit YearMonthDate ]
, [ TName "temp_max", TmType Quantitative ]
, [ TName "temp_min", TmType Quantitative ]
]
enc1 =
encoding
. position Y [ PName "temp_max", PmType Quantitative ]
spec1 =
asSpec [ mark Line [ MColor "orange" ], enc1 [] ]
enc2 =
encoding
. position Y [ PName "temp_min", PmType Quantitative ]
spec2 =
asSpec [ mark Line [ MColor "red" ], enc2 [] ]
sel =
selection
. select "hover" Single [ On "mouseover", Empty ]
enc3 =
encoding
. color
[ MSelectionCondition (Not (SelectionName "hover"))
[ MString "transparent" ]
[]
]
spec3 =
asSpec [ sel [], mark Rule [], enc3 [] ]
in
toVegaLite
[ config []
, desc
, dataFromUrl "https://vega.github.io/vega-lite/data/seattle-weather.csv" []
, enc []
, layer [ spec1, spec2, spec3 ]
]
-- From https://vega.github.io/vega-lite/examples/interactive_brush.html
-- and added to test SInitInterval
--
initInterval :: Maybe (DataValue, DataValue) -> Maybe (DataValue, DataValue) -> VegaLite
initInterval mx my =
let desc = "Drag out a rectangular brush to highlight points."
sel = selection
. select "brush" Interval [ SInitInterval mx my ]
enc = encoding
. position X (pQuant "Horsepower")
. position Y (pQuant "Miles_per_Gallon")
. color [ MSelectionCondition
(SelectionName "brush")
[ MName "Cylinders", MmType Ordinal ]
[ MString "grey" ]
]
in toVegaLite
[ description desc
, dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, mark Point []
, enc []
, sel []
]
xInit, yInit :: (DataValue, DataValue)
xInit = (Number 55, Number 160)
yInit = (Number 13, Number 37)
-- Note: the Vega-Lite spec (circa version 4) does not support the
-- "Nothing Nothing" case - aka interaction11a - so this is a
-- check to make sure we handle this case correctly.
--
interaction11a, interaction11b, interaction11c, interaction11d :: VegaLite
interaction11a = initInterval Nothing Nothing
interaction11b = initInterval (Just xInit) Nothing
interaction11c = initInterval Nothing (Just yInit)
interaction11d = initInterval (Just xInit) (Just yInit)