hvega-0.6.0.0: tests/ViewCompositionTests.hs

{-# LANGUAGE OverloadedStrings #-}

--
-- Based on the Elm VegaLite ViewCompositionTests.elm as of version 1.12.0
--
module ViewCompositionTests (testSpecs) where

import qualified Data.Text as T
import qualified Prelude as P

import Graphics.Vega.VegaLite

import Prelude hiding (filter, repeat)


testSpecs :: [(String, VegaLite)]
testSpecs = [ ("columns1", columns1)
            , ("columns2", columns2)
            , ("columns3", columns3)
            , ("columns4", columns4)
            , ("groupyage", groupByAge)
            , ("grid1", grid1)
            , ("grid2", grid2)
            , ("grid3", grid3)
            , ("grid4", grid4)
            , ("grid5", grid5)
            ]


noStroke :: [ConfigureSpec] -> PropertySpec
noStroke = configure
           . configuration (ViewStyle [ ViewNoStroke ])


genderChart :: [HeaderProperty] -> [HeaderProperty] -> VegaLite
genderChart hdProps cProps =
  let conf = configure . configuration (HeaderStyle cProps)

      pop =
          dataFromUrl "https://vega.github.io/vega-lite/data/population.json" []

      trans =
          transform
              . filter (FExpr "datum.year == 2000")
              . calculateAs "datum.sex == 2 ? 'Female' : 'Male'" "gender"

      enc =
          encoding
              . column
                  [ FName "gender"
                  , FmType Nominal
                  , FHeader hdProps
                  , FSpacing 0
                  ]
              . position X
                  [ PName "age"
                  , PmType Ordinal
                  ]
              . position Y
                  [ PName "people"
                  , PmType Quantitative
                  , PAggregate Sum
                  , PAxis [ AxTitle "Population" ]
                  ]
              . color
                  [ MName "gender"
                  , MmType Nominal
                  , MScale [ SRange (RStrings [ "#CC9933", "#3399CC" ]) ]
                  ]

  in toVegaLite [ conf [], pop, trans [], enc [], mark Bar [], widthStep 17 ]


columns1, columns2, columns3, columns4 :: VegaLite
columns1 = genderChart [] []
columns2 = genderChart [ HTitleFontSize 20, HLabelFontSize 15 ] []
columns3 = genderChart [] [ HTitleFontSize 20, HLabelFontSize 15 ]
columns4 =
    genderChart
        [ HTitleFontSize 20
        , HLabelFontSize 15
        , HTitlePadding (-27)
        , HLabelPadding 40
        ]
        []


groupByAge :: VegaLite
groupByAge =
  let conf = noStroke
             . configuration (Axis [ DomainWidth 1 ] )

      pop = dataFromUrl "https://vega.github.io/vega-lite/data/population.json" []

      trans =
          transform
              . filter (FExpr "datum.year == 2000")
              . calculateAs "datum.sex == 2 ? 'Female' : 'Male'" "gender"

      enc =
          encoding
              . column
                  [ FName "age"
                  , FmType Ordinal
                  , FSpacing 10
                  ]
              . position Y
                  [ PName "people"
                  , PmType Quantitative
                  , PAggregate Sum
                  , PAxis [ AxTitle "Population", AxGrid False ]
                  ]
              . position X
                  [ PName "gender"
                  , PmType Nominal
                  , PAxis [ AxNoTitle ]
                  ]
              . color
                  [ MName "gender"
                  , MmType Nominal
                  , MScale [ SRange (RStrings [ "#675193", "#ca8861" ]) ]
                  ]

  in toVegaLite [ conf []
                , pop
                , trans []
                , widthStep 12
                , mark Bar []
                , enc []
                ]


dataVals :: [DataColumn] -> Data
dataVals =
    let
        rows =
            Numbers $ concatMap (P.replicate (3 * 5)) [ 1, 2, 3, 4 ]

        cols =
            Numbers $ concat $ P.replicate 4 $ concatMap (P.replicate 3) [ 1, 2, 3, 4, 5 ]

        cats =
            Numbers $ concat $ P.replicate (4 * 5) [ 1, 2, 3 ]

        vals =
            Numbers $ [ 30, 15, 12, 25, 30, 25, 10, 28, 11, 18, 24, 16, 10, 10, 10 ]
                ++ [ 8, 8, 29, 11, 24, 12, 26, 32, 9, 8, 18, 28, 8, 20, 24 ]
                ++ [ 21, 15, 20, 4, 13, 12, 27, 21, 14, 5, 1, 2, 11, 2, 5 ]
                ++ [ 14, 20, 24, 20, 2, 9, 15, 14, 13, 22, 30, 30, 10, 8, 12 ]

    in
    dataFromColumns []
        . dataColumn "row" rows
        . dataColumn "col" cols
        . dataColumn "cat" cats
        . dataColumn "val" vals


encByCatVal :: [EncodingSpec] -> PropertySpec
encByCatVal = encoding
              . position X [ PName "cat", PmType Ordinal, PAxis [] ]
              . position Y [ PName "val", PmType Quantitative, PAxis [] ]
              . color [ MName "cat", MmType Nominal, MLegend [] ]

specByCatVal :: VLSpec
specByCatVal = asSpec [ width 120, height 120, mark Bar [], encByCatVal [] ]

gridTransform :: PropertySpec
gridTransform = transform
                (calculateAs "datum.row * 1000 + datum.col" "index" [])

gridConfig :: [CompositionConfig] -> [ConfigureSpec] -> PropertySpec
gridConfig fopts =
  configure
  . configuration (HeaderStyle [ HLabelFontSize 0.1 ])
  . configuration (ViewStyle [ ViewStroke "black"
                             , ViewStrokeWidth 2
                             , ViewFill "gray"
                             , ViewFillOpacity 0.2
                             , ViewContinuousHeight 120 ])
  . configuration (FacetStyle fopts)


grid1 :: VegaLite
grid1 =
    let cfg = gridConfig [ CompSpacing 80, CompColumns 5 ]

    in
    toVegaLite
        [ cfg []
        , dataVals []
        , spacingRC 10 30
        , specification specByCatVal
        , facet
            [ RowBy [ FName "row", FmType Ordinal, FNoTitle ]
            , ColumnBy [ FName "col", FmType Ordinal, FHeader [ HNoTitle ] ]
            ]
        ]


grid2 :: VegaLite
grid2 =
    let cfg = gridConfig [ CompSpacing 80, CompColumns 5 ]

    in
    toVegaLite
        [ cfg []
        , dataVals []
        , gridTransform
        , columns 5
        , specification specByCatVal
        , facetFlow [ FName "index", FmType Ordinal, FHeader [ HNoTitle ] ]
        ]


grid3 :: VegaLite
grid3 =
    let cfg = gridConfig [ CompSpacing 80 ]

    in
    toVegaLite
        [ cfg []
        , dataVals []
        , gridTransform
        , columns 0
        , specification specByCatVal
        , facetFlow [ FName "index", FmType Ordinal, FHeader [ HNoTitle ] ]
        ]


carGrid :: Arrangement -> [PropertySpec] -> VegaLite
carGrid rpt opts =
  let carData = dataFromUrl "https://vega.github.io/vega-lite/data/cars.json"

      enc = encoding
            . position X [ PRepeat rpt, PmType Quantitative, PBin [] ]
            . position Y [ PmType Quantitative, PAggregate Count ]
            . color [ MName "Origin", MmType Nominal ]

      spec = asSpec [ carData [], mark Bar [], enc [] ]

  in toVegaLite (specification spec : opts)


carFields :: [T.Text]
carFields = [ "Horsepower", "Miles_per_Gallon", "Acceleration", "Displacement", "Weight_in_lbs" ]


grid4 :: VegaLite
grid4 =
  let opts = [ columns 3
             , repeatFlow carFields
             ]

  in carGrid Flow opts


grid5 :: VegaLite
grid5 =
  let opts = [ repeat
               [ RowFields carFields
               ]
             ]

  in carGrid Row opts