tests/testthat/test-materialtabelle.R

In eCerto: Statistical Tests for the Production of Reference Materials

testthat::test_that(
  desc = "Init of materialtable after Certifications uploaded",
  code = {
    testthat::local_edition(3)
    suppressMessages({
      rv <- eCerto:::test_rv() # load test data
      shiny::testServer(
        app = eCerto:::m_materialtabelleServer,
        args = list(rv = rv),
        expr = {
          mt <- eCerto::getValue(rv, c("General","materialtabelle"))
          testthat::expect_equal(unname(rv$c_analytes()), c("Si","Fe","Cu"))
          testthat::expect_equal(nrow(mt), 3)
          testthat::expect_equal(colnames(mt), c("analyte", "mean", "cert_val", "sd", "n", "u_char", "u_com", "k", "U", "U_abs", "unit"))
          testthat::expect_equal(unname(cert_sd()), 0.004331029)
          testthat::expect_equal(unname(cert_mean()), 0.0484375)
        }
      )
    })
  }
)

# # Test 2: another Analyte gets selected ------------------------------------
# testthat::test_that(
#   desc = "materialtable gets updated after another analyte gets selected",
#   code = {
#     # load/prepare test data
#     test_datreturn <- eCerto:::test_datreturn()
#     Fe <- structure(
#       list(
#         ID = c(2L, 9L, 16L, 23L, 30L, 37L),
#         Lab = structure(c(1L, 1L, 2L, 2L, 3L, 3L), .Label = c("L1", "L2", "L3"), class = "factor"),
#         analyte = structure(c(2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Si", "Fe", "Cu", "Mn", "Mg", "Cr", "Ni"), class = "factor"),
#         replicate = structure(c(1L, 2L, 1L, 2L, 1L, 2L), .Label = c("1", "2"), class = "factor"),
#         value = c(0.0529, 0.0527, 0.049, 0.0563, 0.0495, 0.0489),
#         unit = c("0.05", "0.05", "0.05", "0.05", "0.05", "0.05"),
#         S_flt = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE),
#         L_flt = c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)),
#       row.names = c(2L, 9L, 16L, 23L, 30L, 37L), class = "data.frame"
#     )
#     suppressMessages(
#       shiny::testServer(
#         app = eCerto::m_materialtabelleServer,
#         args = list(rdataUpload = shiny::reactive({NULL}), datreturn = test_datreturn),
#         expr = {
#           testthat::local_edition(3)
#           testthat::expect_null(mater_table()[mater_table()$analyte=="Fe","mean"])
#           session$setInputs(pooling=FALSE)
#           testthat::expect_equal(mater_table()[mater_table()$analyte=="Fe","mean"], as.numeric(NA))
#           datreturn$set("selectedAnalyteDataframe", Fe)
#           session$flushReact()
#           testthat::expect_equal(nrow(mater_table()), 11)
#           testthat::expect_equal(colnames(mater_table()), c("analyte", "mean", "cert_val", "sd", "n", "u_char", "u_com", "k", "U"))
#           #testthat::expect_equal(cert_sd(), getValue(test_datreturn,"cert_sd"))
#           #testthat::expect_equal(cert_mean(), getValue(test_datreturn,"cert_mean"))
#           testthat::expect_equal(mater_table(), getValue(test_datreturn,"mater_table"))
#           #expect_equal(mater_table()$U,c(0.079635,0.04475583,rep(0,9)),tolerance = 1e-5)
#           #expect_equal(mater_table()$char, c(0.039817,0.022378,rep(NA,9)), tolerance = 1e-5)
#           #expect_equal(mater_table()$com,c(0.03981726,0.02237792, rep(0,9)),tolerance = 1e-5)
#         }
#       )
#     )
#   }
# )
#
# # Test 3: Pooling on/off --------------------------------------------------
# testthat::test_that(
#   desc = "Pooling on/off switch can be set and changes 'n' in mat_tab",
#   code = {
#     testthat::local_edition(3)
#     test_datreturn <- eCerto:::test_datreturn()
#     suppressMessages(shiny::testServer(
#       app = eCerto::m_materialtabelleServer,
#       args = list(rdataUpload = shiny::reactive({NULL}), datreturn=test_datreturn),
#       expr = {
#         session$setInputs(pooling=FALSE)
#         testthat::expect_equal(mater_table()[1,"n"], 3L)
#         session$setInputs(pooling=TRUE)
#         testthat::expect_equal(mater_table()[1,"n"], 9L)
#         testthat::expect_equal(mater_table()$n[1], 9)
#         testthat::expect_equal(mater_table(), getValue(test_datreturn,"mater_table"))
#         # expect_equal(cert_sd(), 0.0032)
#         # expect_equal(mater_table()$char[1], 0.02163624, tolerance = 1e-5)
#         # expect_equal(mater_table()$com[1], 0.02163624, tolerance = 1e-5)
#         # expect_equal(mater_table()$U[1], 0.04327248, tolerance = 1e-5)
#       }
#     ))
#   }
# )
#
# # Test 4: Lab filter ---------------------
# testthat::test_that(
#   desc = "Setting Lab filter is changing 'n' in material table",
#   code = {
#     test_datreturn <- eCerto:::test_datreturn()
#     suppressMessages(
#       shiny::testServer(
#         eCerto::m_materialtabelleServer,
#         args = list(
#           rdataUpload = shiny::reactive({NULL}),
#           datreturn = test_datreturn
#         ), {
#           session$setInputs(pooling=FALSE)
#           session$flushReact()
#           testthat::expect_equal(tmp_mater_table()[tmp_mater_table()$analyte=="Si","n"], 3L)
#           tmp <- selectedAnalyteDataframe()
#           tmp[tmp$Lab=="L1",]$L_flt <- TRUE
#           setValue(datreturn, "selectedAnalyteDataframe", tmp)
#           session$flushReact()
#           testthat::expect_equal(tmp_mater_table()[tmp_mater_table()$analyte=="Si","n"], 2L)
#         }
#       )
#     )
#   }
# )