Skip to content

Commit c419b2e

Browse files
vandenmanvandenman
authored
Merge pull request jasp-stats#4 from koenderks/development
2 parents 0d045f2 + 83f365a commit c419b2e

35 files changed

+797
-3631
lines changed

‎DESCRIPTION‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,11 +20,8 @@ Imports:
2020
jaspBase,
2121
jaspGraphs,
2222
jaspIrtStanModels,
23-
ltm,
2423
mirt,
25-
moments,
2624
parallel,
27-
reshape2,
2825
rstan (>= 2.18.1),
2926
truncdist
3027
Remotes:

‎NAMESPACE‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
import(jaspBase)
2-
export(classicalTestTheory)
32
export(itemResponseTheoryDichotomous)
43
export(itemResponseTheoryPolytomous)
54
export(itemResponseTheoryDichotomousBayesian)

‎R/classicaltesttheory.R‎

Lines changed: 0 additions & 345 deletions
This file was deleted.

‎R/itemresponsetheorycommon.R‎

Lines changed: 104 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -408,8 +408,8 @@
408408
state <- .irtIRTState(dataset, options, jaspResults)
409409
}
410410
plotdata <- state[["plotDataTestInformation"]]
411-
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(-6, 6), min.n = 4)
412-
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, subset(plotdata$y, plotdata$x >= -6 & plotdata$x <= 6)), min.n = 4)
411+
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(-3, 3), min.n = 4)
412+
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, subset(plotdata$y, plotdata$x >= -3 & plotdata$x <= 3)), min.n = 4)
413413
p <- ggplot2::ggplot(data = plotdata, mapping = ggplot2::aes(x = x, y = y, color = type)) +
414414
ggplot2::geom_line() +
415415
ggplot2::scale_x_continuous(name = "\u03B8", breaks = xBreaks, limits = range(xBreaks)) +
@@ -444,8 +444,8 @@
444444
}
445445
plotdata <- state[["plotDataItemInformation"]]
446446
plotdata <- subset(plotdata, plotdata$item %in% match(options[["plotItemInformationItems"]], options[["items"]]))
447-
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(-6, 6), min.n = 4)
448-
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, subset(plotdata$y, plotdata$x >= -6 & plotdata$x <= 6)), min.n = 4)
447+
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(-3, 3), min.n = 4)
448+
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, subset(plotdata$y, plotdata$x >= -3 & plotdata$x <= 3)), min.n = 4)
449449
colors <- colorspace::qualitative_hcl(length(options[["plotItemInformationItems"]]))
450450
p <- ggplot2::ggplot(data = plotdata, mapping = ggplot2::aes(x = x, y = y, col = factor(item))) +
451451
ggplot2::geom_line() +
@@ -482,7 +482,7 @@
482482
object <- createJaspContainer(title = gettext("Item Characteristic Curves"))
483483
}
484484
object$position <- position + 1
485-
object$dependOn(options = c(.irtCommonDeps(type = "irt"), "plotItemCharacteristicItems", "plotItemCharacteristicLabels"))
485+
object$dependOn(options = c(.irtCommonDeps(type = "irt"), "plotItemCharacteristicItems", "plotItemCharacteristicLabels", "plotItemCharacteristicFromX", "plotItemCharacteristicToX"))
486486
jaspResults[["plotItemCharacteristic"]] <- object
487487
if (!ready) {
488488
return()
@@ -492,7 +492,7 @@
492492
} else {
493493
state <- .irtIRTState(dataset, options, jaspResults)
494494
}
495-
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(-6, 6), min.n = 4)
495+
xBreaks <- jaspGraphs::getPrettyAxisBreaks(c(options[["plotItemCharacteristicFromX"]], options[["plotItemCharacteristicToX"]]), min.n = 4)
496496
if (options[["plotItemCharacteristicGroup"]]) {
497497
plotdata <- state[["plotDataItemCharacteristic"]]
498498
plotdata <- subset(plotdata, plotdata$item %in% match(options[["plotItemCharacteristicItems"]], options[["items"]]))
@@ -904,3 +904,101 @@
904904
result <- list(model = model, data = data, pars = pars)
905905
return(result)
906906
}
907+
908+
.irtDifAnalysisTable <- function(dataset, options, jaspResults, ready, position) {
909+
if (options[["explanatoryText"]] && options[["tableDifAnalysis"]]) {
910+
text <- createJaspHtml(gettext("<h3>Explanatory Text: Differential Item Functioning (DIF)</h3> The table below presents the results of a Differential Item Functioning (DIF) analysis. A DIF-analysis is conducted to assess whether specific items perform differently across groups while controlling for overall ability or trait levels. This ensures that the items are fair and not biased toward any particular group."))
911+
text$position <- position
912+
text$dependOn(options = c("explanatoryText", "tableDifAnalysis"))
913+
jaspResults[["tableDifAnalysisText"]] <- text
914+
}
915+
if (!is.null(jaspResults[["tableDifAnalysis"]]) || !options[["tableDifAnalysis"]]) {
916+
return()
917+
}
918+
tb <- createJaspTable(title = gettext("Differential Item Functioning (DIF)"))
919+
tb$position <- position + 1
920+
tb$addColumnInfo(name = "item", title = gettext("Item"), type = "string")
921+
tb$addColumnInfo(name = "aic", title = gettext("AIC"), type = "number")
922+
tb$addColumnInfo(name = "sabic", title = gettext("SABIC"), type = "number")
923+
tb$addColumnInfo(name = "hq", title = gettext("HQ"), type = "number")
924+
tb$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number")
925+
tb$addColumnInfo(name = "x2", title = gettext("X2"), type = "number")
926+
tb$addColumnInfo(name = "df", title = gettext("df"), type = "integer")
927+
tb$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue")
928+
tb$dependOn(options = c(.irtCommonDeps(type = "irt"), "tableDifAnalysis", "groupingVariable", "tableDifAnalysisDifficulty", "tableDifAnalysisDiscrimination", "tableDifAnalysisGuess", "tableDifAnalysisSlip"))
929+
tb$addFootnote(gettext("For each item, the null hypothesis specifies that there is no DIF between the groups."))
930+
tb$addFootnote(gettext("p-values are not adjusted for multiple comparisons."), colName = "p")
931+
if (length(options[["covariates"]]) > 0) {
932+
tb$addFootnote(gettext("The latent regressions present in the ungrouped model are not included in this analysis."))
933+
}
934+
jaspResults[["tableDifAnalysis"]] <- tb
935+
if (!ready || options[["groupingVariable"]] == "") {
936+
return()
937+
}
938+
state <- .irtIRTStateBayesian(dataset, options, jaspResults)
939+
parameters <- character()
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+
}
983+
}
984+
if (length(parameters) == 0) {
985+
tb$setError(gettext("DIf-analysis not possible: Select at least one parameter to test."))
986+
return()
987+
}
988+
result <- try({
989+
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"]]))
990+
dif <- mirt::DIF(fit, which.par = parameters)
991+
})
992+
if (jaspBase:::isTryError(result)) {
993+
tb$setError(jaspBase:::.extractErrorMessage(result))
994+
return()
995+
}
996+
tb[["item"]] <- options[["items"]]
997+
tb[["aic"]] <- dif[["AIC"]]
998+
tb[["sabic"]] <- dif[["SABIC"]]
999+
tb[["hq"]] <- dif[["HQ"]]
1000+
tb[["bic"]] <- dif[["BIC"]]
1001+
tb[["x2"]] <- dif[["X2"]]
1002+
tb[["df"]] <- dif[["df"]]
1003+
tb[["p"]] <- dif[["p"]]
1004+
}

‎R/itemresponstheorydichotomous.R‎

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -30,17 +30,20 @@ itemResponseTheoryDichotomous <- function(jaspResults, dataset, options, ...) {
3030
# Create the item fit statistics table
3131
.irtIRTItemFitStatisticsTable(dataset, options, jaspResults, ready, position = 5)
3232

33+
# Create the DIF-analysis table
34+
.irtDifAnalysisTable(dataset, options, jaspResults, ready, position = 7)
35+
3336
# Create the histogram of latent ability
34-
.irtIRTHistogram(dataset, options, jaspResults, ready, position = 7)
37+
.irtIRTHistogram(dataset, options, jaspResults, ready, position = 9)
3538

3639
# Create the test information function
37-
.irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 9)
40+
.irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 11)
3841

3942
# Create the item information curves
40-
.irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 11)
43+
.irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 13)
4144

4245
# Create the item information curves
43-
.irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 13)
46+
.irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 15)
4447
}
4548

4649
.irtIRTState <- function(dataset, options, jaspResults) {
@@ -55,12 +58,11 @@ itemResponseTheoryDichotomous <- function(jaspResults, dataset, options, ...) {
5558
} else {
5659
covariates <- NULL
5760
}
58-
# Model fit (DIF analysis possible using multipleGroup model)
5961
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"]]))
60-
if (options[["model"]] == "grsm") {
61-
thetaRange <- seq(-10, 10, by = 0.1)
62+
if (options[["model"]] %in% c("rsm", "grsm")) {
63+
thetaRange <- seq(-6, 6, by = 0.05)
6264
} else {
63-
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
6466
}
6567
latentScores <- as.numeric(mirt::fscores(fit))
6668
# Tables

‎R/itemresponstheorypolytomous.R‎

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -30,15 +30,18 @@ itemResponseTheoryPolytomous <- function(jaspResults, dataset, options, ...) {
3030
# Create the item fit statistics table
3131
.irtIRTItemFitStatisticsTable(dataset, options, jaspResults, ready, position = 5)
3232

33+
# Create the DIF-analysis table
34+
.irtDifAnalysisTable(dataset, options, jaspResults, ready, position = 7)
35+
3336
# Create the histogram of latent ability
34-
.irtIRTHistogram(dataset, options, jaspResults, ready, position = 7)
37+
.irtIRTHistogram(dataset, options, jaspResults, ready, position = 9)
3538

3639
# Create the test information function
37-
.irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 9)
40+
.irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 11)
3841

3942
# Create the item information curves
40-
.irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 11)
43+
.irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 13)
4144

4245
# Create the item information curves
43-
.irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 13)
46+
.irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 15)
4447
}

‎inst/Description.qml‎

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -33,11 +33,6 @@ Description
3333
title: qsTr("Polytomous Item Response Theory")
3434
func: "itemResponseTheoryPolytomous"
3535
}
36-
Analysis
37-
{
38-
title: qsTr("Classical Test Theory")
39-
func: "classicalTestTheory"
40-
}
4136

4237
GroupTitle
4338
{

‎inst/qml/classicalTestTheory.qml‎

Lines changed: 0 additions & 143 deletions
This file was deleted.

0 commit comments

Comments
 (0)