tests/testthat/test-gui.R

In cofad: Contrast Analyses for Factorial Designs

library(shinytest2)
modify_hot_table <- function(row, col, value, table) {
  paste0(
    "var $table = HTMLWidgets.getInstance(", table, ").hot;",
    "$table.setDataAtCell(", row - 1, ", ", col - 1, ", ", value, ");"
  )
}

test_that("gui between works", {
  skip_on_cran()
  skip_on_ci()
  start <- run_app()
  app <- AppDriver$new(start, name = "between")
  app$upload_file(datafile = "sedlmeier_p525.csv") # change path
  app$set_inputs("between_name" = "between")

  app$run_js(modify_hot_table(1, 2, 60, "hot_lambda_between"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(2, 2, -40, "hot_lambda_between"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(3, 2, -20, "hot_lambda_between"))
  app$wait_for_idle()

  tbl <- app$get_value(output = "table_region")

  expect_true(grepl("6.519", tbl))
  expect_true(grepl("0.59", tbl))
})

test_that("gui within works", {
  skip_on_cran()
  skip_on_ci()
  app <- AppDriver$new(run_app())
  app$upload_file(datafile = "sedlmeier_p537.csv") # change path

  app$set_inputs("within_name" = "music", "id_name" = "participant")
  app$run_js(modify_hot_table(1, 2, -0.75, "hot_lambda_within"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(2, 2, -0.75, "hot_lambda_within"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(3, 2, 0.25, "hot_lambda_within"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(4, 2, 1.25, "hot_lambda_within"))
  app$wait_for_idle()

  tbl <- app$get_value(output = "table_region")
  # sedlmeier 5.27
  expect_true(grepl("5.269", tbl))
})

test_that("gui mixed works", {
  skip_on_cran()
  skip_on_ci()
  app <- AppDriver$new(run_app())
  app$upload_file(datafile = "rosenthal_tbl53.csv")
  app$set_inputs("within_name" = "within", "id_name" = "id",
                 "between_name" = "between")
  app$run_js(modify_hot_table(1, 2, 0, "hot_lambda_between"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(2, 2, 1, "hot_lambda_between"))
  app$wait_for_idle()
  app$run_js(modify_hot_table(3, 2, -1, "hot_lambda_between"))
  app$wait_for_idle()
  # within is linear

  tbl <- app$get_value(output = "table_region")
  # original vaue: 20.19
  expect_true(grepl("20.211", tbl))
  expect_true(grepl("0.871", tbl))
})