Skip to content

Commit

Permalink
sync tests with new R and mirt version
Browse files Browse the repository at this point in the history
  • Loading branch information
@philchalmers
philchalmers committed Aug 10, 2018
1 parent 1a3e6c0 commit 0efa4ce
Show file tree
Hide file tree
Showing 3 changed files with 57 additions and 59 deletions.
6 changes: 3 additions & 3 deletions tests/tests/test-mirtCAT_classify.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,10 +46,10 @@ test_that('classify', {
preCAT <- list(response_variance = TRUE, min_items = 1, max_items = 20, method = 'fixed')
res <- mirtCAT(mo=mod, criteria = 'KL', start_item = 'MI', local_pattern = pats,
design = list(classify=0, classify_CI=.95), preCAT=preCAT)
expect_equal(summary(res[[1]])$thetas_history[1:6,1], c(0,0,0,-0.1861817,-0.4680564,-0.5840835), tolerance = 1e-4)
expect_equal(summary(res[[2]])$thetas_history[1:6,1], c(0,0,0,-0.09676312,0.05468066,-0.08034545), tolerance = 1e-4)
expect_equal(summary(res[[1]])$thetas_history[1:6,1], c(0,0,0,0,-0.314607,-0.5473551), tolerance = 1e-4)
expect_equal(summary(res[[2]])$thetas_history[1:6,1], c(0,0,0,-0.3014674,-0.08797493,-0.2216946), tolerance = 1e-4)
scored <- summary(res[[3]], sort=FALSE)$scored_responses
out <- fscores(mod, response.pattern = scored)
expect_equal(as.numeric(out[,'F1']), 1.19834, tolerance = 1e-4)
expect_equal(as.numeric(out[,'F1']), 0.938323, tolerance = 1e-4)

})
32 changes: 16 additions & 16 deletions tests/tests/test-mirtCAT_multi.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ test_that('multidimensional', {
Type = 'radio', stringsAsFactors = FALSE)

pat <- generate_pattern(mod2, Theta = c(0, 1), df)
expect_true(all(pat == as.character(c(96,60,86,81,120,82,89,97,124,81,80,126,101,131,108,89,125,113,121,106,95,71,97,82,109,58,62,141,92,85,105,104,120,107,115,111,107,108,119,105))))
expect_true(all(pat == as.character(c(74,96,107,118,102,88,114,96,101,93,80,100,92,52,105,98,120,120,81,114,87,102,68,96,111,100,106,107,108,139,90,124,58,122,114,98,56,114,98,66))))

set.seed(1234)
pat2 <- generate_pattern(mod2, Theta = c(0, 1))
Expand All @@ -51,8 +51,8 @@ test_that('multidimensional', {

#sequential
res <- mirtCAT(df, mod2, local_pattern=pat)
expect_equal(as.numeric(res$thetas), c(0.6080447, 0.8036752), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[41,]), c(0.3960947, 0.4065036), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(-0.2624228, 0.4408263), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[41,]), c(0.3690100, 0.3812945), tolerance = 1e-4)

oo <- plot(res)
expect_is(oo, 'trellis')
Expand All @@ -67,40 +67,40 @@ test_that('multidimensional', {

res <- mirtCAT(df, mod2, local_pattern=pat, criteria='DPrule',
design = list(min_SEM = .4))
expect_equal(res$items_answered, c(1,20,21,37,3,5,35,30,24,36,16,11,39,14,29,7,13,23,32,18,17,22,12,15,28,19,10,26,27,38,31,6,25,9,8,34,4,33,2,40))
expect_equal(as.numeric(res$thetas), c(0.6080447, 0.8036752), tolerance = 1e-4)
expect_equal(res$items_answered, c(1,20,21,39,3,37,5,36,14,15,35,24,11,16,29,30,32,6,13,19,22,10,28,23,7,27,12,9,8,26,38,18,2,25,31))
expect_equal(as.numeric(res$thetas), c(-0.2061207, 0.5225479), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.3960947, 0.4065036), tolerance = 1e-4)
c(0.3723255, 0.3933855), tolerance = 1e-4)

res <- mirtCAT(df, mod2, local_pattern=pat, criteria='Drule',
design = list(min_SEM = .5))
expect_equal(as.numeric(res$thetas), c(0.4718224, 0.8060655), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(-0.06375424, 0.55081663), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.4937443, 0.4917037), tolerance = 1e-4)
c(0.4796803, 0.4957047), tolerance = 1e-4)

res <- mirtCAT(df, mod2, local_pattern=pat,
design = list(min_SEM = .5), criteria = 'TPrule')
expect_equal(as.numeric(res$thetas), c(0.4446583, 0.8397193), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(-0.08072858,0.51927881), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.4404435, 0.4914105), tolerance = 1e-4)
c(0.4483342,0.4926736), tolerance = 1e-4)

res <- mirtCAT(df, mod2, local_pattern=pat,
design = list(min_SEM = .5), criteria = 'WPrule')
expect_equal(as.numeric(res$thetas), c(0.6661044, 1.0048121), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(0.008799144,0.593384091), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.4564088, 0.4913090), tolerance = 1e-4)
c(0.4758097,0.4978876), tolerance = 1e-4)

res <- mirtCAT(df, mod2, local_pattern=pat,
design = list(min_SEM = .5), criteria = 'EPrule')
expect_equal(as.numeric(res$thetas), c(0.4468275, 0.9738567), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(0.008799144,0.593384091), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.4933418, 0.4957023), tolerance = 1e-4)
c(0.4758097,0.4978876), tolerance = 1e-4)

res <- mirtCAT(df, mod2, local_pattern=pat,
design = list(min_SEM = .5), criteria = 'APrule')
expect_equal(as.numeric(res$thetas), c(0.5543021, 0.8456234), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), c(0.0004752878, 0.6161572073), tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
c(0.4881130, 0.4933111), tolerance = 1e-4)
c(0.477021,0.498364), tolerance = 1e-4)

})

78 changes: 38 additions & 40 deletions tests/tests/test-mirtCAT_uni.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,11 +33,9 @@ test_that('unidimensional', {
df2$Answer <- answers

pat <- generate_pattern(mod, Theta = 0, df2)
expect_true(all(pat == as.character(c(67,90,109,118,111,127,118,129,112,97,93,98,77,110,98,
125,112,122,148,136,100,88,83,76,90))))
expect_true(all(pat == as.character(c(80,102,101,98,62,102,100,68,126,62,95,111,89,102,106,113,98,82,65,97,128,79,115,86,118))))
pat2 <- generate_pattern(mod, Theta = -1, df2)
expect_true(all(pat2 == as.character(c(70,90,101,139,123,107,120,139,122,100,93,97,81,110,
100,125,106,132,152,136,106,98,87,72,90))))
expect_true(all(pat2 == as.character(c(74,108,101,77,64,94,92,76,134,62,101,108,82,112,98,105,102,84,69,105,124,79,115,82,110))))

#no scoring, just collecting
res <- mirtCAT(df, local_pattern=pat)
Expand Down Expand Up @@ -87,8 +85,8 @@ test_that('unidimensional', {

#sequential
res <- mirtCAT(df2, mod, local_pattern=pat)
expect_equal(as.numeric(res$thetas), 0.3344562, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[26,]), 0.3148088, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -0.1156397, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[26,]), 0.3319357, tolerance = 1e-4)

oo <- plot(res)
expect_is(oo, 'trellis')
Expand All @@ -100,10 +98,10 @@ test_that('unidimensional', {
#adaptive
res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
design = list(min_SEM = .4))
expect_equal(as.numeric(res$thetas), 0.4047002, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[10L,]), 0.3889968, tolerance = 1e-4)
expect_true(sum(!is.na(res$raw_responses)) == 9L && sum(!is.na(res$scored_responses)) == 9L)
expect_true(nrow(!is.na(res$thetas_history)) == 10L && nrow(!is.na(res$thetas_SE_history)) == 10L)
expect_equal(as.numeric(res$thetas), -.03611283, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[10L,]), 0.4093153, tolerance = 1e-4)
expect_true(sum(!is.na(res$raw_responses)) == 10L && sum(!is.na(res$scored_responses)) == 10L)
expect_true(nrow(!is.na(res$thetas_history)) == 11L && nrow(!is.na(res$thetas_SE_history)) == 11L)

res <- mirtCAT(mo = mod, local_pattern=generate_pattern(mod, matrix(c(0,1))), criteria='MI',
design = list(min_SEM = .4))
Expand All @@ -116,85 +114,85 @@ test_that('unidimensional', {

res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
design = list(min_SEM = .4), method = 'EAP')
expect_equal(as.numeric(res$thetas), 0.3161534, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.00942354, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3947569, tolerance = 1e-4)
0.3843882, tolerance = 1e-4)

exposure <- rep(3L, nrow(df2))
set.seed(1234)
res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
design = list(min_SEM = .4, exposure=exposure), method = 'EAP',
start_item=sample(c(1:nrow(df2)), 1))
expect_equal(as.numeric(res$thetas), 0.6979685, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -0.2186294, tolerance = 1e-4)
so <- summary(res)
expect_equal(as.numeric(so$thetas_SE_history[nrow(so$thetas_SE_history),]),
0.3962437, tolerance = 1e-4)
0.3926076, tolerance = 1e-4)

set.seed(1)
exposure <- rep(0.75, nrow(df2))
res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
design = list(min_SEM = .4, exposure=exposure), method = 'EAP',
start_item=sample(c(1:nrow(df2)), 1))
expect_equal(as.numeric(res$thetas), 0.2187247, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -.03342287, tolerance = 1e-4)
so <- summary(res)
expect_equal(as.numeric(so$thetas_SE_history[nrow(so$thetas_SE_history),]),
0.3951322, tolerance = 1e-4)
0.3986095, tolerance = 1e-4)

set.seed(12)
res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='random')
expect_equal(as.numeric(res$thetas), 0.02252426, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.07423068, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3938078, tolerance = 1e-4)
0.3915826, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='MEI')
expect_equal(as.numeric(res$thetas), 0.3161534, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -.114286, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3947569, tolerance = 1e-4)
0.3867981, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='MEPV')
expect_equal(as.numeric(res$thetas), 0.3425135, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.00942354, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3951722, tolerance = 1e-4)
0.3843882, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='MLWI')
expect_equal(as.numeric(res$thetas), 0.3425135, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.00942354, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3951722, tolerance = 1e-4)
0.3843882, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='MPWI')
expect_equal(as.numeric(res$thetas), 0.3161534, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.00942354, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3947569, tolerance = 1e-4)
0.3843882, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='KL')
expect_equal(as.numeric(res$thetas), 0.3161534, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.00942354, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3947569, tolerance = 1e-4)
0.3843882, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'ML', criteria='KLn',
preCAT = list(max_items = 5L, criteria = 'seq', method = 'fixed'))
expect_equal(as.numeric(res$thetas), 0.2437948, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -0.01885796, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3947168, tolerance = 1e-4)
0.3995055, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat, criteria='IKL',
design = list(min_SEM = .4), method = 'MAP')
expect_equal(as.numeric(res$thetas), 0.1140858, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.213972, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3913585, tolerance = 1e-4)
0.394090, tolerance = 1e-4)

res <- mirtCAT(df2, mod, local_pattern=pat, criteria='IKLPn',
design = list(min_SEM = .4), method = 'MAP')
expect_equal(as.numeric(res$thetas), 0.1140858, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), 0.213972, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3913585, tolerance = 1e-4)
0.3940905, tolerance = 1e-4)

# content balancing
set.seed(1)
Expand All @@ -205,26 +203,26 @@ test_that('unidimensional', {
method = 'MAP') #should crash with 'seq'
so <- summary(res)
expect_equal(so$items_answered[1:5], c(1,20,2,3,24))
expect_equal(as.numeric(table(content[so$items_answered])/10), c(.6, .3))
expect_equal(as.numeric(table(content[so$items_answered])/10), c(.7, .3))

#pass other args through ...
res <- mirtCAT(df2, mod, local_pattern=pat,
design = list(min_SEM = .4), method = 'EAP', criteria='KL', theta_lim = c(-1,1))
expect_equal(as.numeric(res$thetas), 0.3181472, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas), -0.1101559, tolerance = 1e-4)
expect_equal(as.numeric(res$thetas_SE_history[nrow(res$thetas_SE_history),]),
0.3975391, tolerance = 1e-4)
0.3916425, tolerance = 1e-4)

## classification
res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
design = list(classify = -0.5, classify_CI=.95))
so <- summary(res)
expect_true(so$classification == 'above cutoff')
expect_equal(as.numeric(res$thetas), 0.4028854, tolerance = 1e-4)
expect_true(so$classification == 'no decision')
expect_equal(as.numeric(res$thetas), -0.11564, tolerance = 1e-4)

##fscores call
responses <- res$scored_responses
fs <- fscores(mod, response.pattern = responses)
expect_equal(unname(fs[,'F1']), .4236452, tolerance = 1e-4)
expect_equal(unname(fs[,'F1']), -0.1384693, tolerance = 1e-4)

# excluded set
res <- mirtCAT(df2, mod, local_pattern=pat, criteria='MI',
Expand Down

0 comments on commit 0efa4ce

Please sign in to comment.