tests/testthat/test-interactive-preview.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    expect_false,
    expect_true,
    test_that
  ]
)

box::use(
  artma / interactive / preview[
    column_overview_frame,
    count_studies,
    preview_menu_items,
    render_data_overview,
    render_study_summary,
    run_preview_menu,
    study_overview_frame
  ]
)

# A prepared frame with known health metrics: t values 5, 2, 5.833 and -0.5,
# so 3 of the 4 estimates clear the 5% threshold.
preview_df <- function() {
  data.frame(
    study_id = c("s1", "s1", "s2", "s2"),
    effect = c(0.5, 0.3, 0.7, -0.2),
    se = c(0.1, 0.15, 0.12, 0.4),
    country = c("cz", "cz", "de", NA),
    stringsAsFactors = FALSE
  )
}

# Sequenced single-select backend, as in test-session-hub.R: each call
# consumes the next script entry and returns the value of the first label
# containing it.
make_select_fn <- function(script) {
  index <- 0L
  function(choices, prompt, selected = NULL, descriptions = NULL) {
    index <<- index + 1L
    stopifnot(index <= length(script))
    pattern <- script[[index]]
    if (is.na(pattern)) {
      return(character(0))
    }
    labels <- names(choices) %||% choices
    matches <- unname(choices[grepl(pattern, labels, fixed = TRUE)])
    stopifnot(length(matches) >= 1L)
    matches[[1]]
  }
}

test_that("the overview reports size, missingness and the health panel", {
  messages <- testthat::capture_messages(render_data_overview(preview_df()))
  text <- paste(messages, collapse = "\n")

  expect_true(grepl("4 rows, 4 columns", text))
  expect_true(grepl("2 studies", text))
  expect_true(grepl("1 missing value", text))
  expect_true(grepl("Mean effect: 0.325", text))
  expect_true(grepl("precision-weighted", text))
  expect_true(grepl("Sign split: 3 positive, 1 negative", text))
  expect_true(grepl("Significant at 5%: 3 of 4 estimates (75%)", text, fixed = TRUE))
  expect_true(grepl("Largest |t|: 5.833", text, fixed = TRUE))
  expect_true(grepl("Effect range: -0.2 to 0.7", text))
  expect_true(grepl("SE range: 0.1 to 0.4", text))
})

test_that("the overview degrades without numeric effect and se columns", {
  df <- data.frame(x = c("a", "b"), stringsAsFactors = FALSE)
  messages <- testthat::capture_messages(render_data_overview(df))
  text <- paste(messages, collapse = "\n")

  expect_true(grepl("2 rows, 1 column", text))
  expect_true(grepl("No missing values", text))
  expect_false(grepl("Mean effect", text))
  expect_false(grepl("Effect range", text))
})

test_that("count_studies is NA without the study column", {
  expect_equal(count_studies(preview_df()), 2L)
  expect_true(is.na(count_studies(data.frame(x = 1:3))))
})

test_that("column_overview_frame assigns roles, sources and summaries", {
  withr::local_options(list(
    artma.data.columns = list(effect = list(source_name = "Coef"))
  ))

  frame <- column_overview_frame(preview_df())

  expect_equal(frame$column, c("study_id", "effect", "se", "country"))
  expect_equal(frame$role, c("required", "required", "required", "moderator"))
  # Only the genuinely renamed column names its source.
  expect_equal(frame$source, c("", "Coef", "", ""))
  expect_equal(frame$missing, c(0L, 0L, 0L, 1L))
  expect_true(grepl("min -0.2, median 0.4, max 0.7", frame$summary[[2]]))
  expect_equal(frame$summary[[4]], "2 unique values")
})

test_that("column_overview_frame labels computed columns", {
  df <- preview_df()
  df$t_stat <- df$effect / df$se
  frame <- column_overview_frame(df)
  expect_equal(frame$role[frame$column == "t_stat"], "computed")
})

test_that("study_overview_frame sorts by estimate count and averages per study", {
  df <- preview_df()
  df$study_id <- c("s1", "s1", "s1", "s2")

  frame <- study_overview_frame(df)

  expect_equal(frame$study, c("s1", "s2"))
  expect_equal(frame$estimates, c(3L, 1L))
  expect_equal(frame$mean_effect, c(0.5, -0.2))
  expect_equal(frame$mean_se, c(signif(mean(c(0.1, 0.15, 0.12)), 4), 0.4))
})

test_that("render_study_summary caps the table and says so", {
  df <- data.frame(
    study_id = rep(sprintf("study_%02d", 1:12), each = 2),
    effect = rep(0.1, 24),
    se = rep(0.05, 24),
    stringsAsFactors = FALSE
  )

  messages <- testthat::capture_messages(render_study_summary(df, width = 100))
  text <- paste(messages, collapse = "\n")

  expect_true(grepl("12 studies; estimates per study: min 2, median 2, max 2", text))
  expect_true(grepl("Showing the 10 largest of 12 studies", text))
})

test_that("render_study_summary explains an unresolved study column", {
  messages <- testthat::capture_messages(
    render_study_summary(data.frame(effect = 1:3))
  )
  expect_true(any(grepl("study column is not resolved", messages)))
})

test_that("preview_menu_items offers the viewer only when available", {
  values <- function(items) vapply(items, function(item) item$value, character(1))

  expect_equal(
    values(preview_menu_items(TRUE)),
    c("overview", "columns", "studies", "view", "back")
  )
  expect_equal(
    values(preview_menu_items(FALSE)),
    c("overview", "columns", "studies", "back")
  )
})

test_that("run_preview_menu dispatches the submenu items", {
  viewed <- 0L

  messages <- testthat::capture_messages(run_preview_menu(
    preview_df(),
    view_data = function(frame) viewed <<- viewed + 1L,
    select_fn = make_select_fn(c("Columns", "Studies", "Open spreadsheet viewer", "Back")),
    width = 100,
    viewer_available = function() TRUE
  ))
  text <- paste(messages, collapse = "\n")

  # The overview renders on entry, before any submenu pick.
  expect_true(grepl("4 rows, 4 columns", text))
  # The Columns screen: header plus one line per column.
  expect_true(grepl("column", text))
  expect_true(grepl("moderator", text))
  # The Studies screen.
  expect_true(grepl("2 studies; estimates per study", text))
  expect_equal(viewed, 1L)
})

test_that("run_preview_menu hides the viewer and survives a cancelled menu", {
  messages <- testthat::capture_messages(run_preview_menu(
    preview_df(),
    view_data = function(frame) stop("view_data must not be called"),
    select_fn = make_select_fn(NA),
    width = 100,
    viewer_available = function() FALSE
  ))

  expect_true(any(grepl("4 rows, 4 columns", messages)))
})