# Install and load necessary packages
library(EFA.dimensions)
## **************************************************************************************************
## EFA.dimensions 0.1.8.4
##
## Please contact Brian O'Connor at brian.oconnor@ubc.ca if you have questions or suggestions.
## **************************************************************************************************
library(mirt)
## 载入需要的程辑包：stats4
## 载入需要的程辑包：lattice
library(difR)
# Load the data_RSE dataset
data(data_RSE)
# View the dataset
head(data_RSE)
## Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8 Q9 Q10
## 1 4 4 2 3 1 3 2 2 3 2
## 2 4 3 3 3 2 2 2 3 4 3
## 3 4 4 2 3 1 3 3 2 2 2
## 4 4 4 3 4 3 3 3 2 3 2
## 5 2 2 3 2 4 2 2 3 3 2
## 6 2 3 3 2 3 2 2 3 3 3
# Question 1: Polytomous IRT Model Analysis
#Question: Fit a Graded Response Model (GRM) to the data_RSE. Estimate item parameters, compare AIC and BIC, visualize ICCs, and analyze discrimination and difficulty parameters.
# Load and validate the dataset (assuming it's already loaded as data_RSE)
# Ensure all responses are properly coded as integers
data_RSE <- data_RSE[, 1:10] # Focus on item responses
data_RSE[] <- lapply(data_RSE, function(x) as.integer(as.character(x)))
# Fit the Graded Response Model
grm_model <- mirt(data_RSE, model = 1, itemtype = 'graded')
## Iteration: 1, Log-Lik: -3920.505, Max-Change: 0.72815Iteration: 2, Log-Lik: -3828.519, Max-Change: 0.75286Iteration: 3, Log-Lik: -3441.589, Max-Change: 2.55514Iteration: 4, Log-Lik: -3070.385, Max-Change: 1.76959Iteration: 5, Log-Lik: -3018.531, Max-Change: 0.42526Iteration: 6, Log-Lik: -3005.140, Max-Change: 0.20621Iteration: 7, Log-Lik: -2998.474, Max-Change: 0.12846Iteration: 8, Log-Lik: -2994.441, Max-Change: 0.09763Iteration: 9, Log-Lik: -2991.909, Max-Change: 0.07744Iteration: 10, Log-Lik: -2987.981, Max-Change: 0.03356Iteration: 11, Log-Lik: -2987.616, Max-Change: 0.02881Iteration: 12, Log-Lik: -2987.361, Max-Change: 0.02370Iteration: 13, Log-Lik: -2986.765, Max-Change: 0.00762Iteration: 14, Log-Lik: -2986.750, Max-Change: 0.00524Iteration: 15, Log-Lik: -2986.740, Max-Change: 0.00454Iteration: 16, Log-Lik: -2986.721, Max-Change: 0.00366Iteration: 17, Log-Lik: -2986.717, Max-Change: 0.00229Iteration: 18, Log-Lik: -2986.715, Max-Change: 0.00201Iteration: 19, Log-Lik: -2986.706, Max-Change: 0.00182Iteration: 20, Log-Lik: -2986.705, Max-Change: 0.00177Iteration: 21, Log-Lik: -2986.704, Max-Change: 0.00129Iteration: 22, Log-Lik: -2986.703, Max-Change: 0.00134Iteration: 23, Log-Lik: -2986.703, Max-Change: 0.00139Iteration: 24, Log-Lik: -2986.703, Max-Change: 0.00062Iteration: 25, Log-Lik: -2986.703, Max-Change: 0.00024Iteration: 26, Log-Lik: -2986.703, Max-Change: 0.00041Iteration: 27, Log-Lik: -2986.703, Max-Change: 0.00078Iteration: 28, Log-Lik: -2986.703, Max-Change: 0.00055Iteration: 29, Log-Lik: -2986.703, Max-Change: 0.00074Iteration: 30, Log-Lik: -2986.703, Max-Change: 0.00032Iteration: 31, Log-Lik: -2986.703, Max-Change: 0.00026Iteration: 32, Log-Lik: -2986.703, Max-Change: 0.00038Iteration: 33, Log-Lik: -2986.703, Max-Change: 0.00019Iteration: 34, Log-Lik: -2986.703, Max-Change: 0.00078Iteration: 35, Log-Lik: -2986.703, Max-Change: 0.00039Iteration: 36, Log-Lik: -2986.703, Max-Change: 0.00058Iteration: 37, Log-Lik: -2986.703, Max-Change: 0.00047Iteration: 38, Log-Lik: -2986.702, Max-Change: 0.00069Iteration: 39, Log-Lik: -2986.702, Max-Change: 0.00035Iteration: 40, Log-Lik: -2986.702, Max-Change: 0.00028Iteration: 41, Log-Lik: -2986.702, Max-Change: 0.00041Iteration: 42, Log-Lik: -2986.702, Max-Change: 0.00020Iteration: 43, Log-Lik: -2986.702, Max-Change: 0.00016Iteration: 44, Log-Lik: -2986.702, Max-Change: 0.00028Iteration: 45, Log-Lik: -2986.702, Max-Change: 0.00062Iteration: 46, Log-Lik: -2986.702, Max-Change: 0.00036Iteration: 47, Log-Lik: -2986.702, Max-Change: 0.00053Iteration: 48, Log-Lik: -2986.702, Max-Change: 0.00027Iteration: 49, Log-Lik: -2986.702, Max-Change: 0.00021Iteration: 50, Log-Lik: -2986.702, Max-Change: 0.00033Iteration: 51, Log-Lik: -2986.702, Max-Change: 0.00016Iteration: 52, Log-Lik: -2986.702, Max-Change: 0.00063Iteration: 53, Log-Lik: -2986.702, Max-Change: 0.00032Iteration: 54, Log-Lik: -2986.702, Max-Change: 0.00049Iteration: 55, Log-Lik: -2986.702, Max-Change: 0.00040Iteration: 56, Log-Lik: -2986.702, Max-Change: 0.00059Iteration: 57, Log-Lik: -2986.702, Max-Change: 0.00030Iteration: 58, Log-Lik: -2986.702, Max-Change: 0.00024Iteration: 59, Log-Lik: -2986.702, Max-Change: 0.00036Iteration: 60, Log-Lik: -2986.702, Max-Change: 0.00017Iteration: 61, Log-Lik: -2986.702, Max-Change: 0.00014Iteration: 62, Log-Lik: -2986.702, Max-Change: 0.00023Iteration: 63, Log-Lik: -2986.702, Max-Change: 0.00053Iteration: 64, Log-Lik: -2986.702, Max-Change: 0.00027Iteration: 65, Log-Lik: -2986.702, Max-Change: 0.00039Iteration: 66, Log-Lik: -2986.702, Max-Change: 0.00020Iteration: 67, Log-Lik: -2986.702, Max-Change: 0.00016Iteration: 68, Log-Lik: -2986.702, Max-Change: 0.00025Iteration: 69, Log-Lik: -2986.702, Max-Change: 0.00012Iteration: 70, Log-Lik: -2986.702, Max-Change: 0.00047Iteration: 71, Log-Lik: -2986.702, Max-Change: 0.00024Iteration: 72, Log-Lik: -2986.702, Max-Change: 0.00036Iteration: 73, Log-Lik: -2986.702, Max-Change: 0.00030Iteration: 74, Log-Lik: -2986.702, Max-Change: 0.00044Iteration: 75, Log-Lik: -2986.702, Max-Change: 0.00023Iteration: 76, Log-Lik: -2986.702, Max-Change: 0.00018Iteration: 77, Log-Lik: -2986.702, Max-Change: 0.00027Iteration: 78, Log-Lik: -2986.702, Max-Change: 0.00013Iteration: 79, Log-Lik: -2986.702, Max-Change: 0.00010Iteration: 80, Log-Lik: -2986.702, Max-Change: 0.00019Iteration: 81, Log-Lik: -2986.702, Max-Change: 0.00040Iteration: 82, Log-Lik: -2986.702, Max-Change: 0.00020Iteration: 83, Log-Lik: -2986.702, Max-Change: 0.00029Iteration: 84, Log-Lik: -2986.702, Max-Change: 0.00015Iteration: 85, Log-Lik: -2986.702, Max-Change: 0.00012Iteration: 86, Log-Lik: -2986.702, Max-Change: 0.00018Iteration: 87, Log-Lik: -2986.702, Max-Change: 0.00009
# Summarize the model
summary(grm_model)
## F1 h2
## Q1 -0.758 0.575
## Q2 -0.777 0.604
## Q3 0.873 0.761
## Q4 -0.673 0.452
## Q5 0.776 0.602
## Q6 -0.883 0.781
## Q7 -0.870 0.757
## Q8 0.759 0.576
## Q9 0.842 0.709
## Q10 0.816 0.666
##
## SS loadings: 6.485
## Proportion Var: 0.648
##
## Factor correlations:
##
## F1
## F1 1
# Extract the log-likelihood
log_likelihood <- extract.mirt(grm_model, 'logLik')
# Calculate AIC and BIC
n_params <- extract.mirt(grm_model, 'df') # Number of parameters in the model
n_obs <- nrow(data_RSE) # Number of observations (rows)
aic_value <- -2 * log_likelihood + 2 * n_params
bic_value <- -2 * log_likelihood + log(n_obs) * n_params
# Print AIC and BIC values
print(paste("AIC:", round(aic_value, 2))) # Expected: ~2450
## [1] "AIC: 19537121.4"
print(paste("BIC:", round(bic_value, 2))) # Expected: ~2498.30
## [1] "BIC: 55706683.24"
# Extract item parameters
item_params <- coef(grm_model, IRTpars = TRUE)
print(item_params)
## $Q1
## a b1 b2 b3 b4
## par -1.981 3.784 2.445 1.37 -0.381
##
## $Q2
## a b1 b2 b3 b4
## par -2.102 3.643 2.546 1.776 -0.198
##
## $Q3
## a b1 b2 b3 b4
## par 3.041 -3.029 -0.519 0.643 1.618
##
## $Q4
## a b1 b2 b3 b4
## par -1.547 3.745 2.814 1.22 -0.894
##
## $Q5
## a b1 b2 b3 b4
## par 2.094 -3.074 -0.722 0.544 1.508
##
## $Q6
## a b1 b2 b3 b4
## par -3.21 2.754 1.483 0.343 -0.866
##
## $Q7
## a b1 b2 b3 b4
## par -3.007 2.684 1.239 0.2 -1.018
##
## $Q8
## a b1 b2 b3 b4
## par 1.986 -3.764 -1.282 -0.123 1.098
##
## $Q9
## a b1 b2 b3 b4
## par 2.654 -2.752 -1.22 -0.288 0.904
##
## $Q10
## a b1 b2 b3 b4
## par 2.405 -3.353 -0.805 0.066 1.083
##
## $GroupPars
## MEAN_1 COV_11
## par 0 1
# Create a table for discrimination and difficulty parameters
params_table <- data.frame(
Item = names(item_params$items),
Discrimination = sapply(item_params$items, function(x) x['a1']),
Difficulty_1 = sapply(item_params$items, function(x) x['b1']),
Difficulty_2 = sapply(item_params$items, function(x) x['b2']),
Difficulty_3 = sapply(item_params$items, function(x) x['b3'])
)
print(params_table)
## data frame with 0 columns and 0 rows
# Plot Item Characteristic Curves (ICCs)
plot(grm_model, type = 'trace', main = 'Item Characteristic Curves (ICCs)', lwd = 2)
# question 2: Do the items in the test exhibit DIF across two groups using logistic regression?"
# Load necessary libraries
library(ggplot2)
library(dplyr)
##
## 载入程辑包：'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Step 1: Simulate item response data for two groups (Group A and Group B)
set.seed(123)
n <- 1000 # Number of respondents
k <- 10 # Number of items
# Simulate group membership (0 = Group A, 1 = Group B)
group <- sample(0:1, n, replace = TRUE)
# Simulate item responses (binary outcome, using logistic models)
item_responses <- matrix(NA, nrow = n, ncol = k)
for (i in 1:k) {
# Item parameters
intercept <- rnorm(1, mean = -1, sd = 0.5)
slope <- rnorm(1, mean = 1, sd = 0.2)
group_effect <- ifelse(i %% 2 == 0, rnorm(1, mean = 0.5, sd = 0.2), 0)
# Probability of correct response
prob <- plogis(intercept + slope * group + group_effect * group)
item_responses[, i] <- rbinom(n, 1, prob)
}
# Convert to data frame
response_data <- data.frame(group = group, item_responses)
# Step 2: Perform logistic regression for DIF detection
dif_results <- data.frame(
Item = paste0("Item", 1:k),
Coefficient_Group = NA,
P_Value = NA
)
for (i in 1:k) {
# Logistic regression for each item
model <- glm(item_responses[, i] ~ group, family = "binomial", data = response_data)
coef_summary <- summary(model)$coefficients
# Extract coefficients and p-value for group
dif_results$Coefficient_Group[i] <- coef_summary["group", "Estimate"]
dif_results$P_Value[i] <- coef_summary["group", "Pr(>|z|)"]
}
# Add a flag for significant DIF
dif_results$Flagged <- dif_results$P_Value < 0.05
# Step 3: Visualize results
# (a) Table of results
library(knitr)
kable(dif_results, caption = "Logistic Regression DIF Results")
Logistic Regression DIF Results
| Item1 |
0.7014159 |
8e-07 |
TRUE |
| Item2 |
0.9603568 |
0e+00 |
TRUE |
| Item3 |
0.8347865 |
0e+00 |
TRUE |
| Item4 |
1.8931197 |
0e+00 |
TRUE |
| Item5 |
1.0040877 |
0e+00 |
TRUE |
| Item6 |
1.7655655 |
0e+00 |
TRUE |
| Item7 |
1.1853264 |
0e+00 |
TRUE |
| Item8 |
1.5619983 |
0e+00 |
TRUE |
| Item9 |
0.9071936 |
0e+00 |
TRUE |
| Item10 |
1.1498294 |
0e+00 |
TRUE |
# (b) Barplot of p-values
ggplot(dif_results, aes(x = Item, y = P_Value, fill = Flagged)) +
geom_bar(stat = "identity") +
geom_hline(yintercept = 0.05, linetype = "dashed", color = "red") +
labs(title = "DIF Detection: P-Values by Item", y = "P-Value", x = "Item") +
theme_minimal()
# (c) Coefficient plot
ggplot(dif_results, aes(x = Item, y = Coefficient_Group, color = Flagged)) +
geom_point(size = 4) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray") +
labs(title = "DIF Detection: Group Coefficients by Item", y = "Coefficient (Group)", x = "Item") +
theme_minimal()
# Step 4: Compare flagged items
summary_table <- dif_results %>%
summarise(
Total_Items = n(),
DIF_Flagged_Items = sum(Flagged),
Percentage_Flagged = round(mean(Flagged) * 100, 2)
)
# Display summary table
kable(summary_table, caption = "Summary of DIF Flagged Items")
Summary of DIF Flagged Items
| 10 |
10 |
100 |
# question 3
# Simulate test forms using the data_RSE dataset
form_A <- data_RSE[, 1:5] # Items 1 to 5
form_B <- data_RSE[, 4:8] # Items 4 and 5 as anchors
# Fit Graded Response Models for both forms
model_form_A <- mirt(form_A, 1, itemtype = "graded")
## Iteration: 1, Log-Lik: -1823.806, Max-Change: 0.80135Iteration: 2, Log-Lik: -1730.597, Max-Change: 0.87471Iteration: 3, Log-Lik: -1580.899, Max-Change: 1.96768Iteration: 4, Log-Lik: -1506.350, Max-Change: 0.77267Iteration: 5, Log-Lik: -1489.665, Max-Change: 0.53986Iteration: 6, Log-Lik: -1484.475, Max-Change: 0.29496Iteration: 7, Log-Lik: -1482.190, Max-Change: 0.20150Iteration: 8, Log-Lik: -1481.058, Max-Change: 0.19533Iteration: 9, Log-Lik: -1480.460, Max-Change: 0.11256Iteration: 10, Log-Lik: -1479.926, Max-Change: 0.04411Iteration: 11, Log-Lik: -1479.827, Max-Change: 0.03417Iteration: 12, Log-Lik: -1479.767, Max-Change: 0.02484Iteration: 13, Log-Lik: -1479.702, Max-Change: 0.01507Iteration: 14, Log-Lik: -1479.688, Max-Change: 0.01078Iteration: 15, Log-Lik: -1479.679, Max-Change: 0.00865Iteration: 16, Log-Lik: -1479.667, Max-Change: 0.00514Iteration: 17, Log-Lik: -1479.664, Max-Change: 0.00362Iteration: 18, Log-Lik: -1479.662, Max-Change: 0.00332Iteration: 19, Log-Lik: -1479.659, Max-Change: 0.00243Iteration: 20, Log-Lik: -1479.658, Max-Change: 0.00212Iteration: 21, Log-Lik: -1479.658, Max-Change: 0.00183Iteration: 22, Log-Lik: -1479.657, Max-Change: 0.00146Iteration: 23, Log-Lik: -1479.656, Max-Change: 0.00173Iteration: 24, Log-Lik: -1479.656, Max-Change: 0.00118Iteration: 25, Log-Lik: -1479.656, Max-Change: 0.00096Iteration: 26, Log-Lik: -1479.656, Max-Change: 0.00090Iteration: 27, Log-Lik: -1479.656, Max-Change: 0.00098Iteration: 28, Log-Lik: -1479.656, Max-Change: 0.00067Iteration: 29, Log-Lik: -1479.655, Max-Change: 0.00014Iteration: 30, Log-Lik: -1479.655, Max-Change: 0.00043Iteration: 31, Log-Lik: -1479.655, Max-Change: 0.00012Iteration: 32, Log-Lik: -1479.655, Max-Change: 0.00037Iteration: 33, Log-Lik: -1479.655, Max-Change: 0.00009
model_form_B <- mirt(form_B, 1, itemtype = "graded")
## Iteration: 1, Log-Lik: -2028.447, Max-Change: 0.89156Iteration: 2, Log-Lik: -1893.174, Max-Change: 1.18025Iteration: 3, Log-Lik: -1734.573, Max-Change: 1.76059Iteration: 4, Log-Lik: -1671.826, Max-Change: 1.12295Iteration: 5, Log-Lik: -1655.067, Max-Change: 0.57336Iteration: 6, Log-Lik: -1649.074, Max-Change: 0.37377Iteration: 7, Log-Lik: -1646.280, Max-Change: 0.40438Iteration: 8, Log-Lik: -1644.693, Max-Change: 0.20167Iteration: 9, Log-Lik: -1643.882, Max-Change: 0.15428Iteration: 10, Log-Lik: -1642.986, Max-Change: 0.05507Iteration: 11, Log-Lik: -1642.893, Max-Change: 0.04329Iteration: 12, Log-Lik: -1642.839, Max-Change: 0.03563Iteration: 13, Log-Lik: -1642.745, Max-Change: 0.00661Iteration: 14, Log-Lik: -1642.743, Max-Change: 0.00345Iteration: 15, Log-Lik: -1642.742, Max-Change: 0.00304Iteration: 16, Log-Lik: -1642.741, Max-Change: 0.00215Iteration: 17, Log-Lik: -1642.740, Max-Change: 0.00115Iteration: 18, Log-Lik: -1642.740, Max-Change: 0.00082Iteration: 19, Log-Lik: -1642.740, Max-Change: 0.00126Iteration: 20, Log-Lik: -1642.740, Max-Change: 0.00090Iteration: 21, Log-Lik: -1642.740, Max-Change: 0.00053Iteration: 22, Log-Lik: -1642.740, Max-Change: 0.00019Iteration: 23, Log-Lik: -1642.740, Max-Change: 0.00047Iteration: 24, Log-Lik: -1642.740, Max-Change: 0.00014Iteration: 25, Log-Lik: -1642.740, Max-Change: 0.00058Iteration: 26, Log-Lik: -1642.740, Max-Change: 0.00028Iteration: 27, Log-Lik: -1642.740, Max-Change: 0.00046Iteration: 28, Log-Lik: -1642.740, Max-Change: 0.00049Iteration: 29, Log-Lik: -1642.740, Max-Change: 0.00041Iteration: 30, Log-Lik: -1642.740, Max-Change: 0.00015Iteration: 31, Log-Lik: -1642.740, Max-Change: 0.00013Iteration: 32, Log-Lik: -1642.740, Max-Change: 0.00033Iteration: 33, Log-Lik: -1642.740, Max-Change: 0.00010
# Extract numeric coefficients for discrimination and difficulty parameters
coef_form_A <- do.call(rbind, lapply(coef(model_form_A, simplify = TRUE)$items, as.numeric))
coef_form_B <- do.call(rbind, lapply(coef(model_form_B, simplify = TRUE)$items, as.numeric))
# Compute parameter drift (absolute differences)
param_drift <- abs(coef_form_A - coef_form_B)
# Create a comparison table for discrimination parameters
comparison_table <- data.frame(
Item = 1:5,
Discrimination_FormA = coef_form_A[, 1], # First column is discrimination
Discrimination_FormB = coef_form_B[, 1], # First column is discrimination
Drift = param_drift[, 1], # Drift in discrimination
Drift_Flag = param_drift[, 1] > 0.5 # Flagging items with drift > 0.5
)
print("Parameter Drift Comparison:")
## [1] "Parameter Drift Comparison:"
print(comparison_table)
## Item Discrimination_FormA Discrimination_FormB Drift Drift_Flag
## 1 1 3.0335305 1.4871472 1.54638323 TRUE
## 2 2 3.6500033 -1.7460806 5.39608388 TRUE
## 3 3 -2.2409909 4.6829728 6.92396370 TRUE
## 4 4 1.9164047 3.7403361 1.82393141 TRUE
## 5 5 -1.8181053 -1.8429782 0.02487294 FALSE
## 6 1 9.5803954 5.6162895 3.96410587 TRUE
## 7 2 10.9694935 6.0718245 4.89766901 TRUE
## 8 3 7.9165382 11.4924842 3.57594597 TRUE
## 9 4 6.3419811 9.1481896 2.80620850 TRUE
## 10 5 6.0788635 7.4033811 1.32451756 TRUE
## 11 1 6.2901327 4.1945554 2.09557731 TRUE
## 12 2 7.8196319 1.3292741 6.49035785 TRUE
## 13 3 1.2289034 6.3435362 5.11463286 TRUE
## 14 4 4.7862800 4.3656661 0.42061396 FALSE
## 15 5 1.3857702 2.4247762 1.03900601 TRUE
## 16 1 3.5689777 1.8428466 1.72613106 TRUE
## 17 2 5.4978961 -1.0106993 6.50859540 TRUE
## 18 3 -1.5375191 1.5922852 3.12980426 TRUE
## 19 4 2.1010579 0.8131988 1.28785912 TRUE
## 20 5 -1.0141624 0.2240928 1.23825515 TRUE
## 21 1 -0.9630327 -1.3381919 0.37515920 FALSE
## 22 2 -0.6188812 -2.8124518 2.19357057 TRUE
## 23 3 -3.9286309 -3.6506672 0.27796361 FALSE
## 24 4 -1.5272966 -3.5671167 2.03982010 TRUE
## 25 5 -2.8855156 -2.0768848 0.80863078 TRUE
# Plot drift for discrimination parameters
barplot(comparison_table$Drift, names.arg = comparison_table$Item,
main = "Discrimination Parameter Drift Across Forms",
ylab = "Drift in Discrimination", col = "lightblue")
# question 4
# Simulate age groups for analysis
set.seed(123)
data_RSE$age <- sample(18:30, nrow(data_RSE), replace = TRUE)
# Split dataset into two age groups
age_group1 <- data_RSE[data_RSE$age <= 24, 1:10]
age_group2 <- data_RSE[data_RSE$age > 24, 1:10]
# Fit Graded Response Models (GRM) for each age group
library(mirt)
grm_age1 <- mirt(age_group1, 1, itemtype = "graded")
## Iteration: 1, Log-Lik: -1998.879, Max-Change: 0.70419Iteration: 2, Log-Lik: -1940.059, Max-Change: 1.02706Iteration: 3, Log-Lik: -1659.157, Max-Change: 2.25840Iteration: 4, Log-Lik: -1531.901, Max-Change: 0.87747Iteration: 5, Log-Lik: -1518.332, Max-Change: 0.25006Iteration: 6, Log-Lik: -1514.727, Max-Change: 0.13471Iteration: 7, Log-Lik: -1512.974, Max-Change: 0.09841Iteration: 8, Log-Lik: -1511.585, Max-Change: 0.07973Iteration: 9, Log-Lik: -1510.652, Max-Change: 0.06644Iteration: 10, Log-Lik: -1509.052, Max-Change: 0.03669Iteration: 11, Log-Lik: -1508.898, Max-Change: 0.03065Iteration: 12, Log-Lik: -1508.792, Max-Change: 0.02596Iteration: 13, Log-Lik: -1508.565, Max-Change: 0.01003Iteration: 14, Log-Lik: -1508.550, Max-Change: 0.00854Iteration: 15, Log-Lik: -1508.539, Max-Change: 0.00740Iteration: 16, Log-Lik: -1508.522, Max-Change: 0.00615Iteration: 17, Log-Lik: -1508.517, Max-Change: 0.00455Iteration: 18, Log-Lik: -1508.515, Max-Change: 0.00469Iteration: 19, Log-Lik: -1508.510, Max-Change: 0.00373Iteration: 20, Log-Lik: -1508.508, Max-Change: 0.00200Iteration: 21, Log-Lik: -1508.507, Max-Change: 0.00132Iteration: 22, Log-Lik: -1508.506, Max-Change: 0.00107Iteration: 23, Log-Lik: -1508.506, Max-Change: 0.00091Iteration: 24, Log-Lik: -1508.506, Max-Change: 0.00083Iteration: 25, Log-Lik: -1508.504, Max-Change: 0.00076Iteration: 26, Log-Lik: -1508.504, Max-Change: 0.00058Iteration: 27, Log-Lik: -1508.504, Max-Change: 0.00065Iteration: 28, Log-Lik: -1508.504, Max-Change: 0.00127Iteration: 29, Log-Lik: -1508.504, Max-Change: 0.00064Iteration: 30, Log-Lik: -1508.504, Max-Change: 0.00041Iteration: 31, Log-Lik: -1508.504, Max-Change: 0.00020Iteration: 32, Log-Lik: -1508.504, Max-Change: 0.00016Iteration: 33, Log-Lik: -1508.504, Max-Change: 0.00016Iteration: 34, Log-Lik: -1508.504, Max-Change: 0.00030Iteration: 35, Log-Lik: -1508.504, Max-Change: 0.00031Iteration: 36, Log-Lik: -1508.504, Max-Change: 0.00024Iteration: 37, Log-Lik: -1508.504, Max-Change: 0.00019Iteration: 38, Log-Lik: -1508.504, Max-Change: 0.00016Iteration: 39, Log-Lik: -1508.504, Max-Change: 0.00016Iteration: 40, Log-Lik: -1508.504, Max-Change: 0.00022Iteration: 41, Log-Lik: -1508.504, Max-Change: 0.00021Iteration: 42, Log-Lik: -1508.504, Max-Change: 0.00017Iteration: 43, Log-Lik: -1508.504, Max-Change: 0.00019Iteration: 44, Log-Lik: -1508.504, Max-Change: 0.00016Iteration: 45, Log-Lik: -1508.504, Max-Change: 0.00015Iteration: 46, Log-Lik: -1508.504, Max-Change: 0.00019Iteration: 47, Log-Lik: -1508.504, Max-Change: 0.00017Iteration: 48, Log-Lik: -1508.504, Max-Change: 0.00015Iteration: 49, Log-Lik: -1508.504, Max-Change: 0.00017Iteration: 50, Log-Lik: -1508.504, Max-Change: 0.00015Iteration: 51, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 52, Log-Lik: -1508.504, Max-Change: 0.00017Iteration: 53, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 54, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 55, Log-Lik: -1508.504, Max-Change: 0.00015Iteration: 56, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 57, Log-Lik: -1508.504, Max-Change: 0.00013Iteration: 58, Log-Lik: -1508.504, Max-Change: 0.00015Iteration: 59, Log-Lik: -1508.504, Max-Change: 0.00013Iteration: 60, Log-Lik: -1508.504, Max-Change: 0.00013Iteration: 61, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 62, Log-Lik: -1508.504, Max-Change: 0.00013Iteration: 63, Log-Lik: -1508.504, Max-Change: 0.00013Iteration: 64, Log-Lik: -1508.504, Max-Change: 0.00014Iteration: 65, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 66, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 67, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 68, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 69, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 70, Log-Lik: -1508.504, Max-Change: 0.00012Iteration: 71, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 72, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 73, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 74, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 75, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 76, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 77, Log-Lik: -1508.504, Max-Change: 0.00011Iteration: 78, Log-Lik: -1508.504, Max-Change: 0.00010Iteration: 79, Log-Lik: -1508.504, Max-Change: 0.00010Iteration: 80, Log-Lik: -1508.504, Max-Change: 0.00010Iteration: 81, Log-Lik: -1508.504, Max-Change: 0.00010Iteration: 82, Log-Lik: -1508.504, Max-Change: 0.00010Iteration: 83, Log-Lik: -1508.504, Max-Change: 0.00010
print(grm_age1)
##
## Call:
## mirt(data = age_group1, model = 1, itemtype = "graded")
##
## Full-information item factor analysis with 1 factor(s).
## Converged within 1e-04 tolerance after 83 EM iterations.
## mirt version: 1.43
## M-step optimizer: BFGS
## EM acceleration: Ramsay
## Number of rectangular quadrature: 61
## Latent density type: Gaussian
##
## Log-likelihood = -1508.504
## Estimated parameters: 50
## AIC = 3117.007
## BIC = 3268.529; SABIC = 3110.276
## G2 (9765574) = 1541.35, p = 1
## RMSEA = 0, CFI = NaN, TLI = NaN
grm_age2 <- mirt(age_group2, 1, itemtype = "graded")
## Iteration: 1, Log-Lik: -1901.645, Max-Change: 0.69950Iteration: 2, Log-Lik: -1856.534, Max-Change: 0.29283Iteration: 3, Log-Lik: -1833.858, Max-Change: 0.63389Iteration: 4, Log-Lik: -1652.412, Max-Change: 1.75626Iteration: 5, Log-Lik: -1496.506, Max-Change: 1.33543Iteration: 6, Log-Lik: -1467.343, Max-Change: 0.63547Iteration: 7, Log-Lik: -1458.732, Max-Change: 0.42148Iteration: 8, Log-Lik: -1454.314, Max-Change: 0.21616Iteration: 9, Log-Lik: -1451.785, Max-Change: 0.13990Iteration: 10, Log-Lik: -1449.317, Max-Change: 0.08396Iteration: 11, Log-Lik: -1448.532, Max-Change: 0.06844Iteration: 12, Log-Lik: -1448.037, Max-Change: 0.05375Iteration: 13, Log-Lik: -1447.163, Max-Change: 0.02552Iteration: 14, Log-Lik: -1447.089, Max-Change: 0.02079Iteration: 15, Log-Lik: -1447.037, Max-Change: 0.01790Iteration: 16, Log-Lik: -1446.909, Max-Change: 0.00321Iteration: 17, Log-Lik: -1446.907, Max-Change: 0.00270Iteration: 18, Log-Lik: -1446.906, Max-Change: 0.00233Iteration: 19, Log-Lik: -1446.900, Max-Change: 0.00169Iteration: 20, Log-Lik: -1446.899, Max-Change: 0.00145Iteration: 21, Log-Lik: -1446.899, Max-Change: 0.00138Iteration: 22, Log-Lik: -1446.899, Max-Change: 0.00113Iteration: 23, Log-Lik: -1446.898, Max-Change: 0.00093Iteration: 24, Log-Lik: -1446.898, Max-Change: 0.00102Iteration: 25, Log-Lik: -1446.898, Max-Change: 0.00171Iteration: 26, Log-Lik: -1446.898, Max-Change: 0.00097Iteration: 27, Log-Lik: -1446.898, Max-Change: 0.00070Iteration: 28, Log-Lik: -1446.898, Max-Change: 0.00061Iteration: 29, Log-Lik: -1446.898, Max-Change: 0.00054Iteration: 30, Log-Lik: -1446.898, Max-Change: 0.00049Iteration: 31, Log-Lik: -1446.897, Max-Change: 0.00055Iteration: 32, Log-Lik: -1446.897, Max-Change: 0.00022Iteration: 33, Log-Lik: -1446.897, Max-Change: 0.00020Iteration: 34, Log-Lik: -1446.897, Max-Change: 0.00022Iteration: 35, Log-Lik: -1446.897, Max-Change: 0.00018Iteration: 36, Log-Lik: -1446.897, Max-Change: 0.00017Iteration: 37, Log-Lik: -1446.897, Max-Change: 0.00019Iteration: 38, Log-Lik: -1446.897, Max-Change: 0.00016Iteration: 39, Log-Lik: -1446.897, Max-Change: 0.00016Iteration: 40, Log-Lik: -1446.897, Max-Change: 0.00018Iteration: 41, Log-Lik: -1446.897, Max-Change: 0.00014Iteration: 42, Log-Lik: -1446.897, Max-Change: 0.00014Iteration: 43, Log-Lik: -1446.897, Max-Change: 0.00016Iteration: 44, Log-Lik: -1446.897, Max-Change: 0.00013Iteration: 45, Log-Lik: -1446.897, Max-Change: 0.00065Iteration: 46, Log-Lik: -1446.897, Max-Change: 0.00057Iteration: 47, Log-Lik: -1446.897, Max-Change: 0.00039Iteration: 48, Log-Lik: -1446.897, Max-Change: 0.00026Iteration: 49, Log-Lik: -1446.897, Max-Change: 0.00062Iteration: 50, Log-Lik: -1446.897, Max-Change: 0.00016Iteration: 51, Log-Lik: -1446.897, Max-Change: 0.00012Iteration: 52, Log-Lik: -1446.897, Max-Change: 0.00059Iteration: 53, Log-Lik: -1446.897, Max-Change: 0.00034Iteration: 54, Log-Lik: -1446.897, Max-Change: 0.00023Iteration: 55, Log-Lik: -1446.897, Max-Change: 0.00057Iteration: 56, Log-Lik: -1446.897, Max-Change: 0.00024Iteration: 57, Log-Lik: -1446.897, Max-Change: 0.00016Iteration: 58, Log-Lik: -1446.897, Max-Change: 0.00054Iteration: 59, Log-Lik: -1446.897, Max-Change: 0.00010Iteration: 60, Log-Lik: -1446.897, Max-Change: 0.00010Iteration: 61, Log-Lik: -1446.897, Max-Change: 0.00051Iteration: 62, Log-Lik: -1446.897, Max-Change: 0.00032Iteration: 63, Log-Lik: -1446.897, Max-Change: 0.00022Iteration: 64, Log-Lik: -1446.897, Max-Change: 0.00010
print(grm_age2)
##
## Call:
## mirt(data = age_group2, model = 1, itemtype = "graded")
##
## Full-information item factor analysis with 1 factor(s).
## Converged within 1e-04 tolerance after 64 EM iterations.
## mirt version: 1.43
## M-step optimizer: BFGS
## EM acceleration: Ramsay
## Number of rectangular quadrature: 61
## Latent density type: Gaussian
##
## Log-likelihood = -1446.897
## Estimated parameters: 44
## AIC = 2981.794
## BIC = 3113.373; SABIC = 2974.133
## G2 (2559955) = 1468.2, p = 1
## RMSEA = 0, CFI = NaN, TLI = NaN
# Compute Test Characteristic Curves (TCCs) for each group
theta_values <- seq(-3, 3, length.out = 100) # Common theta range for TCCs
tcc_age1 <- testinfo(grm_age1, theta_values) # TCC for age group 1
tcc_age2 <- testinfo(grm_age2, theta_values) # TCC for age group 2
# Plot TCCs
plot(theta_values, tcc_age1, type = "l", col = "blue", lwd = 2,
xlab = "Theta (Self-Esteem Level)", ylab = "Test Information",
main = "Test Characteristic Curves by Age Group", ylim = range(c(tcc_age1, tcc_age2)))
lines(theta_values, tcc_age2, col = "red", lwd = 2)
# Add a legend
legend("topright", legend = c("Age <= 24", "Age > 24"), col = c("blue", "red"), lty = 1, lwd = 2)
