tests/testthat/test-l_conditional_fmt.R

In gt: Easily Create Presentation-Ready Display Tables

# 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 `tbl_latex` object with `gt()` and the `data_tbl` dataset
tbl_latex <- 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 `tbl_latex_time` object with `gt()` and the `data_tbl` dataset
tbl_latex_time <- gt(time_tbl)

test_that("The `fmt_number()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       fmt_number(
         columns = num_1,
         decimals = 4,
         rows = num_1 < 1000) %>%
       render_formats_test(context = "latex"))[["num_1"]],
    c(
      "1836.23", "2763.39", "$937.2900$", "$643.0000$",
      "$212.2320$", "$0.0000$", "$-23.2400$"
    )
  )

  expect_equal(
    (tbl_latex %>%
       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 = "latex"))[["num_2"]],
    c("$34.0000$", "74", "23", "NA", "35", "NA", "NA")
  )
})

test_that("The `fmt_scientific()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       fmt_scientific(
         columns = num_1,
         decimals = 4,
         rows = num_1 < 1000) %>%
       render_formats_test(context = "latex"))[["num_1"]],
    c(
      "1836.23", "2763.39", "$9.3729 \\times 10^{2}$",
      "$6.4300 \\times 10^{2}$", "$2.1223 \\times 10^{2}$", "$0.0000$",
      "$-2.3240 \\times 10^{1}$"
    )
  )

  expect_equal(
    (tbl_latex %>%
       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 = "latex"))[["num_2"]],
    c("$3.4000 \\times 10^{1}$", "74", "23", "NA", "35", "NA", "NA")
  )
})

test_that("The `fmt_percent()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       fmt_percent(
         columns = num_1,
         decimals = 2,
         rows = num_1 < 1000) %>%
       render_formats_test(context = "latex"))[["num_1"]],
    c(
      "1836.23", "2763.39", "$93,729.00\\%$", "$64,300.00\\%$",
      "$21,223.20\\%$", "$0.00\\%$", "$-2,324.00\\%$"
    )
  )

  expect_equal(
    (tbl_latex %>%
       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 = "latex"))[["num_2"]],
    c("$3,400.00\\%$", "74", "23", "NA", "35", "NA", "NA")
  )
})

test_that("The `fmt_currency()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       fmt_currency(
         columns = num_1,
         currency = "USD",
         rows = num_1 < 1000) %>%
       render_formats_test(context = "latex"))[["num_1"]],
    c(
      "1836.23", "2763.39", "$\\text{\\$}937.29$", "$\\text{\\$}643.00$",
      "$\\text{\\$}212.23$", "$\\text{\\$}0.00$", "$-\\text{\\$}23.24$"
    )
  )

  expect_equal(
    (tbl_latex %>%
       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 = "latex"))[["num_2"]],
    c("$\\text{\\$}34.00$", "74", "23", "NA", "35", "NA", "NA")
  )
})

test_that("The `fmt_date()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex_time %>%
       fmt_date(
         columns = date,
         date_style = 2,
         rows = time == "16:45") %>%
       render_formats_test(context = "latex"))[["date"]],
    c("Sunday, October 15, 2017", "2013-02-22", "2014-09-22", "2018-01-10")
  )

  expect_equal(
    (tbl_latex_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 = "latex"))[["date"]],
    c("Sunday, October 15, 2017", "2013-02-22", "2014-09-22", "2018-01-10")
  )
})

test_that("The `fmt_time()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex_time %>%
       fmt_time(
         columns = time,
         time_style = 2,
         rows = time == "16:45") %>%
       render_formats_test(context = "latex"))[["time"]],
    c("16:45", "19:23", "01:30", "08:00")
  )

  expect_equal(
    (tbl_latex_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 = "latex"))[["time"]],
    c("16:45", "19:23", "01:30", "08:00")
  )
})

test_that("The `fmt_datetime()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex_time %>%
       fmt_datetime(
         columns = datetime,
         date_style = 2,
         time_style = 2,
         rows = time == "16:45") %>%
       render_formats_test(context = "latex"))[["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(
    (tbl_latex_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 = "latex"))[["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("The `fmt_passthrough()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex_time %>%
       fmt_passthrough(
         columns = datetime,
         rows = time == "16:45") %>%
       render_formats_test(context = "latex"))[["datetime"]],
    c("2010-03-25 19:45", "2015-06-12 09:25", "2016-01-15 14:38", "2012-08-07 12:31")
  )

  expect_equal(
    (tbl_latex_time %>%
       fmt_passthrough(
         columns = datetime,
         rows = date %in% c("2017-10-15", "2014-09-22") & grepl("^1", time)) %>%
       render_formats_test(context = "latex"))[["datetime"]],
    c("2010-03-25 19:45", "2015-06-12 09:25", "2016-01-15 14:38", "2012-08-07 12:31")
  )
})

test_that("The `sub_missing()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       sub_missing(
         columns = num_2,
         rows = num_1 <= 0
       ) %>%
       render_formats_test(context = "latex"))[["num_2"]],
    c("34", "74", "23", "NA", "35", rep("—", 2))
  )
})

test_that("The `fmt()` function works with conditional `rows`", {

  expect_equal(
    (tbl_latex %>%
       fmt(
         columns = num_1,
         rows = num_1 > 1000,
         fns = function(x){
           x * 1000
         }) %>%
       render_formats_test(context = "latex"))[["num_1"]],
    c("1836230", "2763390", "937.290", "643.000", "212.232", "0.000", "-23.240")
  )
})