tests/testthat/test-nice_table.R

In rempsyc: Convenience Functions for Psychology

test_that("nice_table", {
  skip_if_not_installed("flextable")
  skip_if_not_installed("methods")

  my_table <- nice_table(
    mtcars[1:3, ],
    title = c("Table 1", "Motor Trend Car Road Tests"),
    note = c(
      "The data was extracted from the 1974 Motor Trend US magazine.",
      "* p < .05, ** p < .01, *** p < .001"
    )
  )
  # Test that nice_table returns a proper flextable object (not snapshot due to cross-environment differences)
  expect_s3_class(my_table, "flextable")
  expect_true("col_keys" %in% names(my_table))
  expect_true("header" %in% names(my_table))
  expect_true("body" %in% names(my_table))
  expect_equal(length(my_table$col_keys), 11) # mtcars has 11 columns
  expect_equal(nrow(my_table$body$dataset), 3) # 3 rows of mtcars data

  flextable::save_as_docx(my_table, path = "my_table.docx")

  # expect_snapshot_file("my_table.docx")
  # Not supported

  # Remove file
  unlink("my_table.docx")

  # Publication-ready tables
  mtcars.std <- lapply(mtcars, scale)
  model <- lm(mpg ~ cyl + wt * hp, mtcars.std)
  stats.table <- as.data.frame(summary(model)$coefficients)
  CI <- confint(model)
  stats.table <- cbind(
    row.names(stats.table),
    stats.table, CI
  )
  names(stats.table) <- c(
    "Term", "B", "SE", "t", "p",
    "CI_lower", "CI_upper"
  )
  # Publication-ready tables - test flextable class and properties
  stats_table <- nice_table(stats.table, highlight = TRUE)
  expect_s3_class(stats_table, "flextable")
  expect_true("col_keys" %in% names(stats_table))
  expect_true("95% CI" %in% stats_table$col_keys) # CI formatting creates this column
  expect_equal(nrow(stats_table$body$dataset), 5) # 5 rows in model coefficients

  # Test different column names
  test <- head(mtcars)
  names(test) <- c(
    "dR", "N", "M", "SD", "b", "np2",
    "ges", "p", "r", "R2", "sr2"
  )
  test[, 10:11] <- test[, 10:11] / 10
  test_table <- nice_table(test)
  expect_s3_class(test_table, "flextable")
  expect_equal(length(test_table$col_keys), 11) # 11 columns
  expect_equal(nrow(test_table$body$dataset), 6) # 6 rows (head of mtcars)

  # Custom cell formatting (such as p or r) - test flextable class
  p_format_table <- nice_table(test[8:11], col.format.p = 2:4, highlight = .001)
  expect_s3_class(p_format_table, "flextable")
  expect_equal(length(p_format_table$col_keys), 4) # 4 columns
  expect_equal(nrow(p_format_table$body$dataset), 6) # 6 rows

  r_format_table <- nice_table(test[8:11], col.format.r = 1:4)
  expect_s3_class(r_format_table, "flextable")
  expect_equal(length(r_format_table$col_keys), 4) # 4 columns
  expect_equal(nrow(r_format_table$body$dataset), 6) # 6 rows

  # Apply custom functions to cells - test flextable class
  fun <<- function(x) {
    x + 11.1
  }
  custom_table1 <- nice_table(test[8:11], col.format.custom = 2:4, format.custom = "fun")
  expect_s3_class(custom_table1, "flextable")
  expect_equal(length(custom_table1$col_keys), 4) # 4 columns

  fun <<- function(x) {
    paste("x", x)
  }
  custom_table2 <- nice_table(test[8:11], col.format.custom = 2:4, format.custom = "fun")
  expect_s3_class(custom_table2, "flextable")
  expect_equal(length(custom_table2$col_keys), 4) # 4 columns

  # Separate headers based on periods
  header.data <- structure(
    list(
      Variable = c(
        "Sepal.Length",
        "Sepal.Width", "Petal.Length"
      ), setosa.M = c(
        5.01, 3.43,
        1.46
      ), setosa.SD = c(0.35, 0.38, 0.17), versicolor.M =
        c(5.94, 2.77, 4.26), versicolor.SD = c(0.52, 0.31, 0.47)
    ),
    row.names = c(NA, -3L), class = "data.frame"
  )

  # Test that nice_table returns a proper flextable object (not snapshot due to cross-environment differences)
  result_table <- nice_table(header.data,
    separate.header = TRUE,
    italics = 2:4
  )
  expect_s3_class(result_table, "flextable")
  expect_true("col_keys" %in% names(result_table))
  expect_true("header" %in% names(result_table))
  expect_true("body" %in% names(result_table))
  expect_equal(result_table$col_keys, c("Variable", "setosa.M", "setosa.SD", "versicolor.M", "versicolor.SD"))
  expect_equal(nrow(result_table$header$dataset), 2) # separate.header = TRUE creates 2 header rows
  expect_equal(nrow(result_table$body$dataset), 3) # 3 rows of data
})