-
Notifications
You must be signed in to change notification settings - Fork 0
/
stnd_cor.R
75 lines (63 loc) · 3.29 KB
/
stnd_cor.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#' Standard Guessing Correction for Learning
#'
#' Estimate of learning adjusted with standard correction for guessing. Correction is based on number of options per question.
#' The function takes separate pre-test and post-test dataframes. Why do we need dataframes? To accomodate multiple items.
#' The items can carry NA (missing). Items must be in the same order in each dataframe. Assumes that respondents are posed same questions twice.
#' The function also takes a \code{lucky} vector --- the chance of getting a correct answer if guessing randomly. Each entry is 1/(number of options).
#' The function also optionally takes a vector carrying names of the items. By default, the vector carrying adjusted learning estimates takes same
#' item names as the pre_test items. However you can assign a vector of names separately via \code{item_names}.
#'
#' @param pre_test Required. data.frame carrying responses to pre-test questions.
#' @param pst_test Required. data.frame carrying responses to post-test questions.
#' @param lucky Required. A vector. Each entry is 1/(number of options)
#' @param item_names Optional. A vector carrying item names.
#'
#' @return a list of three vectors, carrying pre-treatment corrected scores, post-treatment scores, and adjusted estimates of learning
#' @export
#' @examples
#' # Without DK
#' pre_test <- data.frame(item1 = c(1,0,0,1,0), item2 = c(1,NA,0,1,0))
#' pst_test <- pre_test + cbind(c(0,1,1,0,0), c(0,1,0,0,1))
#' lucky <- rep(.25, 2); stnd_cor(pre_test, pst_test, lucky)
#' # With DK
#' pre_test <- data.frame(item1 = c(1,0,0,1,0,'d',0), item2 = c(1,NA,0,1,0,'d','d'))
#' pst_test <- data.frame(item1 = c(1,0,0,1,0,'d',1), item2 = c(1,NA,0,1,0,1,'d'))
#' lucky <- rep(.25, 2); stnd_cor(pre_test, pst_test, lucky)
stnd_cor <- function(pre_test = NULL, pst_test = NULL, lucky = NULL,
item_names = NULL) {
# pre_test data frame is missing
if ( !is.data.frame(pre_test)) stop("Specify pre_test data.frame.")
# post_test data frame is missing
if ( !is.data.frame(pst_test)) stop("Specify pst_test data.frame.")
# lucky vector is missing
if ( is.null(lucky)) stop("Specify lucky vector.")
if ( length(unique(length(pre_test), length(pst_test), length(lucky))) != 1) {
stop("Length of input varies.
Length of pre_test, pst_test, and lucky must be the same.")
}
pre_test_cor <- pst_test_cor <- stnd_cor <- NA
pre_test_cor <- mapply(
function(x, y) {
sum(x == 1, na.rm = TRUE) -
sum(x == 0, na.rm = TRUE) / (1 / y - 1)
},
pre_test, lucky)
pst_test_cor <- mapply(
function(x, y) {
sum(x == 1, na.rm = TRUE) -
sum(x == 0, na.rm = TRUE) / (1 / y - 1)
},
pst_test, lucky)
stnd_cor <- pst_test_cor - pre_test_cor
# Names of the return vector
if ( is.null(item_names)) {
names(pre_test_cor) <- names(pst_test_cor) <- names(stnd_cor) <-
names(pre_test)
} else {
names(pre_test_cor) <- names(pst_test_cor) <- names(stnd_cor) <- item_names
}
pre <- pre_test_cor / nrow(pre_test)
pst <- pst_test_cor / nrow(pst_test)
learn <- stnd_cor / nrow(pre_test)
list(pre = pre, pst = pst, learn = learn)
}