Add DIF for dichotomous items

koenderks · koenderks · commit 617067c3ebae · 2024-11-23T00:12:59.000+01:00
diff --git a/R/itemresponsetheorycommon.R b/R/itemresponsetheorycommon.R
@@ -904,3 +904,63 @@
   result <- list(model = model, data = data, pars = pars)
   return(result)
 }
+
+.irtDifAnalysisTable <- function(dataset, options, jaspResults, ready, position) {
+  if (options[["explanatoryText"]] && options[["tableDifAnalysis"]]) {
+    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."))
+    text$position <- position
+    text$dependOn(options = c("explanatoryText", "tableDifAnalysis"))
+    jaspResults[["tableDifAnalysisText"]] <- text
+  }
+  if (!is.null(jaspResults[["tableDifAnalysis"]]) || !options[["tableDifAnalysis"]]) {
+    return()
+  }
+  tb <- createJaspTable(title = gettext("Differential Item Functioning (DIF)"))
+  tb$position <- position + 1
+  tb$addColumnInfo(name = "item", title = gettext("Item"), type = "string")
+  tb$addColumnInfo(name = "aic", title = gettext("AIC"), type = "number")
+  tb$addColumnInfo(name = "sabic", title = gettext("SABIC"), type = "number")
+  tb$addColumnInfo(name = "hq", title = gettext("HQ"), type = "number")
+  tb$addColumnInfo(name = "bic", title = gettext("BIC"), type = "number")
+  tb$addColumnInfo(name = "x2", title = gettext("X2"), type = "number")
+  tb$addColumnInfo(name = "df", title = gettext("df"), type = "number")
+  tb$addColumnInfo(name = "p", title = gettext("p"), type = "pvalue")
+  tb$dependOn(options = c(.irtCommonDeps(type = "irt"), "tableDifAnalysis", "groupingVariable", "tableDifAnalysisDifficulty", "tableDifAnalysisDiscrimination", "tableDifAnalysisGuess", "tableDifAnalysisSlip"))
+  tb$addFootnote(gettext("For each item, the null hypothesis specifies that there is no DIF between the groups."))
+  tb$addFootnote(gettext("p-values are not adjusted for multiple comparisons."), colName = "p")
+  if (length(options[["covariates"]]) > 0) {
+    tb$addFootnote(gettext("The latent regressions present in the ungrouped model are not included in this analysis."))
+  }
+  jaspResults[["tableDifAnalysis"]] <- tb
+  if (!ready || options[["groupingVariable"]] == "") {
+    return()
+  }
+  parameters <- character()
+  if (options[["tableDifAnalysisDifficulty"]]) {
+    parameters <- c(parameters, "d")
+  }
+  if (options[["tableDifAnalysisDiscrimination"]] && options[["model"]] %in% c("2PL", "3PL", "4PL")) {
+    parameters <- c(parameters, "a1")
+  }
+  if (options[["tableDifAnalysisGuess"]] && options[["model"]] %in% c("3PL", "4PL")) {
+    parameters <- c(parameters, "d")
+  }
+  if (options[["tableDifAnalysisSlip"]] && options[["model"]] == "4PL") {
+    parameters <- c(parameters, "u")
+  }
+  if (length(parameters) == 0) {
+    tb$setError(gettext("DIf-analysis not possible: Select at least one parameter to test."))
+    return()
+  }
+  state <- .irtIRTStateBayesian(dataset, options, jaspResults)
+  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"]]))
+  dif <- mirt::DIF(fit, which.par = parameters)
+  tb[["item"]] <- options[["items"]]
+  tb[["aic"]] <- dif[["AIC"]]
+  tb[["sabic"]] <- dif[["SABIC"]]
+  tb[["hq"]] <- dif[["HQ"]]
+  tb[["bic"]] <- dif[["BIC"]]
+  tb[["x2"]] <- dif[["X2"]]
+  tb[["df"]] <- dif[["df"]]
+  tb[["p"]] <- dif[["p"]]
+}
diff --git a/R/itemresponstheorydichotomous.R b/R/itemresponstheorydichotomous.R
@@ -30,17 +30,20 @@ itemResponseTheoryDichotomous <- function(jaspResults, dataset, options, ...) {
   # Create the item fit statistics table
   .irtIRTItemFitStatisticsTable(dataset, options, jaspResults, ready, position = 5)
 
+  # Create the DIF-analysis table
+  .irtDifAnalysisTable(dataset, options, jaspResults, ready, position = 7)
+
   # Create the histogram of latent ability
-  .irtIRTHistogram(dataset, options, jaspResults, ready, position = 7)
+  .irtIRTHistogram(dataset, options, jaspResults, ready, position = 9)
 
   # Create the test information function
-  .irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 9)
+  .irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 11)
 
   # Create the item information curves
-  .irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 11)
+  .irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 13)
 
   # Create the item information curves
-  .irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 13)
+  .irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 15)
 }
 
 .irtIRTState <- function(dataset, options, jaspResults) {
@@ -55,7 +58,6 @@ itemResponseTheoryDichotomous <- function(jaspResults, dataset, options, ...) {
     } else {
       covariates <- NULL
     }
-    # Model fit (DIF analysis possible using multipleGroup model)
     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"]]))
     if (options[["model"]] == "grsm") {
       thetaRange <- seq(-10, 10, by = 0.1)
diff --git a/R/itemresponstheorypolytomous.R b/R/itemresponstheorypolytomous.R
@@ -30,15 +30,18 @@ itemResponseTheoryPolytomous <- function(jaspResults, dataset, options, ...) {
   # Create the item fit statistics table
   .irtIRTItemFitStatisticsTable(dataset, options, jaspResults, ready, position = 5)
 
+  # Create the DIF-analysis table
+  .irtDifAnalysisTable(dataset, options, jaspResults, ready, position = 7)
+
   # Create the histogram of latent ability
-  .irtIRTHistogram(dataset, options, jaspResults, ready, position = 7)
+  .irtIRTHistogram(dataset, options, jaspResults, ready, position = 9)
 
   # Create the test information function
-  .irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 9)
+  .irtIRTTestInfoCurve(dataset, options, jaspResults, ready, position = 11)
 
   # Create the item information curves
-  .irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 11)
+  .irtIRTItemInfoCurve(dataset, options, jaspResults, ready, position = 13)
 
   # Create the item information curves
-  .irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 13)
+  .irtIRTItemCharCurve(dataset, options, jaspResults, ready, position = 15)
 }
diff --git a/inst/qml/common/IrtOutput.qml b/inst/qml/common/IrtOutput.qml
@@ -25,6 +25,7 @@ Column
 {
 	property	bool	bayesian:		false
 	property	bool	dichotomous:	true
+	property	string	modeltype:		"Rasch"
 
 	spacing:				20 * preferencesModel.uiScale
 
@@ -73,6 +74,59 @@ Column
 			visible:		bayesian
 			info:			qsTr("Generate a table of all parameters that are estimated.")
 		}
+
+		CheckBox
+		{
+			name:			"tableDifAnalysis"
+			text:			qsTr("Differential Item Functioning (DIF)")
+			visible:		!bayesian && dichotomous
+			info:			qsTr("Generate a table showing the output of a likelihood-ratio test for Differential Item Functioning (DIF).")
+
+			DropDown
+			{
+				name: 					"groupingVariable"
+				label: 					qsTr("Grouping variable")
+				showVariableTypeIcon: 	true
+				addEmptyValue: 			true
+				source: 				[ { model: columnsModel, use: "type=nominal"} ]
+			}
+
+			Group
+			{
+				title:		qsTr("Parameters")
+
+				CheckBox
+				{
+					name:		"tableDifAnalysisDiscrimination"
+					text:		qsTr("Discrimination")
+					enabled:	dichotomous ? (modeltype == "2PL" || modeltype == "3PL" || modeltype == "4PL") : false // TODO
+					checked:	true
+				}
+
+				CheckBox
+				{
+					name:		"tableDifAnalysisDifficulty"
+					text:		qsTr("Difficulty")
+					checked:	true
+				}
+
+				CheckBox
+				{
+					name:		"tableDifAnalysisGuess"
+					text:		qsTr("Guessing")
+					enabled:	dichotomous ? (modeltype == "3PL" || modeltype == "4PL") : false // TODO
+					checked:	true
+				}
+
+				CheckBox
+				{
+					name:		"tableDifAnalysisSlip"
+					text:		qsTr("Slip")
+					enabled:	dichotomous ? modeltype == "4PL" : false // TODO
+					checked:	true
+				}
+			}
+		}
 	}
 
 	Group
diff --git a/inst/qml/common/bayesian/AdvancedOptions.qml b/inst/qml/common/bayesian/AdvancedOptions.qml
@@ -810,6 +810,7 @@ Section
 			min:					0.001
 			enabled:				modeltype != "Rasch" && modeltype != "rsm"
 			info:					qsTr("Specify the scaling constant for the model. Default is 1.702 (Camilli, 1994).")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 	}
 
@@ -825,6 +826,7 @@ Section
 			defaultValue:			2000
 			min:					500
 			info:					qsTr("Specify the number of samples to be collected by each chain in the MCMC process after the burn-in phase. A larger number improves the precision of parameter estimates.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 
 		IntegerField
@@ -835,6 +837,7 @@ Section
 			min:					200
 			max:					samples.value - 300
 			info:					qsTr("Specify the number of warmup iterations in each chain of the MCMC process. These iterations are discarded to ensure that the chain reaches the target distribution.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 
 		IntegerField
@@ -844,6 +847,7 @@ Section
 			defaultValue:			4
 			min:					1
 			info:					qsTr("Specify the number of independent MCMC chains to run in parallel. Running multiple chains helps assess convergence and improves results.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 	}
 
@@ -859,6 +863,7 @@ Section
 			min:					-999999
 			max:					999999
 			info:					qsTr("Specify the random seed for reproducibility.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 
 		DoubleField
@@ -870,6 +875,7 @@ Section
 			max:					0.999
 			decimals:				3
 			info:					qsTr("Specify is the target average proposal acceptance probability during Stan's adaptation period.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 
 		IntegerField
@@ -879,6 +885,7 @@ Section
 			defaultValue:			10
 			min:					5
 			info:					qsTr("Specify the max value, in exponents of 2, of what the binary tree size in the NUTS algorithm should have.")
+			fieldWidth:				60 * preferencesModel.uiScale
 		}
 	}
 }
diff --git a/inst/qml/common/classical/AdvancedOptions.qml b/inst/qml/common/classical/AdvancedOptions.qml
@@ -27,13 +27,14 @@ Section
 
 	DoubleField
 	{
-		name:					"priorScaling"
-		text:					qsTr("Scaling constant")
-		defaultValue:			1.702
-		decimals:				3
-		min:					0.001
-		enabled:				false
-		info:					qsTr("Specify the scaling constant for the model. Default is 1.702 (Camilli, 1994).")
+		name:				"priorScaling"
+		text:				qsTr("Scaling constant")
+		defaultValue:		1.702
+		decimals:			3
+		min:				0.001
+		enabled:			false
+		info:				qsTr("Specify the scaling constant for the model. Default is 1.702 (Camilli, 1994).")
+		fieldWidth:			60 * preferencesModel.uiScale
 	}
 
 	Group
@@ -42,12 +43,13 @@ Section
 
 		IntegerField
 		{
-			name:				"seed"
-			text:				qsTr("Seed")
-			defaultValue:		Math.floor(Math.random() * 1000000) // Init with random integer in [1,...,999999]
-			min:				-999999
-			max:				999999
-			info:				qsTr("Specify the random seed for reproducibility.")
+			name:			"seed"
+			text:			qsTr("Seed")
+			defaultValue:	Math.floor(Math.random() * 1000000) // Init with random integer in [1,...,999999]
+			min:			-999999
+			max:			999999
+			info:			qsTr("Specify the random seed for reproducibility.")
+			fieldWidth:		60 * preferencesModel.uiScale
 		}
 
 		IntegerField
@@ -57,6 +59,7 @@ Section
 			defaultValue:	2000
 			min:			500
 			info:			qsTr("Specify the maximum number of iterations of the EM algoritm.")
+			fieldWidth:			60 * preferencesModel.uiScale
 		}
 
 		DoubleField
@@ -67,6 +70,7 @@ Section
 			decimals:		6
 			min:			0.000001
 			info:			qsTr("Specify the tolerance for the EM algoritm.")
+			fieldWidth:		60 * preferencesModel.uiScale
 		}
 	}
 }
diff --git a/inst/qml/itemResponseTheoryDichotomous.qml b/inst/qml/itemResponseTheoryDichotomous.qml
@@ -32,8 +32,8 @@ Form
 	CheckBox { name: "bayesian"; checked: false; visible: false } // Invisible option
 	CheckBox { name: "dichotomous"; checked: true; visible: false } // Invisible option
 	DICH.VariablesListDichotomous { }
-	DICH.IrtInputDichotomous { }
-	COMMON.IrtOutput { bayesian: false; dichotomous: true }
+	DICH.IrtInputDichotomous { id: model }
+	COMMON.IrtOutput { bayesian: false; dichotomous: true; modeltype: model.value }
 	COMMON.ItemInfoCurves { }
 	COMMON.ItemCharCurves { dichotomous: true }
 	CLASSICAL.AdvancedOptions { }
diff --git a/inst/qml/itemResponseTheoryDichotomousBayesian.qml b/inst/qml/itemResponseTheoryDichotomousBayesian.qml
@@ -33,7 +33,7 @@ Form
 	CheckBox { name: "dichotomous"; checked: true; visible: false } // Invisible option
 	DICH.VariablesListDichotomous { id: vars }
 	DICH.IrtInputDichotomous { id: model }
-	COMMON.IrtOutput { bayesian: true; dichotomous: true }
+	COMMON.IrtOutput { bayesian: true; dichotomous: true; modeltype: model.value }
 	COMMON.ItemInfoCurves { }
 	COMMON.ItemCharCurves { dichotomous: true }
 	BAYES.AdvancedOptions { ncovs: vars.ncovs; modeltype: model.value }
diff --git a/inst/qml/itemResponseTheoryPolytomous.qml b/inst/qml/itemResponseTheoryPolytomous.qml
@@ -32,8 +32,8 @@ Form
 	CheckBox { name: "bayesian"; checked: false; visible: false } // Invisible option
 	CheckBox { name: "dichotomous"; checked: false; visible: false } // Invisible option
 	POLY.VariablesListPolytomous { }
-	POLY.IrtInputPolytomous { }
-	COMMON.IrtOutput { bayesian: false; dichotomous: false }
+	POLY.IrtInputPolytomous { id: model }
+	COMMON.IrtOutput { bayesian: false; dichotomous: false; modeltype: model.value }
 	COMMON.ItemInfoCurves { }
 	COMMON.ItemCharCurves { dichotomous: false }
 	CLASSICAL.AdvancedOptions { }
diff --git a/inst/qml/itemResponseTheoryPolytomousBayesian.qml b/inst/qml/itemResponseTheoryPolytomousBayesian.qml
@@ -33,7 +33,7 @@ Form
 	CheckBox { name: "dichotomous"; checked: false; visible: false } // Invisible option
 	POLY.VariablesListPolytomous { id: vars }
 	POLY.IrtInputPolytomous { id: model }
-	COMMON.IrtOutput { bayesian: true; dichotomous: false }
+	COMMON.IrtOutput { bayesian: true; dichotomous: false; modeltype: model.value }
 	COMMON.ItemInfoCurves { }
 	COMMON.ItemCharCurves { dichotomous: false }
 	BAYES.AdvancedOptions { ncovs: vars.ncovs; modeltype: model.value }

Original file line number	Diff line number	Diff line change
`@@ -810,6 +810,7 @@ Section`
`810`	`810`	`min: 0.001`
`811`	`811`	`enabled: modeltype != "Rasch" && modeltype != "rsm"`
`812`	`812`	`info: qsTr("Specify the scaling constant for the model. Default is 1.702 (Camilli, 1994).")`
	`813`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`813`	`814`	`}`
`814`	`815`	`}`
`815`	`816`
`@@ -825,6 +826,7 @@ Section`
`825`	`826`	`defaultValue: 2000`
`826`	`827`	`min: 500`
`827`	`828`	`info: qsTr("Specify the number of samples to be collected by each chain in the MCMC process after the burn-in phase. A larger number improves the precision of parameter estimates.")`
	`829`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`828`	`830`	`}`
`829`	`831`
`830`	`832`	`IntegerField`
`@@ -835,6 +837,7 @@ Section`
`835`	`837`	`min: 200`
`836`	`838`	`max: samples.value - 300`
`837`	`839`	`info: qsTr("Specify the number of warmup iterations in each chain of the MCMC process. These iterations are discarded to ensure that the chain reaches the target distribution.")`
	`840`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`838`	`841`	`}`
`839`	`842`
`840`	`843`	`IntegerField`
`@@ -844,6 +847,7 @@ Section`
`844`	`847`	`defaultValue: 4`
`845`	`848`	`min: 1`
`846`	`849`	`info: qsTr("Specify the number of independent MCMC chains to run in parallel. Running multiple chains helps assess convergence and improves results.")`
	`850`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`847`	`851`	`}`
`848`	`852`	`}`
`849`	`853`
`@@ -859,6 +863,7 @@ Section`
`859`	`863`	`min: -999999`
`860`	`864`	`max: 999999`
`861`	`865`	`info: qsTr("Specify the random seed for reproducibility.")`
	`866`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`862`	`867`	`}`
`863`	`868`
`864`	`869`	`DoubleField`
`@@ -870,6 +875,7 @@ Section`
`870`	`875`	`max: 0.999`
`871`	`876`	`decimals: 3`
`872`	`877`	`info: qsTr("Specify is the target average proposal acceptance probability during Stan's adaptation period.")`
	`878`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`873`	`879`	`}`
`874`	`880`
`875`	`881`	`IntegerField`
`@@ -879,6 +885,7 @@ Section`
`879`	`885`	`defaultValue: 10`
`880`	`886`	`min: 5`
`881`	`887`	`info: qsTr("Specify the max value, in exponents of 2, of what the binary tree size in the NUTS algorithm should have.")`
	`888`	`+ fieldWidth: 60 * preferencesModel.uiScale`
`882`	`889`	`}`
`883`	`890`	`}`
`884`	`891`	`}`