Nothing
context("legend")
test_that("gradient legends return correct rows",{
## A gradient legend should have an even number of bins and spacing between numbers
##
## we want to keep the min & max colours
## but we may not want to use the values associated wtih those colours because the
## numbers may not space nicely
n <- 234
palette <- data.frame(variable = 1:n, colour = viridisLite::inferno(n) )
})
test_that("legend resolves", {
dat <- data.frame(id = c(rep(1,3), rep(2, 2)),
val = letters[1:5],
val2 = letters[11:15],
stringsAsFactors = F)
lstPalette <- list(stroke_colour = viridisLite::viridis,
fill_colour = viridisLite::inferno)
allCols <- c("id", "val", "val2")
objArgs <- quote(add_polygons(id = "id", stroke_colour = "id", fill_colour = "val"))
shape <- googleway:::createMapObject(dat, allCols, objArgs)
colourColumns <- c("stroke_colour" = 'id', "fill_colour" = "val")
pal <- googleway:::createPalettes(shape, colourColumns)
colour_palettes <- googleway:::createColourPalettes(dat, pal, colourColumns, lstPalette)
legend <- googleway:::resolveLegend(T, NULL, colour_palettes)
expect_true(
legend[[1]]$colourType == "stroke_colour"
)
expect_true(
legend[[2]]$title == "val"
)
})
test_that("legend values are prefixed & suffixed", {
dat <- data.frame(id = c(rep(1,3), rep(2, 2)),
val = letters[1:5],
val2 = letters[11:15],
stringsAsFactors = F)
lstPalette <- list(stroke_colour = viridisLite::viridis,
fill_colour = viridisLite::inferno)
allCols <- c("id", "val", "val2")
objArgs <- quote(add_polygons(id = "id", stroke_colour = "id", fill_colour = "val"))
shape <- googleway:::createMapObject(dat, allCols, objArgs)
colourColumns <- c("stroke_colour" = 'id', "fill_colour" = "val")
pal <- googleway:::createPalettes(shape, colourColumns)
colour_palettes <- googleway:::createColourPalettes(dat, pal, colourColumns, lstPalette)
legend <- googleway:::constructLegend(colour_palettes, legend = T)
legend_options <- list(
fill_colour = list(
title = "new legend title",
css = 'max-width : 120px; max-height : 160px; overflow : auto;',
position = "BOTTOM_LEFT",
prefix = "MyVal",
suffix = NULL
),
stroke_colour = list(
suffix = "%%%%"
)
)
legend <- googleway:::addLegendOptions(legend, legend_options)
expect_true(
legend[[1]]$legend[1, 'variable'] == "MyVala"
)
expect_true(
legend[[2]]$legend[2, 'variable'] == "2%%%%"
)
})
test_that("legends are formatted", {
dat <- data.frame(id = c(rep(1,3), rep(2, 2)),
val = 10000000:10000004,
val2 = seq.POSIXt(from = as.POSIXct("2017-10-01 00:00:00", tz = "Australia/Melbourne"), by = "1 day", length.out = 5),
stringsAsFactors = F)
lstPalette <- list(stroke_colour = viridisLite::viridis,
fill_colour = viridisLite::inferno)
allCols <- c("id", "val", "val2")
objArgs <- quote(add_polygons(id = "id", stroke_colour = "val2", fill_colour = "val"))
shape <- googleway:::createMapObject(dat, allCols, objArgs)
colourColumns <- c("stroke_colour" = 'val2', "fill_colour" = "val")
pal <- googleway:::createPalettes(shape, colourColumns)
colour_palettes <- googleway:::createColourPalettes(dat, pal, colourColumns, lstPalette)
legend <- googleway:::constructLegend(colour_palettes, legend = T)
legend <- googleway:::addLegendOptions(legend, NULL)
expect_true(
legend[[1]]$legend[1, 'variable'] == "10,000,000"
)
expect_true(
legend[[2]]$legend[1, 'variable'] == "2017-10-01"
)
})
test_that("legend is reveresed", {
dat <- data.frame(id = c(rep(1,3), rep(2, 2)),
val = 10000000:10000004,
val2 = seq.POSIXt(from = as.POSIXct("2017-10-01 00:00:00", tz = "Australia/Melbourne"), by = "1 day", length.out = 5),
stringsAsFactors = F)
lstPalette <- list(stroke_colour = viridisLite::viridis,
fill_colour = viridisLite::inferno)
allCols <- c("id", "val", "val2")
objArgs <- quote(add_polygons(id = "id", stroke_colour = "val2", fill_colour = "val"))
shape <- googleway:::createMapObject(dat, allCols, objArgs)
colourColumns <- c("stroke_colour" = 'val2', "fill_colour" = "val")
pal <- googleway:::createPalettes(shape, colourColumns)
colour_palettes <- googleway:::createColourPalettes(dat, pal, colourColumns, lstPalette)
legendOptions <- list(
reverse = T
)
legend <- googleway:::constructLegend(colour_palettes, legend = T)
legend <- googleway:::addLegendOptions(legend, legendOptions)
expect_true(
legend[[1]]$legend[1, 'variable'] == as.Date("2017-10-05")
)
expect_true(
legend[[2]]$legend[1, 'variable'] == "10,000,004"
)
legendOptions <- list(
fill_colour = list(
reverse = T
)
)
legend <- googleway:::constructLegend(colour_palettes, legend = T)
legend <- googleway:::addLegendOptions(legend, legendOptions)
expect_true(
legend[[2]]$legend[1, 'variable'] == as.Date("2017-10-01")
)
expect_true(
legend[[1]]$legend[1, 'variable'] == "10,000,004"
)
})
## issue 184
test_that("error handled when asking for legend while using hex colours",{
legend <- TRUE
expect_warning(
googleway:::resolveLegend(legend, NULL, list())
, "nothing to include in the legend"
)
legend <- list( fill_colour = TRUE, stroke_colour = TRUE )
expect_warning(
googleway:::resolveLegend(legend, NULL, list())
, "nothing to include in the legend"
)
## IF stroke is a column, it should work
legend <- list( fill_colour = TRUE, stroke_colour = TRUE )
pal <- list(list(variables = c(stroke_colour = "id"), palette = structure(list(
variable = c(1, 2), colour = c("#440154", "#FDE725")), class = "data.frame", row.names = c(NA,
-2L))))
expect_equal(
googleway:::resolveLegend(legend, NULL, list( stroke_colour = pal ) )
, list(
stroke_colour = list(
colourType = "stroke_colour"
, type = "category"
, title = NULL
, legend = NULL
, css = NULL
, position = NULL
)
)
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.