Nothing
context("test bi_legend function")
# test errors ------------------------------------------------
test_that("missing parameters trigger appropriate errors", {
expect_error(bi_legend(dim = 3),
"A palette name or a custom palette vector must be specified for the 'pal' argument. Please see bi_pal's help file for a list of included palettes.")
})
test_that("incorrectly specified parameters trigger appropriate errors", {
expect_error(bi_legend(pal = "ham", dim = 3),
"The given palette is not one of the allowed options for bivariate mapping. Please see bi_pal's help file for a list of included palettes.")
expect_error(bi_legend(pal = "DkViolet", dim = 4),
"The legacy 'DkViolet' palette does not support 4x4 bivarite mapping. Please use 'DkViolet2' instead.")
expect_error(bi_legend(pal = "DkBlue", dim = 2, xlab = 24),
"The 'xlab' argument must be a character string.")
expect_error(bi_legend(pal = "DkBlue", dim = 2, ylab = 24),
"The 'ylab' argument must be a character string.")
expect_error(bi_legend(pal = "DkBlue", dim = 2, size = "ham"),
"The 'size' argument must be a numeric value.")
})
# test inputs ------------------------------------------------
test_that("correctly specified functions execute without error", {
expect_error(bi_legend(pal = "GrPink", dim = 2, xlab = "ham", ylab = "bacon"), NA)
expect_error(bi_legend(pal = "GrPink", dim = 3, xlab = "ham", ylab = "bacon"), NA)
})
a <- "ham"
b <- "bacon"
test_that("correctly specified functions execute without error", {
expect_error(bi_legend(pal = "Brown", dim = 2, xlab = a, ylab = b), NA)
})
custom_pal_valid1 <- c(
"1-1" = "#cabed0", # low x, low y
"2-1" = "#ae3a4e", # high x, low y
"1-2" = "#4885c1", # low x, high y
"2-2" = "#3f2949" # high x, high y
)
custom_pal_valid2 <- c(
"1-1" = "#d3d3d3", # low x, low y
"2-1" = "#b6cdcd",
"3-1" = "#97c5c5",
"4-1" = "#75bebe",
"5-1" = "#52b6b6", # high x, low y
"1-2" = "#cab6c5",
"2-2" = "#aeb0bf",
"3-2" = "#91aab9",
"4-2" = "#70a4b2",
"5-2" = "#4e9daa",
"1-3" = "#c098b9",
"2-3" = "#a593b3",
"3-3" = "#898ead",
"4-3" = "#6b89a6",
"5-3" = "#4a839f",
"1-4" = "#b77aab",
"2-4" = "#9e76a6",
"3-4" = "#8372a0",
"4-4" = "#666e9a",
"5-4" = "#476993",
"1-5" = "#ad5b9c", # low x, high y
"2-5" = "#955898",
"3-5" = "#7c5592",
"4-5" = "#60528d",
"5-5" = "#434e87" # high x, high y
)
test_that("custom palettes are accepted without error", {
expect_error(bi_legend(pal = custom_pal_valid1, dim = 2, xlab = a, ylab = b), NA)
expect_error(bi_legend(pal = custom_pal_valid2, dim = 5, xlab = a, ylab = b), NA)
})
break_vals <- bi_class_breaks(stl_race_income, style = "quantile",
x = pctWhite, y = medInc, dim = 3,
dig_lab = c(x = 4, y = 5), split = TRUE)
test_that("accepts split breaks without error", {
expect_error(bi_legend(pal = "GrPink", dim = 3, xlab = "ham", ylab = "bacon",
breaks = break_vals), NA)
})
break_vals <- bi_class_breaks(stl_race_income, style = "quantile",
x = pctWhite, y = medInc, dim = 3,
dig_lab = c(x = 4, y = 5), split = FALSE)
test_that("accepts break ranges without error", {
expect_error(bi_legend(pal = "GrPink", dim = 3, xlab = "ham", ylab = "bacon",
breaks = break_vals), NA)
})
# test results ------------------------------------------------
result1 <- bi_legend(pal = "GrPink", dim = 2)
result2 <- bi_legend(pal = "GrPink", dim = 3)
result3 <- bi_legend(pal = custom_pal_valid2, dim = 5)
test_that("correct classes of output are returned", {
expect_equal("ggplot" %in% class(result1), TRUE)
expect_equal("ggplot" %in% class(result2), TRUE)
expect_equal("ggplot" %in% class(result3), TRUE)
})
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.