Skip to content

Commit a4e3bcd

Browse files
committed
DIF for polytomous items
1 parent 617067c commit a4e3bcd

File tree

3 files changed

+66
-21
lines changed

3 files changed

+66
-21
lines changed

R/itemresponsetheorycommon.R

Lines changed: 47 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -923,7 +923,7 @@
923923
tb$addColumnInfo(name = "hq", title = gettext("HQ"), type = "number")
924924
tb$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number")
925925
tb$addColumnInfo(name = "x2", title = gettext("X2"), type = "number")
926-
tb$addColumnInfo(name = "df", title = gettext("df"), type = "number")
926+
tb$addColumnInfo(name = "df", title = gettext("df"), type = "integer")
927927
tb$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue")
928928
tb$dependOn(options = c(.irtCommonDeps(type = "irt"), "tableDifAnalysis", "groupingVariable", "tableDifAnalysisDifficulty", "tableDifAnalysisDiscrimination", "tableDifAnalysisGuess", "tableDifAnalysisSlip"))
929929
tb$addFootnote(gettext("For each item, the null hypothesis specifies that there is no DIF between the groups."))
@@ -935,25 +935,59 @@
935935
if (!ready || options[["groupingVariable"]] == "") {
936936
return()
937937
}
938+
state <- .irtIRTStateBayesian(dataset, options, jaspResults)
938939
parameters <- character()
939-
if (options[["tableDifAnalysisDifficulty"]]) {
940-
parameters <- c(parameters, "d")
941-
}
942-
if (options[["tableDifAnalysisDiscrimination"]] && options[["model"]] %in% c("2PL", "3PL", "4PL")) {
943-
parameters <- c(parameters, "a1")
944-
}
945-
if (options[["tableDifAnalysisGuess"]] && options[["model"]] %in% c("3PL", "4PL")) {
946-
parameters <- c(parameters, "d")
947-
}
948-
if (options[["tableDifAnalysisSlip"]] && options[["model"]] == "4PL") {
949-
parameters <- c(parameters, "u")
940+
if (options[["dichotomous"]]) {
941+
if (options[["tableDifAnalysisDifficulty"]]) {
942+
parameters <- c(parameters, "d")
943+
}
944+
if (options[["tableDifAnalysisDiscrimination"]] && options[["model"]] %in% c("2PL", "3PL", "4PL")) {
945+
parameters <- c(parameters, "a1")
946+
}
947+
if (options[["tableDifAnalysisGuess"]] && options[["model"]] %in% c("3PL", "4PL")) {
948+
parameters <- c(parameters, "g")
949+
}
950+
if (options[["tableDifAnalysisSlip"]] && options[["model"]] == "4PL") {
951+
parameters <- c(parameters, "u")
952+
}
953+
} else {
954+
all_parameters <- colnames(state[["coefficients"]])
955+
if (options[["tableDifAnalysisDifficulty"]]) {
956+
if (options[["model"]] %in% c("rsm", "grsm")) {
957+
parameters <- c(parameters, "c")
958+
} else if (options[["model"]] == "nominal") {
959+
colnames_diff <- colnames(state[["coefficients"]])[grep("c", colnames(state[["coefficients"]]))]
960+
colnames_diff <- gsub("c", "", colnames_diff)
961+
colnames_diff <- paste0("d", as.numeric(colnames_diff) - 1)
962+
parameters <- c(parameters, colnames_diff)
963+
} else {
964+
colnames_diff <- colnames(state[["coefficients"]])[grep("b", colnames(state[["coefficients"]]))]
965+
colnames_diff <- gsub("b", "d", colnames_diff)
966+
parameters <- c(parameters, colnames_diff)
967+
}
968+
}
969+
if (options[["tableDifAnalysisDiscrimination"]] && options[["model"]] %in% c("gpcm", "grsm", "graded", "nominal")) {
970+
if (options[["model"]] == "nominal") {
971+
colnames_disc <- colnames(state[["coefficients"]])[grep("a", colnames(state[["coefficients"]]))]
972+
colnames_disc <- gsub("a", "", colnames_disc)
973+
colnames_disc <- paste0("ak", as.numeric(colnames_disc) - 1)
974+
parameters <- c(parameters, colnames_disc)
975+
} else {
976+
parameters <- c(parameters, "a1")
977+
}
978+
}
979+
if (options[["tableDifAnalysisThreshold"]] && options[["model"]] %in% c("rsm", "grsm")) {
980+
colnames_tresh <- colnames(state[["coefficients"]])[grep("b", colnames(state[["coefficients"]]))]
981+
parameters <- c(parameters, colnames_tresh)
982+
}
950983
}
951984
if (length(parameters) == 0) {
952985
tb$setError(gettext("DIf-analysis not possible: Select at least one parameter to test."))
953986
return()
954987
}
955-
state <- .irtIRTStateBayesian(dataset, options, jaspResults)
956988
fit <- mirt::multipleGroup(data = state[["items"]], model = 1, itemtype = options[["model"]], group = dataset[[options[["groupingVariable"]]]], SE = FALSE, verbose = FALSE, TOL = options[["emTolerance"]], technical = list(NCYCLES = options[["emIterations"]], set.seed = options[["seed"]]))
989+
print(unique(unlist(lapply(mirt::coef(fit)[[1]][seq_len(length(options[["items"]]))], colnames))))
990+
print(parameters)
957991
dif <- mirt::DIF(fit, which.par = parameters)
958992
tb[["item"]] <- options[["items"]]
959993
tb[["aic"]] <- dif[["AIC"]]

R/itemresponstheorydichotomous.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -59,10 +59,10 @@ itemResponseTheoryDichotomous <- function(jaspResults, dataset, options, ...) {
5959
covariates <- NULL
6060
}
6161
fit <- mirt::mirt(data = items, model = 1, itemtype = options[["model"]], covdata = covariates, formula = ~., SE = FALSE, verbose = FALSE, TOL = options[["emTolerance"]], technical = list(NCYCLES = options[["emIterations"]], set.seed = options[["seed"]]))
62-
if (options[["model"]] == "grsm") {
63-
thetaRange <- seq(-10, 10, by = 0.1)
62+
if (options[["model"]] %in% c("rsm", "grsm")) {
63+
thetaRange <- seq(-6, 6, by = 0.05)
6464
} else {
65-
thetaRange <- seq(-25, 25, by = 0.01) # Takes too long with grsm
65+
thetaRange <- seq(-25, 25, by = 0.01) # Takes too long with grsm or rsm
6666
}
6767
latentScores <- as.numeric(mirt::fscores(fit))
6868
# Tables

inst/qml/common/IrtOutput.qml

Lines changed: 16 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -78,8 +78,8 @@ Column
7878
CheckBox
7979
{
8080
name: "tableDifAnalysis"
81-
text: qsTr("Differential Item Functioning (DIF)")
82-
visible: !bayesian && dichotomous
81+
text: qsTr("Differential item functioning (DIF)")
82+
visible: !bayesian
8383
info: qsTr("Generate a table showing the output of a likelihood-ratio test for Differential Item Functioning (DIF).")
8484

8585
DropDown
@@ -99,7 +99,7 @@ Column
9999
{
100100
name: "tableDifAnalysisDiscrimination"
101101
text: qsTr("Discrimination")
102-
enabled: dichotomous ? (modeltype == "2PL" || modeltype == "3PL" || modeltype == "4PL") : false // TODO
102+
enabled: dichotomous ? (modeltype == "2PL" || modeltype == "3PL" || modeltype == "4PL") : (modeltype == "gpcm" || modeltype == "grsm" || modeltype == "graded" || modeltype == "nominal") // TODO
103103
checked: true
104104
}
105105

@@ -114,15 +114,26 @@ Column
114114
{
115115
name: "tableDifAnalysisGuess"
116116
text: qsTr("Guessing")
117-
enabled: dichotomous ? (modeltype == "3PL" || modeltype == "4PL") : false // TODO
117+
enabled: dichotomous ? (modeltype == "3PL" || modeltype == "4PL") : false
118+
visible: dichotomous
118119
checked: true
119120
}
120121

121122
CheckBox
122123
{
123124
name: "tableDifAnalysisSlip"
124125
text: qsTr("Slip")
125-
enabled: dichotomous ? modeltype == "4PL" : false // TODO
126+
enabled: dichotomous ? modeltype == "4PL" : false
127+
visible: dichotomous
128+
checked: true
129+
}
130+
131+
CheckBox
132+
{
133+
name: "tableDifAnalysisThreshold"
134+
text: qsTr("Threshold")
135+
enabled: dichotomous ? modeltype == "4PL" : (modeltype == "rsm" || modeltype == "grsm")
136+
visible: !dichotomous
126137
checked: true
127138
}
128139
}

0 commit comments

Comments
 (0)