# Create an input data frame four columns: two
# character-based and two that are numeric
data_tbl <-
data.frame(
char_1 = c("saturday", "sunday", "monday", "tuesday",
"wednesday", "thursday", "friday"),
char_2 = c("june", "july", "august", "september",
"october", "november", "december"),
num_1 = c(1836.23, 2763.39, 937.29, 643.00, 212.232, 0, -23.24),
num_2 = c(34, 74, 23, NA, 35, NA, NA),
stringsAsFactors = FALSE)
# Create a `gt_tbl` object with `gt()` and the
# `data_tbl` dataset
tab <- gt(data_tbl)
# Create an input data frame with dates, times, and date-times (all
# as character)
time_tbl <-
data.frame(
date = c("2017-10-15", "2013-02-22", "2014-09-22", "2018-01-10"),
time = c("16:45", "19:23", "01:30", "08:00"),
datetime = c("2010-03-25 19:45", "2015-06-12 09:25",
"2016-01-15 14:38", "2012-08-07 12:31"),
stringsAsFactors = FALSE)
# Create a `gt_tbl` object with `gt()` and the
# `data_tbl` dataset
tab_time <- gt(time_tbl)
test_that("fmt_number() works with conditional `rows`", {
expect_equal(
(tab %>%
fmt_number(
columns = num_1,
decimals = 4,
rows = num_1 < 1000) %>%
render_formats_test(context = "html"))[["num_1"]],
c("1836.23", "2763.39", "937.2900", "643.0000",
"212.2320", "0.0000", paste0("\U02212", "23.2400")))
expect_equal(
(tab %>%
fmt_number(
columns = c(num_1, num_2),
decimals = 4,
rows = char_2 %in% c("june", "july") & grepl("sa.*", char_1)) %>%
render_formats_test(context = "html"))[["num_2"]],
c("34.0000", "74", "23", "NA", "35", "NA", "NA"))
})
test_that("fmt_scientific() works with conditional `rows`", {
expect_equal(
(tab %>%
fmt_scientific(
columns = num_1,
decimals = 4,
rows = num_1 < 1000) %>%
render_formats_test(context = "html"))[["num_1"]],
c(
"1836.23", "2763.39",
paste0("9.3729 ", "\U000D7", " 102"),
paste0("6.4300 ", "\U000D7", " 102"),
paste0("2.1223 ", "\U000D7", " 102"),
"0.0000",
paste0("\U02212", "2.3240 ", "\U000D7", " 101")
)
)
expect_equal(
(tab %>%
fmt_scientific(
columns = c(num_1, num_2),
decimals = 4,
rows = char_2 %in% c("june", "july") & grepl("sa.*", char_1)) %>%
render_formats_test(context = "html"))[["num_2"]],
c(
paste0("3.4000 ", "\U000D7", " 101"),
"74", "23", "NA", "35", "NA", "NA"
)
)
})
test_that("fmt_percent() works with conditional `rows`", {
expect_equal(
(tab %>%
fmt_percent(
columns = num_1,
decimals = 2,
rows = num_1 < 1000
) %>%
render_formats_test(context = "html"))[["num_1"]],
c(
"1836.23", "2763.39", "93,729.00%", "64,300.00%",
"21,223.20%", "0.00%", paste0("\U02212", "2,324.00%")
)
)
expect_equal(
(tab %>%
fmt_percent(
columns = c(num_1, num_2),
decimals = 2,
rows = char_2 %in% c("june", "july") & grepl("sa.*", char_1)) %>%
render_formats_test(context = "html"))[["num_2"]],
c("3,400.00%", "74", "23", "NA", "35", "NA", "NA")
)
})
test_that("fmt_currency() works with conditional `rows`", {
expect_equal(
(tab %>%
fmt_currency(
columns = num_1,
currency = "USD",
rows = num_1 < 1000) %>%
render_formats_test(context = "html"))[["num_1"]],
c(
"1836.23", "2763.39", "$937.29", "$643.00", "$212.23",
"$0.00", paste0("\U02212", "$23.24")
)
)
expect_equal(
(tab %>%
fmt_currency(
columns = c(num_1, num_2),
currency = "USD",
rows = char_2 %in% c("june", "july") & grepl("sa.*", char_1)) %>%
render_formats_test(context = "html"))[["num_2"]],
c("$34.00", "74", "23", "NA", "35", "NA", "NA")
)
})
test_that("fmt_date() works with conditional `rows`", {
expect_equal(
(tab_time %>%
fmt_date(
columns = date,
date_style = 2,
rows = time == "16:45") %>%
render_formats_test(context = "html"))[["date"]],
c("Sunday, October 15, 2017", "2013-02-22", "2014-09-22", "2018-01-10")
)
expect_equal(
(tab_time %>%
fmt_date(
columns = date,
date_style = 2,
rows = date %in% c("2017-10-15", "2014-09-22") & grepl("^1", time)) %>%
render_formats_test(context = "html"))[["date"]],
c("Sunday, October 15, 2017", "2013-02-22", "2014-09-22", "2018-01-10")
)
})
test_that("fmt_time() works with conditional `rows`", {
expect_equal(
(tab_time %>%
fmt_time(
columns = time,
time_style = 2,
rows = time == "16:45") %>%
render_formats_test(context = "html"))[["time"]],
c("16:45", "19:23", "01:30", "08:00")
)
expect_equal(
(tab_time %>%
fmt_time(
columns = time,
time_style = 2,
rows = date %in% c("2017-10-15", "2014-09-22") & grepl("^1", time)) %>%
render_formats_test(context = "html"))[["time"]],
c("16:45", "19:23", "01:30", "08:00")
)
})
test_that("fmt_datetime() works with conditional `rows`", {
expect_equal(
(tab_time %>%
fmt_datetime(
columns = datetime,
date_style = 2,
time_style = 2,
rows = time == "16:45") %>%
render_formats_test(context = "html"))[["datetime"]],
c("Thursday, March 25, 2010 19:45", "2015-06-12 09:25",
"2016-01-15 14:38", "2012-08-07 12:31")
)
expect_equal(
(tab_time %>%
fmt_datetime(
columns = datetime,
date_style = 2,
time_style = 2,
rows = date %in% c("2017-10-15", "2014-09-22") & grepl("^1", time)) %>%
render_formats_test(context = "html"))[["datetime"]],
c("Thursday, March 25, 2010 19:45", "2015-06-12 09:25",
"2016-01-15 14:38", "2012-08-07 12:31")
)
})
test_that("fmt_passthrough() works with conditional `rows`", {
expect_equal(
(tab_time %>%
fmt_passthrough(
columns = datetime,
rows = time == "16:45") %>%
render_formats_test(context = "html"))[["datetime"]],
c("2010-03-25 19:45", "2015-06-12 09:25",
"2016-01-15 14:38", "2012-08-07 12:31")
)
expect_equal(
(tab_time %>%
fmt_passthrough(
columns = datetime,
rows = date %in% c("2017-10-15", "2014-09-22") & grepl("^1", time)) %>%
render_formats_test(context = "html"))[["datetime"]],
c("2010-03-25 19:45", "2015-06-12 09:25",
"2016-01-15 14:38", "2012-08-07 12:31")
)
})
test_that("sub_missing() works with conditional `rows`", {
expect_equal(
(tab %>%
sub_missing(
columns = num_2,
rows = num_1 <= 0
) %>%
render_formats_test(context = "html"))[["num_2"]],
c("34", "74", "23", "NA", "35", rep("\U02014", 2))
)
})
test_that("fmt() works with conditional `rows`", {
expect_equal(
(tab %>%
fmt(
columns = num_1,
rows = num_1 > 1000,
fns = function(x) {
x * 1000
}) %>%
render_formats_test(context = "html"))[["num_1"]],
c("1836230", "2763390", "937.290", "643.000",
"212.232", "0.000", "-23.240")
)
})
test_that("fmt() works when providing a purrr formula (#1762)", {
# Function has a different class, so that will differ
# - but makes sense since the passed function is actually different
expect_equal(
{v1 <- mtcars %>% gt() %>% fmt(mpg, fns = ~.x+1); v1$`_formats`[[1]]$func$default <- NULL; v1},
{v2 <- mtcars %>% gt() %>% fmt(mpg, fns = function(x) x+1); v2$`_formats`[[1]]$func$default <- NULL; v2}
)
})
test_that("get_locale_sep_mark() works correctly", {
# Expect that a `locale` which is `NULL` will return the
# default value
expect_equal(
c(
get_locale_sep_mark(locale = NULL, default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = NULL, default = ".", use_seps = TRUE),
get_locale_sep_mark(locale = NULL, default = " ", use_seps = TRUE)
),
c(",", ".", " ")
)
# Expect that an invalid `locale` will result in
# an error
expect_error(
get_locale_sep_mark(locale = "do_IT", default = ",", use_seps = TRUE)
)
# Expect that when `use_seps` is `FALSE`, we always
# get an empty string `""` returned
expect_equal("", get_locale_sep_mark(locale = "en_US", default = ",", use_seps = FALSE))
expect_equal("", get_locale_sep_mark(locale = "do_IT", default = ",", use_seps = FALSE))
expect_equal("", get_locale_sep_mark(locale = NULL, default = ",", use_seps = FALSE))
expect_equal("", get_locale_sep_mark(locale = NULL, default = ",", use_seps = FALSE))
expect_equal("", get_locale_sep_mark(locale = NULL, use_seps = FALSE))
expect_equal("", get_locale_sep_mark(use_seps = FALSE))
# Expect the correct `sep_mark` values for a range of locales
expect_equal(
c(
get_locale_sep_mark(locale = "fr-CF", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "en-JE", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "en-KY", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "ln-CF", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "en-MO", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "teo-KE", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "en-IL", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "pt", default = ",", use_seps = TRUE),
get_locale_sep_mark(locale = "en-DE", default = ",", use_seps = TRUE)
),
c(" ", ",", ",", ".", ",", ",", ",", ".", ".")
)
})
test_that("get_locale_dec_mark() works correctly", {
# Expect that a `locale` which is `NULL` will return the
# default value
expect_equal(
c(
get_locale_dec_mark(locale = NULL, default = "."),
get_locale_dec_mark(locale = NULL, default = ","),
get_locale_dec_mark(locale = NULL, default = " ")
),
c(".", ",", " ")
)
# Expect that an invalid `locale` will result in
# an error
expect_error(
get_locale_dec_mark(locale = "do_IT", default = ".")
)
# Expect the correct `dec_mark` values for a range of locales
expect_equal(
c(
get_locale_dec_mark(locale = "fr-CF", default = "."),
get_locale_dec_mark(locale = "en-JE", default = "."),
get_locale_dec_mark(locale = "en-KY", default = "."),
get_locale_dec_mark(locale = "ln-CF", default = "."),
get_locale_dec_mark(locale = "en-MO", default = "."),
get_locale_dec_mark(locale = "teo-KE", default = "."),
get_locale_dec_mark(locale = "en-IL", default = "."),
get_locale_dec_mark(locale = "pt", default = "."),
get_locale_dec_mark(locale = "en-DE", default = ".")
),
c(",", ".", ".", ",", ".", ".", ".", ",", ",")
)
})
test_that("has_order_zero() works correctly", {
# Create numeric vectors, with and without
# NA values
x <- c(-500, -50, -5, -0.5, -0.05, 0, 0.05, 0.5, 5, 50, 500)
x_has_NA <- c(NA_real_, -50, -5, -0.5, -0.05, 0, 0.05, 0.5, 5, 50, NA_real_)
# Expect that a vector of numbers introduced
# to `has_order_zero()` will result in a equal-
# length logical vector (for vectors that have
# and don't have NA values)
expect_length(has_order_zero(x), length(x))
expect_type(has_order_zero(x), "logical")
expect_length(has_order_zero(x_has_NA), length(x_has_NA))
expect_type(has_order_zero(x_has_NA), "logical")
# Expect the correct logical values for
# vectors that have and don't have NA values
expect_equal(
has_order_zero(x),
c(FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE)
)
expect_equal(
has_order_zero(x_has_NA),
c(FALSE, FALSE, TRUE, FALSE, FALSE, TRUE,FALSE, FALSE, TRUE, FALSE, FALSE)
)
})
test_that("split_string_2() works correctly", {
test_str <- "-HK$4,299"
# Expect certain length 2 character vectors from a series
# of `split_string_2()` operations with regex matching
expect_equal(split_string_2(x = test_str, before = "HK"), c("-", "HK$4,299"))
expect_equal(split_string_2(x = test_str, after = "HK"), c("-HK", "$4,299"))
expect_equal(split_string_2(x = test_str, before = "\\$"), c("-HK", "$4,299"))
expect_equal(split_string_2(x = test_str, after = "\\$"), c("-HK$", "4,299"))
expect_equal(split_string_2(x = test_str, before = "9"), c("-HK$4,2", "99"))
expect_equal(split_string_2(x = test_str, after = "9"), c("-HK$4,29", "9"))
expect_equal(split_string_2(x = test_str, before = "99"), c("-HK$4,2", "99"))
expect_equal(split_string_2(x = test_str, after = "99"), c("-HK$4,299", ""))
expect_equal(split_string_2(x = test_str, before = "9"), c("-HK$4,2", "99"))
expect_equal(split_string_2(x = test_str, before = "$"), c("-HK$4,299", ""))
expect_equal(split_string_2(x = test_str, after = "$"), c("-HK$4,299", ""))
expect_equal(split_string_2(x = test_str, before = ".$"), c("-HK$4,29", "9"))
expect_equal(split_string_2(x = test_str, after = ".$"), c("-HK$4,299", ""))
expect_equal(split_string_2(x = test_str, before = "^."), c("", "-HK$4,299"))
expect_equal(split_string_2(x = test_str, after = "^."), c("-", "HK$4,299"))
expect_equal(split_string_2(x = test_str, before = "x"), c("-HK$4,299", ""))
expect_equal(split_string_2(x = test_str, after = "x"), c("-HK$4,299", ""))
# Expect certain length 2 character vectors from a series
# of `split_string_2()` operations with numeric positions
expect_equal(split_string_2(x = test_str, before = 0), c("", "-HK$4,299"))
expect_equal(split_string_2(x = test_str, before = 1), c("", "-HK$4,299"))
expect_equal(split_string_2(x = test_str, before = 2), c("-", "HK$4,299"))
expect_equal(split_string_2(x = test_str, before = 3), c("-H", "K$4,299"))
expect_equal(split_string_2(x = test_str, before = 4), c("-HK", "$4,299"))
expect_equal(split_string_2(x = test_str, before = 5), c("-HK$", "4,299"))
expect_equal(split_string_2(x = test_str, before = 6), c("-HK$4", ",299"))
expect_equal(split_string_2(x = test_str, before = 7), c("-HK$4,", "299"))
expect_equal(split_string_2(x = test_str, before = 8), c("-HK$4,2", "99"))
expect_equal(split_string_2(x = test_str, before = 9), c("-HK$4,29", "9"))
expect_equal(split_string_2(x = test_str, after = 0), c("", "-HK$4,299"))
expect_equal(split_string_2(x = test_str, after = 1), c("-", "HK$4,299"))
expect_equal(split_string_2(x = test_str, after = 2), c("-H", "K$4,299"))
expect_equal(split_string_2(x = test_str, after = 3), c("-HK", "$4,299"))
expect_equal(split_string_2(x = test_str, after = 4), c("-HK$", "4,299"))
expect_equal(split_string_2(x = test_str, after = 5), c("-HK$4", ",299"))
expect_equal(split_string_2(x = test_str, after = 6), c("-HK$4,", "299"))
expect_equal(split_string_2(x = test_str, after = 7), c("-HK$4,2", "99"))
expect_equal(split_string_2(x = test_str, after = 8), c("-HK$4,29", "9"))
expect_equal(split_string_2(x = test_str, after = 9), c("-HK$4,299", ""))
# Expect an error if `x` is not of class character
expect_error(split_string_2(x = 23432, before = "34"))
# Expect an error if the length of `x` is not 1
expect_error(split_string_2(x = c("345", "234"), before = "34"))
# Expect an error if neither of `before` or `after` has a value
expect_error(split_string_2(x = "23432"))
# Expect an error if both `before` and `after` have values
expect_error(split_string_2(x = "23432", before = "3", after = "2"))
# Expect an error if the index position is not valid
expect_error(split_string_2(x = "23432", before = 10))
})
test_that("paste_between() works correctly", {
# Expect a correctly formed string with `paste_between()`
expect_equal(
paste_between(x_2 = c("left", "right"), "-between-"),
"left-between-right"
)
# Expect multiple correctly formed strings with `paste_between()`
expect_equal(
paste_between(x_2 = c("left", "right"), c("-a-", "-b-", "-c-")),
c("left-a-right", "left-b-right", "left-c-right")
)
# Expect an error if the class of `x_2` is not `character`
expect_error(paste_between(x_2 = 1:2, "-between-"))
# Expect an error if the class of `x_between` is not `character`
expect_error(paste_between(x_2 = c("left", "right"), 1))
# Expect an error if the length of `x_2` is not 2
expect_error(paste_between(x_2 = "left", "between"))
})
test_that("paste_on_side() works correctly", {
# Expect a correctly formed string with `paste_on_side()`,
# pasting to the left
expect_equal(
paste_on_side(x = "center", x_side = "left-", direction = "left"),
"left-center"
)
# Expect a correctly formed string with `paste_on_side()`,
# pasting to the right
expect_equal(
paste_on_side(x = "center", x_side = "-right", direction = "right"),
"center-right"
)
# Expect an error if `direction` is not valid
expect_error(paste_on_side(x = "center", x_side = "c", direction = "center"))
})
test_that("paste_left() works correctly", {
# Expect correctly formed strings with `paste_left()`
expect_equal(
paste_left(x = "center", "left-"),
"left-center"
)
expect_equal(
paste_left(x = c("a", "b", "c"), "left-"),
c("left-a", "left-b", "left-c")
)
expect_equal(
paste_left(x = c("c1", "c2", "c3"), c("l1-", "l2-", "l3-")),
c("l1-c1", "l2-c2", "l3-c3")
)
# Expect an error if the class of `x` is not `character`
expect_error(paste_left(x = 1, x_left = "left"))
# Expect an error if the class of `x_left` is not `character`
expect_error(paste_left(x = "center", x_left = 1))
# Expect an error if the length of `x_left` is not 1 of the length of `x`
expect_error(paste_left(x = "center", x_left = c("l1", "l2", "l3")))
expect_error(paste_left(x = c("c1", "c2", "c3"), x_left = c("l1", "l2")))
})
test_that("paste_right() works correctly", {
# Expect correctly formed strings with `paste_right()`
expect_equal(
paste_right(x = "center", "-right"),
"center-right"
)
expect_equal(
paste_right(x = c("a", "b", "c"), "-right"),
c("a-right", "b-right", "c-right")
)
expect_equal(
paste_right(x = c("c1", "c2", "c3"), c("-r1", "-r2", "-r3")),
c("c1-r1", "c2-r2", "c3-r3")
)
# Expect an error if the class of `x` is not `character`
expect_error(paste_right(x = 1, x_right = "right"))
# Expect an error if the class of `x_right` is not `character`
expect_error(paste_right(x = "center", x_right = 1))
# Expect an error if the length of `x_right` is not 1 of the length of `x`
expect_error(paste_left(x = "center", x_right = c("r1", "r2", "r3")))
expect_error(paste_left(x = c("c1", "c2", "c3"), x_right = c("r1", "r2")))
})