Nothing
context("MPTinR basic tests")
test_that("No-pooling approaches work", {
##testthat::skip_on_cran()
EQN_FILE <- system.file("extdata", "prospective_memory.eqn",
package = "MPTmultiverse")
DATA_FILE <- system.file("extdata", "smith_et_al_2011.csv",
package = "MPTmultiverse")
data <- read.csv(DATA_FILE, fileEncoding = "UTF-8-BOM")
data <- data[c(1:5, 113:118),]
COL_CONDITION <- "WM_EX"
data[[COL_CONDITION]] <- factor(
data[[COL_CONDITION]]
, levels = 1:2
, labels = c("low_WM", "high_WM")
)
op <- mpt_options()
capture_output(mpt_options("test"))
mpt_options("n.CPU" = 1) ## use 1 CPU, so it can run on CRAN
set.seed(10) ## for reproducibility
only_asymptotic <- fit_mpt(
method = "asymptotic_no"
, dataset = DATA_FILE
, data = data
, model = EQN_FILE
, condition = COL_CONDITION
)
expect_equal(nrow(only_asymptotic), 1)
expect_equal(only_asymptotic$pooling, "no")
expect_equal(only_asymptotic$method, "asymptotic")
## dput(round(only_asymptotic$est_group[[1]]$est, 3))
## extract correct parameters:
new <- only_asymptotic$est_group[[1]]
ref <- tibble(condition = c("low_WM", "low_WM", "low_WM", "low_WM",
"high_WM", "high_WM", "high_WM", "high_WM"),
parameter = c("C1", "C2", "M", "P", "C1", "C2", "M", "P"),
core = c(FALSE, FALSE,FALSE, FALSE, FALSE, FALSE, FALSE,
FALSE),
est = c(0.933, 0.903, 0.701, 0.887, 0.922, 0.972, 0.912,
0.725)
)
expect_equal(dplyr::arrange(new, condition, parameter)$est,
dplyr::arrange(ref, condition, parameter)$est,
tolerance = 0.001)
# dput(round(only_asymptotic$gof_group[[1]]$stat_obs, 2))
expect_equal(only_asymptotic$gof_group[[1]]$stat_obs,
c(27.2, 31.75),
tolerance = 0.01)
new <- only_asymptotic$est_indiv[[1]]
ref <- tibble(
id = c("1", "1", "1", "1", "2", "2", "2", "2", "3", "3", "3",
"3", "4", "4", "4", "4", "5", "5", "5", "5", "6", "6",
"6", "6", "7", "7", "7", "7", "8", "8", "8", "8", "9",
"9", "9", "9", "10", "10", "10", "10", "11", "11", "11",
"11"),
condition = c("low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM"),
parameter = c("C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M",
"P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2",
"M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P"),
se = c(NA, NA, NA, NA, NA, NA, NA, NA, 0.02, 0.02, 0.05, 0.19, NA,
NA, NA, NA, 0.02, 0.02, 0.06, 0.17, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA))
expect_equal(dplyr::arrange(new, id, condition, parameter)$se,
dplyr::arrange(ref, id, condition, parameter)$se,
tolerance = 0.01)
## required to skip remaining if not using latest RNG
testthat::skip_if(getRversion() < "3.6.0")
only_pb <- fit_mpt(
method = "pb_no"
, dataset = DATA_FILE
, data = data
, model = EQN_FILE
, condition = COL_CONDITION
)
expect_equal(nrow(only_pb), 1)
expect_equal(only_pb$pooling, "no")
expect_equal(only_pb$method, "PB/MLE")
### NOTE: ordering of conditions differs between asymptotic and PB!
new <- only_pb$est_group[[1]]
ref <- tibble(
condition = c("low_WM", "low_WM", "low_WM", "low_WM",
"high_WM", "high_WM", "high_WM", "high_WM"),
parameter = c("C1", "C2", "M", "P", "C1", "C2", "M", "P"),
est = c(0.933, 0.903, 0.701, 0.887, 0.922, 0.972, 0.912, 0.75)
)
expect_equal(dplyr::arrange(new, condition, parameter)$est,
dplyr::arrange(ref, condition, parameter)$est,
tolerance = 0.001)
new_gof <- only_pb$gof_group[[1]]
ref_gof <- tibble(
condition = c("low_WM", "high_WM"),
stat_obs = c(27.2, 31.75),
p = c(0.09, 0.09)
)
expect_equal(dplyr::arrange(new_gof, condition)$stat_obs,
dplyr::arrange(ref_gof, condition)$stat_obs,
tolerance = 0.01)
expect_equal(dplyr::arrange(new_gof, condition)$p,
dplyr::arrange(ref_gof, condition)$p,
tolerance = 0.01)
new_indiv <- only_pb$est_indiv[[1]]
ref_indiv <- tibble(
id = c("1", "1", "1", "1", "2", "2", "2", "2",
"3", "3", "3", "3", "4", "4", "4", "4", "5", "5", "5", "5", "6",
"6", "6", "6", "7", "7", "7", "7", "8", "8", "8", "8", "9", "9",
"9", "9", "10", "10", "10", "10", "11", "11", "11", "11"),
condition =
c("low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM"),
parameter =
c("C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P"),
est = c(0.97, 1, 1, 0.81, 0.98, 0.88, 1, 0.69, 0.89, 0.88, 0.22, 1,
0.91, 0.93, 1, 0.94, 0.92, 0.82, 0.28, 1, 0.79, 0.95, 1, 0.31,
0.9, 0.97, 1, 0.81, 0.95, 1, 0.47, 1, 0.91, 0.95, 1, 0.87, 0.98,
0.97, 1, 0.88, 1, 1, 1, 0.62),
se =
c(0.02, 0, 0, 0.09, 0.02, 0.04, 0, 0.1, 0.06, 0.03, 0.34, 0.28,
0.04, 0.04, 0, 0.08, 0.03, 0.04, 0.32, 0.33, 0.06, 0.02, 0, 0.14,
0.04, 0.02, 0, 0.09, 0.02, 0, 0.10, 0.07, 0.03, 0.02, 0, 0.05,
0.01, 0.02, 0, 0.09, 0, 0, 0, 0.12)
)
expect_equal(dplyr::arrange(new_indiv, id, condition, parameter)$est,
dplyr::arrange(ref_indiv, id, condition, parameter)$est,
tolerance = 0.01)
if (capabilities()[["long.double"]]) {
expect_equal(dplyr::arrange(new_indiv, id, condition, parameter)$se,
dplyr::arrange(ref_indiv, id, condition, parameter)$se,
tolerance = 0.05)
}
only_npb <- fit_mpt(
method = "npb_no"
, dataset = DATA_FILE
, data = data
, model = EQN_FILE
, condition = COL_CONDITION
)
expect_equal(nrow(only_npb), 1)
expect_equal(only_npb$pooling, "no")
expect_equal(only_npb$method, "NPB/MLE")
new <- only_npb$est_group[[1]]
ref <- tibble(
condition = c("low_WM", "low_WM", "low_WM", "low_WM",
"high_WM", "high_WM", "high_WM", "high_WM"),
parameter = c("C1", "C2", "M", "P", "C1", "C2", "M", "P"),
est = c(0.933, 0.903, 0.701, 0.887, 0.922, 0.972, 0.912, 0.75)
)
expect_equal(dplyr::arrange(new, condition, parameter)$est,
dplyr::arrange(ref, condition, parameter)$est,
tolerance = 0.001)
new_gof <- only_npb$gof_group[[1]]
ref_gof <- tibble(
condition = c("low_WM", "high_WM"),
stat_obs = c(27.2, 31.75),
p = c(0.64, 1) ## is now: c(0.64, 0.91)
)
expect_equal(dplyr::arrange(new_gof, condition)$stat_obs,
dplyr::arrange(ref_gof, condition)$stat_obs,
tolerance = 0.01)
expect_equal(dplyr::arrange(new_gof, condition)$p,
dplyr::arrange(ref_gof, condition)$p,
tolerance = 0.1)
new_indiv <- only_npb$est_indiv[[1]]
ref_indiv <- tibble(
id = c("1", "1", "1", "1", "2", "2", "2", "2",
"3", "3", "3", "3", "4", "4", "4", "4", "5", "5", "5", "5", "6",
"6", "6", "6", "7", "7", "7", "7", "8", "8", "8", "8", "9", "9",
"9", "9", "10", "10", "10", "10", "11", "11", "11", "11"),
condition =
c("low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM", "low_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM",
"high_WM", "high_WM", "high_WM", "high_WM", "high_WM", "high_WM"),
parameter =
c("C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P", "C1", "C2", "M", "P", "C1",
"C2", "M", "P", "C1", "C2", "M", "P"),
est = c(0.97, 1, 1, 0.81, 0.98, 0.88, 1, 0.69, 0.89, 0.88, 0.22, 1,
0.91, 0.93, 1, 0.94, 0.92, 0.82, 0.28, 1, 0.79, 0.95, 1, 0.31,
0.9, 0.97, 1, 0.81, 0.95, 1, 0.47, 1, 0.91, 0.95, 1, 0.87, 0.98,
0.97, 1, 0.88, 1, 1, 1, 0.62),
se =
c(0.02, 0, 0, 0.09, 0.01, 0.03, 0, 0.14, 0.04, 0.05, 0.06, 0,
0.02, 0.03, 0, 0.07, 0.03, 0.04, 0.12, 0.09, 0.05, 0.02, 0, 0.13,
0.04, 0.03, 0, 0.11, 0.04, 0, 0.18, 0.16, 0.05, 0.03, 0, 0.08,
0.02, 0.02, 0, 0.06, 0, 0, 0, 0.16)
)
expect_equal(dplyr::arrange(new_indiv, id, condition, parameter)$est,
dplyr::arrange(ref_indiv, id, condition, parameter)$est,
tolerance = 0.01)
if (capabilities()[["long.double"]]) {
expect_equal(dplyr::arrange(new_indiv, id, condition, parameter)$se,
dplyr::arrange(ref_indiv, id, condition, parameter)$se,
tolerance = 0.05)
}
mpt_options(op)
})
test_that("Complete-pooling approaches work", {
##testthat::skip_on_cran()
EQN_FILE <- system.file("extdata", "prospective_memory.eqn",
package = "MPTmultiverse")
DATA_FILE <- system.file("extdata", "smith_et_al_2011.csv",
package = "MPTmultiverse")
data <- read.csv(DATA_FILE, fileEncoding = "UTF-8-BOM")
data <- data[c(1:5, 113:118),]
COL_CONDITION <- "WM_EX"
data[[COL_CONDITION]] <- factor(
data[[COL_CONDITION]]
, levels = 1:2
, labels = c("low_WM", "high_WM")
)
op <- mpt_options()
capture_output(mpt_options("test"))
mpt_options("n.CPU" = 1) ## use 1 CPU, so it can run on CRAN
set.seed(10) ## for reproducibility
only_asymptotic <- fit_mpt(
method = "asymptotic_complete"
, dataset = DATA_FILE
, data = data
, model = EQN_FILE
, condition = COL_CONDITION
)
expect_equal(nrow(only_asymptotic), 1)
expect_equal(only_asymptotic$pooling, "complete")
expect_equal(only_asymptotic$method, "asymptotic")
## dput(round(only_asymptotic$est_group[[1]]$est, 3))
expect_equal(only_asymptotic$est_group[[1]]$est,
c(0.933, 0.902, 0.587, 1, 0.922, 0.972, 0.822, 0.809),
tolerance = 0.001)
# dput(round(only_asymptotic$gof_group[[1]]$stat_obs, 2))
expect_equal(only_asymptotic$gof_group[[1]]$stat_obs,
c(6.86, 4.93),
tolerance = 0.01)
expect_equal(only_asymptotic$est_indiv[[1]], tibble::tibble())
expect_equal(only_asymptotic$gof[[1]]$p,
0.117,
tolerance = 0.001)
mpt_options(op)
# test_within
est_group <- only_asymptotic$est_group[[1]]
test_within <- only_asymptotic$test_within[[1]]
pairs <- combn(x = unique(est_group$parameter), m = 2)
for (j in seq_len(ncol(pairs))) {
est_diff <- est_group$est[est_group$parameter == pairs[1, j]] - est_group$est[est_group$parameter == pairs[2, j]]
expect_equal(object = est_diff, expected = test_within$est[test_within$parameter1 == pairs[1, j] & test_within$parameter2 == pairs[2, j]])
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.