hvega-0.7.0.0: tests/Gallery/Multi.hs
{-# LANGUAGE OverloadedStrings #-}
--
-- Based on the Elm VegaLite GalleryMulti.elm (from development of version
-- 1.13.0)
--
module Gallery.Multi (testSpecs) where
import Graphics.Vega.VegaLite
import Prelude hiding (filter, lookup, repeat)
testSpecs :: [(String, VegaLite)]
testSpecs = [ ("multi1", multi1)
, ("multi2", multi2)
, ("multi3", multi3)
, ("multi4", multi4)
, ("multi5", multi5)
, ("multi6", multi6)
, ("multi7", multi7)
, ("multi8", multi8)
, ("selectandzoom", selectAndZoom)
]
multi1 :: VegaLite
multi1 =
let
des =
description "Overview and detail."
sel =
selection . select "myBrush" Interval [ Encodings [ ChX ] ]
enc1 =
encoding
. position X
[ PName "date"
, PmType Temporal
, PScale [ SDomain (DSelection "myBrush") ]
, PAxis [ AxNoTitle ]
]
. position Y [ PName "price", PmType Quantitative ]
spec1 =
asSpec [ width 500, mark Area [], enc1 [] ]
enc2 =
encoding
. position X [ PName "date", PmType Temporal, PAxis [ AxFormat "%Y" ] ]
. position Y
[ PName "price"
, PmType Quantitative
, PAxis [ AxTickCount 3, AxGrid False ]
]
spec2 =
asSpec [ width 480, height 60, sel [], mark Area [], enc2 [] ]
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/sp500.csv" []
, vConcat [ spec1, spec2 ]
]
multi2 :: VegaLite
multi2 =
let
des =
description "Cross-filter."
trans =
transform
. calculateAs "hours(datum.date)" "time"
sel =
selection . select "myBrush" Interval [ Encodings [ ChX ] ]
selTrans =
transform
. filter (FSelection "myBrush")
encPosition =
encoding
. position X
[ PRepeat Column
, PmType Quantitative
, PBin [ MaxBins 20 ]
]
. position Y [ PAggregate Count, PmType Quantitative ]
spec1 =
asSpec [ sel [], mark Bar [] ]
spec2 =
asSpec [ selTrans [], mark Bar [], encoding (color [ MString "goldenrod" ] []) ]
spec =
asSpec
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/flights-2k.json" [ Parse [ ( "date", FoDate "" ) ] ]
, trans []
, encPosition []
, layer [ spec1, spec2 ]
]
in
toVegaLite
[ repeat [ ColumnFields [ "distance", "delay", "time" ] ]
, specification spec
]
multi3 :: VegaLite
multi3 =
let
des =
description "Scatterplot matrix"
sel =
selection
. select "myBrush"
Interval
[ On "[mousedown[event.shiftKey], window:mouseup] > window:mousemove!"
, Translate "[mousedown[event.shiftKey], window:mouseup] > window:mousemove!"
, Zoom "wheel![event.shiftKey]"
, ResolveSelections Union
]
. select "grid"
Interval
[ BindScales
, Translate "[mousedown[!event.shiftKey], window:mouseup] > window:mousemove!"
, Zoom "wheel![event.shiftKey]"
, ResolveSelections Global
]
enc =
encoding
. position X [ PRepeat Column, PmType Quantitative ]
. position Y [ PRepeat Row, PmType Quantitative ]
. color
[ MSelectionCondition (SelectionName "myBrush")
[ MName "Origin", MmType Nominal ]
[ MString "grey" ]
]
spec =
asSpec
[ dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
, mark Point []
, sel []
, enc []
]
in
toVegaLite
[ des
, repeat
[ RowFields [ "Horsepower", "Acceleration", "Miles_per_Gallon" ]
, ColumnFields [ "Miles_per_Gallon", "Acceleration", "Horsepower" ]
]
, specification spec
]
multi4 :: VegaLite
multi4 =
let
des =
description "A dashboard with cross-highlighting"
selTrans =
transform
. filter (FSelection "myPts")
encPosition =
encoding
. position X [ PName "IMDB_Rating", PmType Quantitative, PBin [ MaxBins 10 ] ]
. position Y [ PName "Rotten_Tomatoes_Rating", PmType Quantitative, PBin [ MaxBins 10 ] ]
colLegend = [ LTitle "All Movies"
, LDirection Horizontal
, LGradientLength 120
]
enc1 =
encoding
. color [ MAggregate Count, MmType Quantitative, MLegend colLegend ]
-- removed width as not valid in Vega-Lite 4.1.1
spec1 =
asSpec [ {- width 300, -} mark Rect [], enc1 [] ]
enc2 =
encoding
. size [ MAggregate Count, MmType Quantitative, MLegend [ LTitle "In Selected Category" ] ]
. color [ MString "#666" ]
spec2 =
asSpec [ selTrans [], mark Point [], enc2 [] ]
heatSpec =
asSpec [ encPosition [], layer [ spec1, spec2 ] ]
sel =
selection . select "myPts" Single [ Encodings [ ChX ] ]
barSpec =
asSpec [ width 330, height 120, mark Bar [], sel [], encBar [] ]
encBar =
encoding
. position X [ PName "Major_Genre", PmType Nominal, PAxis [ AxLabelAngle (-40) ] ]
. position Y [ PAggregate Count, PmType Quantitative ]
. color
[ MSelectionCondition (SelectionName "myPts")
[ MString "steelblue" ]
[ MString "grey" ]
]
config =
configure . configuration (RangeStyle [ RHeatmap "greenblue" ])
res =
resolve
. resolution (RLegend [ ( ChColor, Independent ), ( ChSize, Independent ) ])
in
toVegaLite
[ des
, dataFromUrl "https://vega.github.io/vega-lite/data/movies.json" []
, vConcat [ heatSpec, barSpec ]
, res []
, config []
]
multi5 :: VegaLite
multi5 =
let
des =
description "A dashboard with cross-highlighting"
spec1 =
asSpec
[ width 600, height 300, mark Point [], sel1 [], trans1 [], enc1 [] ]
sel1 =
selection . select "myBrush" Interval [ Encodings [ ChX ] ]
trans1 =
transform . filter (FSelection "myClick")
weatherColors =
categoricalDomainMap
[ ( "sun", "#e7ba52" )
, ( "fog", "#c7c7c7" )
, ( "drizzle", "#aec7ea" )
, ( "rain", "#1f77b4" )
, ( "snow", "#9467bd" )
]
enc1 =
encoding
. position X
[ PName "date"
, PmType Temporal
, PTimeUnit MonthDate
, PAxis [ AxTitle "Date", AxFormat "%b" ]
]
. position Y
[ PName "temp_max"
, PmType Quantitative
, PScale [ SDomain (DNumbers [ -5, 40 ]) ]
, PAxis [ AxTitle "Maximum Daily Temperature (C)" ]
]
. color
[ MSelectionCondition (SelectionName "myBrush")
[ MName "weather"
, MTitle "Weather"
, MmType Nominal
, MScale weatherColors
]
[ MString "#cfdebe" ]
]
. size
[ MName "precipitation"
, MmType Quantitative
, MScale [ SDomain (DNumbers [ -1, 50 ]) ]
]
spec2 =
asSpec [ width 600, mark Bar [], sel2 [], trans2 [], enc2 [] ]
sel2 =
selection . select "myClick" Multi [ Encodings [ ChColor ] ]
trans2 =
transform . filter (FSelection "myBrush")
enc2 =
encoding
. position X [ PAggregate Count, PmType Quantitative ]
. position Y [ PName "weather", PmType Nominal ]
. color
[ MSelectionCondition (SelectionName "myClick")
[ MName "weather"
, MmType Nominal
, MScale weatherColors
]
[ MString "#acbf98" ]
]
in
toVegaLite
[ title "Seattle Weather, 2012-2015" []
, des
, dataFromUrl "https://vega.github.io/vega-lite/data/seattle-weather.csv" []
, vConcat [ spec1, spec2 ]
]
multi6 :: VegaLite
multi6 =
let
desc =
description "Drag a rectangular brush to show (first 20) selected points in a table."
dvals =
dataFromUrl "https://vega.github.io/vega-lite/data/cars.json"
trans =
transform
. window [ ( [ WOp RowNumber ], "rowNumber" ) ] []
sel =
selection
. select "brush" Interval []
encPoint =
encoding
. position X [ PName "Horsepower", PmType Quantitative ]
. position Y [ PName "Miles_per_Gallon", PmType Quantitative ]
. color
[ MSelectionCondition (SelectionName "brush")
[ MName "Cylinders", MmType Ordinal ]
[ MString "grey" ]
]
specPoint =
asSpec [ sel [], mark Point [], encPoint [] ]
tableTrans =
transform
. filter (FSelection "brush")
. window [ ( [ WOp Rank ], "rank" ) ] []
. filter (FLessThan "rank" (Number 20))
encHPText =
encoding
. position Y [ PName "rowNumber", PmType Ordinal, PAxis [] ]
. text [ TName "Horsepower", TmType Nominal ]
specHPText =
asSpec [ title "Engine power" [], tableTrans [], mark Text [], encHPText [] ]
encMPGText =
encoding
. position Y [ PName "rowNumber", PmType Ordinal, PAxis [] ]
. text [ TName "Miles_per_Gallon", TmType Nominal ]
specMPGText =
asSpec [ title "Efficiency (mpg)" [], tableTrans [], mark Text [], encMPGText [] ]
encOriginText =
encoding
. position Y [ PName "rowNumber", PmType Ordinal, PAxis [] ]
. text [ TName "Origin", TmType Nominal ]
specOriginText =
asSpec [ title "Country of origin" [], tableTrans [], mark Text [], encOriginText [] ]
res =
resolve
. resolution (RLegend [ ( ChColor, Independent ) ])
cfg =
configure
. configuration (ViewStyle [ ViewNoStroke ])
in
toVegaLite
[ desc, cfg [], dvals [], trans [], res [], hConcat [ specPoint, specHPText, specMPGText, specOriginText ] ]
multi7 :: VegaLite
multi7 =
let des = description "One dot per airport in the US overlayed on geoshape"
cfg = configure
. configuration (ViewStyle [ ViewNoStroke ])
backdropSpec =
asSpec
[ dataFromUrl "https://vega.github.io/vega-lite/data/us-10m.json" [ TopojsonFeature "states" ]
, mark Geoshape [ MFill "#ddd", MStroke "#fff" ]
]
airportData =
dataFromUrl "https://vega.github.io/vega-lite/data/airports.csv" []
flightData =
dataFromUrl "https://vega.github.io/vega-lite/data/flights-airport.csv" []
lineTrans =
transform
. filter (FSelection "mySelection")
. lookup "origin" airportData "iata" (LuAs "o")
. lookup "destination" airportData "iata" (LuAs "d")
lineEnc =
encoding
. position Longitude [ PName "o.longitude", PmType Quantitative ]
. position Latitude [ PName "o.latitude", PmType Quantitative ]
. position Longitude2 [ PName "d.longitude" ]
. position Latitude2 [ PName "d.latitude" ]
lineSpec =
asSpec
[ flightData
, lineTrans []
, lineEnc []
, mark Rule [ MColor "black", MOpacity 0.35 ]
]
airportTrans =
transform
. aggregate [ opAs Count "" "routes" ] [ "origin" ]
. lookup "origin" airportData "iata"
(LuFields [ "name", "state", "latitude", "longitude" ])
. filter (FExpr "datum.state !== 'PR' && datum.state !== 'VI'")
airportEnc =
encoding
. position Longitude [ PName "longitude", PmType Quantitative ]
. position Latitude [ PName "latitude", PmType Quantitative ]
. size [ MName "routes", MmType Quantitative, MScale [ SRange (RNumbers [ 0, 1000 ]) ], MLegend [] ]
. order [ OName "routes", OmType Quantitative, OSort [ Descending ] ]
. tooltip [ TName "name", TmType Nominal ]
sel =
selection
. select "mySelection" Single [ On "mouseover", Nearest True, Empty, Fields [ "origin" ] ]
airportSpec =
asSpec
[ flightData
, airportTrans []
, sel []
, mark Circle []
, airportEnc []
]
in toVegaLite
[ des
, cfg []
, width 900
, height 500
, projection [ PrType AlbersUsa ]
, layer [ backdropSpec, lineSpec, airportSpec ]
]
multi8 :: VegaLite
multi8 =
let dvals = dataFromUrl "https://vega.github.io/vega-lite/data/flights-5k.json"
[ Parse [ ( "date", FoDate "" ) ] ]
trans = transform
. calculateAs "hours(datum.date) + minutes(datum.date) / 60" "time"
sel = selection
. select "brush" Interval [ Encodings [ ChX ]
, SInitInterval
(Just (Number 6, Number 12))
Nothing
]
enc1 = encoding
. position X [ PName "time"
, PBin [ MaxBins 30 ]
, PmType Quantitative ]
. position Y [ PAggregate Count, PmType Quantitative ]
spec1 = asSpec [ width 963, height 100, sel [], enc1 [], mark Bar [] ]
enc2 = encoding
. position X [ PName "time"
, PBin [ MaxBins 30, SelectionExtent "brush" ]
, PmType Quantitative ]
. position Y [ PAggregate Count, PmType Quantitative ]
spec2 = asSpec [ width 963, height 100, enc2 [], mark Bar [] ]
in toVegaLite [ dvals, trans [], vConcat [ spec1, spec2 ] ]
-- interval selection in one plot to zoom in in second plot.
--
selectAndZoom :: VegaLite
selectAndZoom =
let plot1 = asSpec [ encoding
. position X [ PName "theta", PmType Quantitative, PAxis [] ]
. position Y [ PName "y", PmType Quantitative, PAxis [] ]
$ []
, mark Line []
, selection
. select "brush" Interval [ Encodings [ChX, ChY]
, SInitInterval (Just xr) (Just yr)
]
$ []
]
xr = (Number 0.2, Number 6)
yr = (Number (-0.8), Number 0.8)
xscale = [ SDomain (DSelectionField "brush" "theta") ]
yscale = [ SDomain (DSelectionChannel "brush" ChY) ]
plot2 = asSpec [ encoding
. position X [ PName "theta", PmType Quantitative, PScale xscale ]
. position Y [ PName "y", PmType Quantitative, PScale yscale ]
$ []
, mark Circle []
]
in toVegaLite [ dataSequenceAs 0 6.28 0.1 "theta"
, transform
. calculateAs "cos(datum.theta)" "y"
$ []
, vConcat [plot1, plot2]
]