{-# LANGUAGE OverloadedStrings #-}
--
-- Based on the Elm VegaLite AxisTests.elm in the 2.0 development version
--
module AxisTests (testSpecs) where
import qualified Data.Text as T
import Graphics.Vega.VegaLite
import Prelude hiding (filter)
testSpecs :: [(String, VegaLite)]
testSpecs = [ ("axis1", axis1)
, ("axis1c", axis1c)
, ("axis2", axis2)
, ("axis2c", axis2c)
, ("axis3", axis3)
, ("axis3c", axis3c)
, ("axis4", axis4)
, ("axis4c", axis4c)
, ("axis5", axis5)
, ("axis5c", axis5c)
, ("axis6", axis6)
, ("axis6c", axis6c)
, ("axis7", axis7)
, ("axis7c", axis7c)
, ("axis8", axis8)
, ("axis8c", axis8c)
, ("axisOverlapNone", axisOverlapNone)
, ("axisOverlapParity", axisOverlapParity)
, ("axisOverlapGreedy", axisOverlapGreedy)
, ("zorder", zorder)
, ("responsiveWidth", responsiveWidth)
, ("responsiveHeight", responsiveHeight)
, ("axisstyleempty", axisStyleEmpty)
, ("axisstyleemptyx", axisStyleEmptyX)
, ("axisstylex", axisStyleX)
, ("axisstylexastyle", axisStyleXAStyle)
, ("axisstylexy", axisStyleXY)
, ("singleline", singleLine)
, ("multiline", multiLine)
]
-- We do not provide these in hvega, so define them here to make copying
-- the Elm tests over easier.
--
pOrdinal, pQuant, pTemporal :: PositionChannel
pOrdinal = PmType Ordinal
pQuant = PmType Quantitative
pTemporal = PmType Temporal
pName :: T.Text -> PositionChannel
pName = PName
simpleData :: Data
simpleData =
let xvals = map fromIntegral xs
xs = [1::Int .. 100]
in dataFromColumns []
. dataColumn "x" (Numbers xvals)
. dataColumn "catX" (Strings (map (T.pack . show) xs))
. dataColumn "y" (Numbers xvals)
$ []
temporalData :: Data
temporalData =
let dates = [ "2019-01-01 09:00:00"
, "2019-01-02 09:00:00"
, "2019-01-03 09:00:00"
, "2019-01-04 09:00:00"
, "2019-01-05 09:00:00"
, "2019-01-06 09:00:00"
, "2019-01-07 09:00:00"
, "2019-01-08 09:00:00"
, "2019-01-09 09:00:00"
, "2019-01-10 09:00:00"
, "2019-01-11 09:00:00"
, "2019-01-12 09:00:00"
]
xs = map fromIntegral [1::Int .. 12]
in dataFromColumns []
. dataColumn "date" (Strings dates)
. dataColumn "y" (Numbers xs)
$ []
xQuant, yQuant, catX, xDate :: [PositionChannel]
xQuant = [pName "x", pQuant]
yQuant = [pName "y", pQuant]
catX = [pName "catX", pOrdinal]
xDate = [pName "date", pTemporal]
axisBase :: Data -> [ConfigurationProperty] -> [PositionChannel] -> [PositionChannel] -> VegaLite
axisBase plotData confOpts xOpts yOpts =
let enc = encoding . position X xOpts . position Y yOpts
conf = case confOpts of
[] -> []
_ -> [configure (foldr configuration [] confOpts)]
vs = conf ++ [ plotData, enc [], mark Line [ MPoint (PMMarker []) ] ]
in toVegaLite vs
plotCfg :: [ConfigurationProperty]
plotCfg = [ AxisQuantitative AxXY [ DomainColor "orange"
, GridColor "seagreen"
, LabelFont "Comic Sans MS"
, LabelOffset 10
, TickOffset 10
]
, AxisTemporal AxXY [ DomainColor "brown"
, DomainDash [4, 2]
, Grid False
, LabelColor "purple"
]
, PointStyle [ MStroke "black"
, MStrokeOpacity 0.4
, MStrokeWidth 1
, MFill "yellow"
]
, LineStyle [ MStroke "gray"
, MStrokeWidth 2
]
]
axis1, axis1c, axis2, axis2c, axis3, axis3c, axis4, axis4c,
axis5, axis5c, axis6, axis6c, axis7, axis7c, axis8, axis8c :: VegaLite
axis1 = axisBase simpleData [] xQuant yQuant
axis1c = axisBase simpleData plotCfg xQuant yQuant
axis2 = axisBase simpleData [] catX yQuant
axis2c = axisBase simpleData plotCfg catX yQuant
axis3 = axisBase simpleData [] xDate yQuant
axis3c = axisBase simpleData plotCfg xDate yQuant
axis4 =
let x = PAxis [AxValues (Numbers [1, 25, 39, 90])] : xQuant
in axisBase simpleData [] x yQuant
axis4c =
let x = PAxis [AxValues (Numbers [1, 25, 39, 90])] : xQuant
in axisBase simpleData plotCfg x yQuant
axis5 =
let x = PAxis [AxValues (Strings ["1", "25", "39", "dummy", "90"])] : catX
in axisBase simpleData [] x yQuant
axis5c =
let x = PAxis [AxValues (Strings ["1", "25", "39", "dummy", "90"])] : catX
in axisBase simpleData plotCfg x yQuant
axis6 =
let x = PAxis [AxValues (DateTimes axDates)] : xDate
axDates = [ [DTYear 2019, DTMonth Jan, DTDate 4 ]
, [DTYear 2019, DTMonth Jan, DTDate 8 ]
, [DTYear 2019, DTMonth Jan, DTDate 20 ]
]
in axisBase temporalData [] x yQuant
axis6c =
let x = PAxis [AxValues (DateTimes axDates)] : xDate
axDates = [ [DTYear 2019, DTMonth Jan, DTDate 4 ]
, [DTYear 2019, DTMonth Jan, DTDate 8 ]
, [DTYear 2019, DTMonth Jan, DTDate 20 ]
]
in axisBase temporalData plotCfg x yQuant
axis7 =
let x = PAxis [AxLabelExpr "datum.value / 100"] : xQuant
in axisBase simpleData [] x yQuant
axis7c =
let x = PAxis [AxLabelExpr "datum.value / 100"] : xQuant
in axisBase simpleData plotCfg x yQuant
axis8 =
let x = PAxis [AxLabelExpr "'number' + datum.label"] : catX
in axisBase simpleData [] x yQuant
axis8c =
let x = PAxis [AxLabelExpr "'number' + datum.label"] : catX
in axisBase simpleData plotCfg x yQuant
overlap :: OverlapStrategy -> VegaLite
overlap strat =
let dvals = dataFromColumns []
. dataColumn "x" (Numbers [ 0.1, 0.11, 0.2, 0.21, 0.5 ])
. dataColumn "y" (Numbers [ 100, 101, 102, 103, 101 ])
axisOpts = PAxis [ AxLabelOverlap strat
, AxLabelFontSize 20
]
enc = encoding
. position X [ PName "x", PmType Quantitative, axisOpts ]
. position Y [ PName "y", PmType Quantitative, axisOpts ]
in toVegaLite [ dvals [], enc [], mark Circle [] ]
axisOverlapNone :: VegaLite
axisOverlapNone = overlap ONone
axisOverlapParity :: VegaLite
axisOverlapParity = overlap OParity
axisOverlapGreedy :: VegaLite
axisOverlapGreedy = overlap OGreedy
-- From
-- https://github.com/gicentre/elm-vegalite/issues/15#issuecomment-524527125
--
zorder :: VegaLite
zorder =
let dcols = dataFromColumns []
. dataColumn "x" (Numbers [ 20, 10 ])
. dataColumn "y" (Numbers [ 10, 20 ])
. dataColumn "cat" (Strings [ "a", "b" ])
axis lbl z = [ PName lbl, PmType Quantitative, PAxis [ AxZIndex z ] ]
enc = encoding
. position X (axis "x" 2)
. position Y (axis "y" 1)
. color [ MName "cat", MmType Nominal, MLegend [] ]
cfg = configure
. configuration (Axis [ GridWidth 8 ])
. configuration (AxisX [ GridColor "red" ])
. configuration (AxisY [ GridColor "blue" ])
in toVegaLite [ cfg []
, dcols []
, enc []
, mark Circle [ MSize 5000, MOpacity 1 ]
]
responsive :: PropertySpec -> VegaLite
responsive prop =
let enc = encoding
. position X [PName "x", PmType Quantitative]
. position Y [PName "y", PmType Quantitative]
in toVegaLite [ prop, simpleData, enc []
, mark Line [MPoint (PMMarker [])] ]
responsiveWidth, responsiveHeight :: VegaLite
responsiveWidth = responsive widthOfContainer
responsiveHeight = responsive heightOfContainer
carData :: Data
carData = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json" []
carEnc :: [AxisProperty] -> [AxisProperty] -> PropertySpec
carEnc xOpts yOpts =
let toAxis n l o = position n ([ PName l, PmType Quantitative ]
++ if null o
then []
else [PAxis o])
in encoding
. toAxis X "Horsepower" xOpts
. toAxis Y "Miles_per_Gallon" yOpts
. color [ MName "Origin", MmType Nominal, MLegend [] ]
$ []
axisStyleEmpty :: VegaLite
axisStyleEmpty =
let cfg = configure
. configuration (AxisNamedStyles [])
in toVegaLite [ cfg []
, carData
, carEnc [] []
, mark Point []
]
axisStyleEmptyX :: VegaLite
axisStyleEmptyX =
let cfg = configure
. configuration (AxisNamedStyles [("x-style", [])])
in toVegaLite [ cfg []
, carData
, carEnc [AxStyle ["x-style"]] []
, mark Point []
]
axisStyleX :: VegaLite
axisStyleX =
let cfg = configure
. configuration (AxisNamedStyles [("x-style", [ AxDomainColor "orange"
, AxGridColor "lightgreen"
, AxLabelExpr xexpr ])])
xexpr = "if (datum.value <= 100, 'low:' + datum.label, 'high:' + datum.label)"
in toVegaLite [ cfg []
, carData
, carEnc [AxStyle ["x-style"]] []
, mark Point []
]
-- check AStyle; should give same look as axisStyleX
axisStyleXAStyle :: VegaLite
axisStyleXAStyle =
let cfg = configure
. configuration (AxisNamedStyles [("x-style", [ AxDomainColor "orange"
, AxGridColor "lightgreen"
, AxLabelExpr xexpr ])])
. configuration (AxisX [AStyle ["x-style"]])
xexpr = "if (datum.value <= 100, 'low:' + datum.label, 'high:' + datum.label)"
in toVegaLite [ cfg []
, carData
, carEnc [] []
, mark Point []
]
axisStyleXY :: VegaLite
axisStyleXY =
let cfg = configure
. configuration (AxisNamedStyles [ ("x-style", [ AxDomainColor "orange"
, AxGridColor "lightgreen"
, AxLabelExpr xexpr ])
, ("y-style", [ AxDomain False
, AxGrid False
, AxLabels False
, AxTicks False
, AxNoTitle ])
])
xexpr = "if (datum.value <= 100, 'low:' + datum.label, 'high:' + datum.label)"
in toVegaLite [ cfg []
, carData
, carEnc [AxStyle ["x-style"]] [AxStyle ["y-style"]]
, mark Point []
]
singleLine :: VegaLite
singleLine =
let xOpts = [ AxLabelExpr "datum.label + ' horses'" ]
yOpts = [ AxLabelExpr "datum.label+' mpg'" ]
in toVegaLite [ carData
, carEnc xOpts yOpts
, mark Point []
]
multiLine :: VegaLite
multiLine =
let xOpts = [ AxLabelExpr "datum.label + ' horses'"
, AxLabelLineHeight 22
, AxLabelFontSize 11
]
yOpts = [ AxLabelExpr "datum.label+' mpg'"
, AxLabelFontSize 22 ]
in toVegaLite [ carData
, carEnc xOpts yOpts
, mark Point []
, configure
. configuration (LineBreakStyle " ")
. configuration (Axis [LabelLineHeight 20])
$ []
]