ASQ:I CAT
Luis Anunciacao
13 março, 2019
1 Overview
This report summarises all previous results computed with the mirt package v.1.28.4. I´m using what I´m calling as Artificial imputation (i.e., data with no missing cases because all values were imputed with 0 or 2), and what I´m calling as NA Data (data with missing cases allowed). I have exported all data to flexmirt and I carried out the same analyses using this software as well. Just to notice, flexmirt uses -9 to identify its missing cases and I have changed “NA values” with the flexmirt default. An excel file has been sent in the e-mail that you received with the link for this report and this file gathers all flexmirt and mirt results.
All computational codes used is printed in this html file. Once I’m working on this dataset for a very long time, I´m afraid that small errors or inconsistencies could not be filtered during the proccess. Therefore, I’ll be grateful if everyone look at the following codes (all logic is very straightforward) aiming at identifying any errors.
Thank you
1.1 mirt results (artificial imputation)
overall_mirt_results <- data.frame(m2_gm_artificial) %>%
bind_rows(.,m2_fm_artificial) %>%
bind_rows(.,m2_cg_artificial) %>%
bind_rows(.,m2_cm_artificial) %>%
bind_rows(.,m2_ps_artificial) %>%
mutate(model = row_number()) %>%
mutate(model = case_when(
model == "1" ~ "Gross motor",
model == "2" ~ "Fine motor",
model == "3" ~ "Problem solving",
model == "4" ~ "Communication",
model == "5" ~ "Personal and social"
)) %>%
select(model, everything())
overall_mirt_results %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| model | M2 | df | p | RMSEA | RMSEA_5 | RMSEA_95 | SRMSR | TLI | CFI |
|---|---|---|---|---|---|---|---|---|---|
| Gross motor | 19367.047 | 1127 | 0 | 0.107 | 0.106 | 0.108 | 0.093 | 0.939 | 0.941 |
| Fine motor | 7653096.711 | 1224 | 0 | 2.659 | 2.653 | 2.658 | 0.096 | -52.385 | 0.000 |
| Problem solving | 1777.595 | 1224 | 0 | 0.024 | 0.022 | 0.027 | 0.139 | 0.996 | 0.996 |
| Communication | 2706.134 | 1175 | 0 | 0.039 | 0.037 | 0.041 | 0.092 | 0.990 | 0.991 |
| Personal and social | 2952.016 | 1175 | 0 | 0.034 | 0.032 | 0.035 | 0.125 | 0.991 | 0.991 |
1.2 flexmirt (artificial imputation)
(#fig:flexmirt - artificial dataset)Flexmirt results
1.3 flexmirt (NA dataset)
(#fig:flexmirt - na dataset)Flexmirt results 2
2 Gross motor
2.1 Dataset (Missing data allowed)
The following chunk gets the SPSS dataset, locate the floor and the ceiling and replace all previously imputed values by NA. The function that performs theses action is named as altMask. In addition, you can check all the steps by reading the comments close to each function.
#gm_original <- asqi_gm_online
#Slice the data
gm_items_na <- gm_original %>%
select(gm_floor:gm_20_p) #get all ASQ-I items
#change names
gm_items_na <- gm_items_na %>%
rename_at(vars(-gm_floor, -gm_ceiling),
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
#change str for numeric
gm_items_na <- gm_items_na %>%
mutate_at(vars(gm_floor, gm_ceiling),
list(~as.numeric(.))) #now, all variables are numeric
#replace na with the first/last option possible
#if the floor or the ceiling were missing, I'll fix it.
gm_items_na <- gm_items_na %>%
mutate_at(vars(gm_floor), list(~if_else(is.na(.),1,.)))
gm_items_na <- gm_items_na %>%
mutate_at(vars(gm_ceiling), list(~if_else(is.na(.),69,.)))
#Now I'll run the function I've created
gm_items_na %>%
mutate(rowIdx = 1:n()) %>%
gather(col, value, starts_with("y")) %>%
mutate(value = altMask(parse_number(col), value, gm_floor, gm_ceiling)) %>%
spread(col, value) %>%
arrange(rowIdx) %>%
select(-rowIdx) -> gm_items_na
#Order
gm_items_na <- gm_items_na %>% select(gm_floor, gm_ceiling, paste("y", seq(1, ncol(select(., starts_with("y"))), 1), sep=""), everything())
#supress floor and ceiling
gm_items_na <- gm_items_na %>% select(-gm_floor, -gm_ceiling)The plot below shows the missing quantity in this domain:
I’ll run the IRT model.
2.2 Gross motor IRT with missing data
#run the model
set.seed(123) #replicable results
mod_gm_na <- mirt(gm_items_na, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_gm_na <- M2(mod_gm_na, type="C2", calcNull = FALSE, na.rm=TRUE)The M2 statistics was not computed: NaN, 2277, NaN, NaN, 0, 0, NaN, but the model coefficients were. These results are reported in the table below:
coef(mod_gm_na, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| y1 | 0.163 | -24.843 | -15.040 |
| y2 | 0.650 | -7.883 | -5.310 |
| y3 | 1.555 | -3.887 | -2.444 |
| y4 | 0.613 | -9.552 | -4.373 |
| y5 | 0.812 | -5.518 | -2.988 |
| y6 | 0.971 | -4.905 | -2.481 |
| y7 | 1.877 | -3.525 | -1.996 |
| y8 | 3.364 | -2.428 | -1.590 |
| y9 | 3.569 | -1.738 | -1.147 |
| y10 | 1.868 | -2.771 | -1.886 |
| y11 | 1.965 | -2.186 | -1.494 |
| y12 | 2.098 | -1.070 | -0.715 |
| y13 | 2.211 | -1.269 | -0.638 |
| y14 | 3.053 | -1.158 | -0.730 |
| y15 | 1.324 | -1.742 | -0.931 |
| y16 | 2.544 | -0.855 | -0.622 |
| y17 | 1.673 | -0.300 | -0.001 |
| y18 | 1.806 | -0.266 | 0.162 |
| y19 | 0.276 | 0.540 | 2.178 |
| y20 | -0.188 | 3.010 | 0.495 |
| y21 | -0.474 | 3.170 | 1.571 |
| y22 | -1.365 | 0.853 | 0.275 |
| y23 | -1.761 | 0.702 | 0.167 |
| y24 | -2.177 | 0.272 | -0.082 |
| y25 | -0.893 | 1.316 | 0.520 |
| y26 | -2.845 | -0.054 | -0.190 |
| y27 | -2.527 | 0.181 | -0.045 |
| y28 | -1.789 | 0.115 | -0.304 |
| y29 | -0.600 | 0.197 | -0.673 |
| y30 | -0.294 | 2.600 | 0.224 |
| y31 | 0.860 | -3.061 | -2.283 |
| y32 | 0.987 | -2.512 | -1.575 |
| y33 | 1.457 | -1.820 | -1.363 |
| y34 | 1.190 | -2.010 | -1.220 |
| y35 | 2.157 | -1.042 | -0.629 |
| y36 | 2.365 | -1.374 | -0.903 |
| y37 | 1.973 | -0.999 | -0.320 |
| y38 | 4.111 | -0.695 | -0.388 |
| y39 | 1.656 | -1.294 | -0.616 |
| y40 | 3.040 | -0.690 | -0.314 |
| y41 | 5.720 | -0.393 | -0.196 |
| y42 | 1.769 | -0.723 | 0.193 |
| y43 | 5.925 | -0.149 | 0.115 |
| y44 | 1.948 | -0.832 | -0.325 |
| y45 | 2.775 | -0.146 | 0.387 |
| y46 | 3.802 | 0.037 | 0.368 |
| y47 | 4.013 | 0.259 | 0.507 |
| y48 | 2.498 | 0.549 | 0.967 |
| y49 | 3.570 | 0.608 | 1.060 |
| y50 | 1.881 | -1.306 | -0.229 |
| y51 | 1.901 | -0.430 | 0.119 |
| y52 | 2.390 | 0.628 | 1.199 |
| y53 | 4.811 | 0.321 | 0.701 |
| y54 | 1.776 | -0.138 | 0.362 |
| y55 | 1.074 | -1.514 | -0.990 |
| y56 | 1.889 | 0.135 | 0.855 |
| y57 | 1.408 | -1.511 | NA |
| y58 | 1.342 | -1.616 | -0.245 |
| y59 | 1.685 | -0.369 | 0.815 |
| y60 | 2.712 | -0.658 | NA |
| y61 | 2.474 | 0.041 | 0.643 |
| y62 | 3.749 | -0.074 | 0.458 |
| y63 | 2.266 | -0.573 | 0.037 |
| y64 | 1.441 | -2.395 | -1.196 |
| y65 | 1.579 | -0.785 | -0.020 |
| y66 | 1.164 | 0.148 | 1.343 |
| y67 | 1.966 | 1.711 | 2.172 |
| y68 | 1.379 | 1.651 | 1.950 |
| y69 | 1.181 | -0.472 | 1.064 |
#replace NA by -99
gm_items_na <- gm_items_na %>%
mutate_all(., funs(replace_na(., -9)))
write.table(gm_items_na, file = "gm_items_na.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)2.3 Gross motor IRT with Artificial imputation
Now I’ll test the dataset with the artificial imputation (2s and 0s). Note this dataset has no missing data.
gm_items_c_artificial <- gm_original %>%
select(gm_floor:gm_20_p)#get all ASQ-I items
#complete dataset
items_up60 <- c(
"gm_1_2",
"gm_4_2",
"gm_3_2",
"gm_5_2",
"gm_6_2",
"gm_2_2",
"gm_3_4",
"gm_4_4",
"gm_5_4",
"gm_6_4",
"gm_1_6",
"gm_2_6",
"gm_3_6",
"gm_4_6",
"gm_5_6",
"gm_6_6",
"gm_5_8",
"gm_6_8",
"gm_4_10",
"gm_5_10",
"gm_6_10",
"gm_4_12",
"gm_5_12",
"gm_6_12",
"gm_4_14",
"gm_5_14",
"gm_6_14",
"gm_5_16",
"gm_6_16",
"gm_5_18",
"gm_6_18",
"gm_5_20",
"gm_6_20",
"gm_5_22",
"gm_6_22",
"gm_5_27",
"gm_6_27",
"gm_6_30",
"gm_6_33",
"gm_6_36",
"gm_5_42",
"gm_6_42",
"gm_3_48",
"gm_4_48",
"gm_5_48",
"gm_6_48",
"gm_6_54",
"gm_5_60",
"gm_6_60",
"gm_1_p",
"gm_2_p",
"gm_3_p",
"gm_4_p",
"gm_5_p",
"gm_6_p",
"gm_7_p",
"gm_8_p",
"gm_9_p",
"gm_10_p",
"gm_11_p",
"gm_12_p",
"gm_13_p",
"gm_14_p",
"gm_15_p",
"gm_16_p",
"gm_17_p",
"gm_18_p",
"gm_19_p",
"gm_20_p")
#create ds
gm_items_c_artificial <- gm_items_c_artificial %>%
select(items_up60)
#check for missing
plot_missing(gm_items_c_artificial)
#remove missing
gm_items_c_artificial <- gm_items_c_artificial %>%
dplyr::select(-c(ends_with("_p")))
#check
plot_missing(gm_items_c_artificial)
#change names
gm_items_c_artificial <- gm_items_c_artificial %>%
rename_all(.,
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
# to flexmirt
write.table(gm_items_c_artificial, file = "gm_items_c_artificial.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)#run the model
set.seed(123)
mod_gm_artificial <- mirt(gm_items_c_artificial, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_gm_artificial <- M2(mod_gm_artificial, type="C2")The M2 statistics revealed an excelent fit. See below:
1.936704710^{4}, 1127, 0, 0.1070237, 0.1056656, 0.1083115, 0.0930104, 0.9385562, 0.9411164.
The coefficients are reported in the next table.
coef(mod_gm_artificial, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| y1 | 2.385 | -4.268 | -3.492 |
| y2 | 2.503 | -4.195 | -3.455 |
| y3 | 4.320 | -3.150 | -2.574 |
| y4 | 2.733 | -4.387 | -3.028 |
| y5 | 3.227 | -3.378 | -2.662 |
| y6 | 3.302 | -3.269 | -2.478 |
| y7 | 6.812 | -2.559 | -2.132 |
| y8 | 8.130 | -2.184 | -1.895 |
| y9 | 4.604 | -3.018 | -2.331 |
| y10 | 4.604 | -2.614 | -2.229 |
| y11 | 4.690 | -2.365 | -2.054 |
| y12 | 5.336 | -1.899 | -1.608 |
| y13 | 5.364 | -1.831 | -1.677 |
| y14 | 7.151 | -1.854 | -1.645 |
| y15 | 3.671 | -1.981 | -1.693 |
| y16 | 6.671 | -1.321 | -1.188 |
| y17 | 7.200 | -1.629 | -1.523 |
| y18 | 9.138 | -1.304 | -1.110 |
| y19 | 7.636 | -0.896 | -0.706 |
| y20 | 6.504 | -0.943 | -0.707 |
| y21 | 7.703 | -0.661 | -0.443 |
| y22 | 5.130 | -1.070 | -0.797 |
| y23 | 7.258 | -0.592 | -0.373 |
| y24 | 13.170 | -0.183 | -0.111 |
| y25 | 4.173 | -0.504 | -0.302 |
| y26 | 7.014 | -0.354 | -0.187 |
| y27 | 8.140 | -0.193 | -0.063 |
| y28 | 7.586 | -0.082 | 0.144 |
| y29 | 5.240 | 0.046 | 0.218 |
| y30 | 6.006 | 0.167 | 0.365 |
| y31 | 5.292 | 0.158 | 0.414 |
| y32 | 5.834 | 0.147 | 0.431 |
| y33 | 6.297 | 0.276 | 0.444 |
| y34 | 6.419 | 0.771 | 0.950 |
| y35 | 5.623 | 0.423 | 0.661 |
| y36 | 8.709 | 0.953 | 1.065 |
| y37 | 4.081 | 0.639 | 0.979 |
| y38 | 5.990 | 0.797 | 0.995 |
| y39 | 3.864 | 0.287 | 0.568 |
| y40 | 10.002 | 1.093 | 1.247 |
| y41 | 4.149 | 0.861 | 1.260 |
| y42 | 5.004 | 0.566 | 0.786 |
| y43 | 4.185 | 0.593 | 0.867 |
| y44 | 6.848 | 1.219 | 1.402 |
| y45 | 6.926 | 1.350 | 1.495 |
| y46 | 5.754 | 1.128 | 1.399 |
| y47 | 4.864 | 0.837 | 1.037 |
| y48 | 5.966 | 1.578 | 1.858 |
| y49 | 4.205 | 1.562 | 1.807 |
2.4 Take away message
mirt package did not compute a valid model when missing data were present. Its coefficient results should be seen carefully.
mirt package could compute a model when the dataset had artificial imputation (2s and 0s). Its results allow conclude that this model is well-adjusted.
3 Fine motor
3.1 Dataset (Missing data allowed)
The following code repeats the process described in the beginning.
#Slice the data
fm_items_na <- fm_original %>%
select(fm_floor:fm_3_p) #get all ASQ-I items
#change names
fm_items_na <- fm_items_na %>%
rename_at(vars(-fm_floor, -fm_ceiling),
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
#change str for numeric
fm_items_na <- fm_items_na %>%
mutate_at(vars(fm_floor, fm_ceiling),
list(~as.numeric(.))) #now, all variables are numeric
#replace na with the first/last option possible
#if the floor or the ceiling were missing, I'll fix it.
fm_items_na <- fm_items_na %>%
mutate_at(vars(fm_floor), list(~if_else(is.na(.),1,.)))
fm_items_na <- fm_items_na %>%
mutate_at(vars(fm_ceiling), list(~if_else(is.na(.),64,.)))
#Now I'll run the function I've created
fm_items_na %>%
mutate(rowIdx = 1:n()) %>%
gather(col, value, starts_with("y")) %>%
mutate(value = altMask(parse_number(col), value, fm_floor, fm_ceiling)) %>%
spread(col, value) %>%
arrange(rowIdx) %>%
select(-rowIdx) -> fm_items_na
#Order
fm_items_na <- fm_items_na %>% select(fm_floor, fm_ceiling, paste("y", seq(1, ncol(select(., starts_with("y"))), 1), sep=""), everything())
#supress floor and ceiling
fm_items_na <- fm_items_na %>% select(-fm_floor, -fm_ceiling)The plot below shows the missing quantity in this domain:
I’ll run the IRT model.
3.2 Fine motor IRT with missing data
#run the model
set.seed(123)
mod_fm_na <- mirt(fm_items_na, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_fm_na <- M2(mod_fm_na, type="C2", na.rm=TRUE)Unfortunately, even after 2000 iterations, the convergence was not reached. Similar to what I carried out before, I’ve computed the summary and the model coefficients. These results are presented in the next Table.
coef(mod_fm_na, IRTpars=TRUE, simplify = TRUE) %>% data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| y1 | 2.149 | -3.537 | -2.918 |
| y2 | 1.636 | -4.429 | -3.477 |
| y3 | 1.128 | -4.536 | -2.880 |
| y4 | 1.790 | -3.915 | -2.885 |
| y5 | 2.449 | -2.971 | -2.490 |
| y6 | 5.244 | -2.932 | -2.487 |
| y7 | 20082757.239 | -1.544 | NA |
| y8 | 3.937 | -2.543 | -2.323 |
| y9 | 7.153 | -2.326 | -2.038 |
| y10 | 7.670 | -2.180 | -1.981 |
| y11 | 6.789 | -2.186 | -1.997 |
| y12 | 6.884 | -1.963 | -1.792 |
| y13 | 3.197 | -2.518 | -2.040 |
| y14 | 5.817 | -1.989 | -1.768 |
| y15 | 11.353 | -1.668 | -1.568 |
| y16 | 10.736 | -1.686 | -1.554 |
| y17 | 14.039 | -1.610 | -1.446 |
| y18 | 7.387 | -1.583 | -1.434 |
| y19 | 4.564 | -1.707 | -1.370 |
| y20 | 5.919 | -1.560 | -1.333 |
| y21 | 5.226 | -1.628 | -1.278 |
| y22 | 6.402 | -1.407 | -1.229 |
| y23 | 3.800 | -1.720 | -1.377 |
| y24 | 4.515 | -1.402 | -1.149 |
| y25 | 4.628 | -0.932 | -0.741 |
| y26 | 4.608 | -0.997 | -0.662 |
| y27 | 3.216 | -1.127 | -0.821 |
| y28 | 2.717 | -1.022 | -0.622 |
| y29 | 4.050 | -0.723 | -0.395 |
| y30 | 2.815 | -1.189 | -0.366 |
| y31 | 3.498 | -0.367 | 0.028 |
| y32 | 2.275 | -1.170 | -0.645 |
| y33 | 1.940 | -1.528 | -0.361 |
| y34 | 5.530 | 0.194 | 0.438 |
| y35 | 6.056 | 0.118 | 0.433 |
| y36 | 4.637 | 0.062 | 0.434 |
| y37 | 2.693 | -0.006 | 0.541 |
| y38 | 2.372 | 0.307 | 0.656 |
| y39 | 0.916 | -1.063 | 0.697 |
| y40 | 1.923 | 0.368 | 0.907 |
| y41 | 1.462 | 0.219 | 1.052 |
| y42 | 3.324 | 0.650 | 1.241 |
| y43 | 3.295 | 0.783 | 0.942 |
| y44 | 1.436 | -0.270 | 0.615 |
| y45 | 3.037 | 0.456 | 0.950 |
| y46 | 1.745 | -0.021 | 1.072 |
| y47 | 1.745 | 0.082 | 0.870 |
| y48 | 0.572 | -2.659 | 0.313 |
| y49 | 2.385 | 0.134 | 1.273 |
| y50 | 2.098 | 0.092 | 0.818 |
| y51 | 1.967 | 0.140 | 1.115 |
| y52 | 1.505 | -0.004 | 1.166 |
| y53 | 2.660 | 0.499 | 1.165 |
| y54 | 2.337 | 0.293 | 1.150 |
| y55 | 1.602 | -0.741 | 1.106 |
| y56 | 1.721 | -0.023 | 1.055 |
| y57 | 1.636 | 0.173 | 1.129 |
| y58 | 1.577 | 0.467 | 1.286 |
| y59 | 0.807 | 0.113 | 1.371 |
| y60 | 1.572 | 0.159 | 1.267 |
| y61 | 2.060 | 0.780 | 1.613 |
| y62 | 1.359 | 0.893 | 1.596 |
| y63 | 0.842 | 0.728 | 1.899 |
| y64 | 1.364 | 2.282 | 2.842 |
Please, have a look at “y7” (fm_2_4). In the dataset, 99.66% of values are NA. I don’t know what happened in this case.
#replace NA by -99
fm_items_na <- fm_items_na %>%
mutate_all(., funs(replace_na(., -9)))
write.table(fm_items_na, file = "fm_items_na.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)3.3 Fine motor IRT with Artificial imputation
Now I’ll test the dataset with the artificial imputation (2s and 0s). Note this dataset has no missing data.
#get entire data
fm_items_c_artificial <- fm_original %>%
select(fm_floor:fm_3_p) #get all ASQ-I items
#overall instrument
items_up60 <- c("fm_4_2",
"fm_2_2",
"fm_5_2",
"fm_1_2",
"fm_6_2",
"fm_3_2",
"fm_2_4",
"fm_5_4",
"fm_4_4",
"fm_6_4",
"fm_1_6",
"fm_2_6",
"fm_3_6",
"fm_4_6",
"fm_5_6",
"fm_6_6",
"fm_5_8",
"fm_6_8",
"fm_4_10",
"fm_5_10",
"fm_6_10",
"fm_4_12",
"fm_5_12",
"fm_6_12",
"fm_4_14",
"fm_5_14",
"fm_6_14",
"fm_6_16",
"fm_6_18",
"fm_5_20",
"fm_6_20",
"fm_5_22",
"fm_6_22",
"fm_3_27",
"fm_6_27",
"fm_5_30",
"fm_6_30",
"fm_6_33",
"fm_6_36",
"fm_5_42",
"fm_6_42",
"fm_2_48",
"fm_3_48",
"fm_4_48",
"fm_5_48",
"fm_6_48",
"fm_4_54",
"fm_5_54",
"fm_6_54",
"fm_4_60",
"fm_6_60",
"fm_5_60",
"fm_1_p",
"fm_2_p",
"fm_3_p",
"fm_4_p",
"fm_5_p",
"fm_6_p",
"fm_7_p",
"fm_8_p",
"fm_9_p",
"fm_10_p",
"fm_11_p",
"fm_12_p")
#select specific items
fm_items_c_artificial <- fm_items_c_artificial %>%
dplyr::select(items_up60)
#check for missing
plot_missing(fm_items_c_artificial)
#remove missing
fm_items_c_artificial <- fm_items_c_artificial %>%
dplyr::select(-fm_2_4,-c(ends_with("_p")))
#check
plot_missing(fm_items_c_artificial)
#change names
fm_items_c_artificial <- fm_items_c_artificial %>%
rename_all(.,
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to
# to flexmirt
write.table(fm_items_c_artificial, file = "fm_items_c_artificial.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)#run the model
set.seed(123)
mod_fm_artificial <- mirt(fm_items_c_artificial, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_fm_artificial <- M2(mod_fm_artificial, type="C2")The M2 statistics revealed an excelent fit. See below:
7.653096710^{6}, 1224, 0, 2.6592981, 2.6529954, 2.6582551, 0.0956688, -52.384929, 0.
The coefficients are reported in the next table.
coef(mod_fm_artificial, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| fm_4_2 | 3.029 | -3.362 | -2.907 |
| fm_2_2 | 2.293 | -4.059 | -3.368 |
| fm_5_2 | 2.554 | -3.575 | -2.808 |
| fm_1_2 | 2.442 | -3.597 | -2.820 |
| fm_6_2 | 2.846 | -2.941 | -2.513 |
| fm_3_2 | 4.016 | -3.064 | -2.558 |
| fm_5_4 | 3.522 | -2.595 | -2.352 |
| fm_4_4 | 6.046 | -2.355 | -2.016 |
| fm_6_4 | 5.506 | -2.169 | -1.945 |
| fm_1_6 | 6.357 | -2.167 | -1.929 |
| fm_2_6 | 3.899 | -2.142 | -1.811 |
| fm_3_6 | 6.821 | -1.493 | -1.341 |
| fm_4_6 | 4.810 | -1.872 | -1.610 |
| fm_5_6 | 6.253 | -1.502 | -1.310 |
| fm_6_6 | 5.712 | -1.897 | -1.670 |
| fm_5_8 | 7.800 | -1.384 | -1.147 |
| fm_6_8 | 5.728 | -1.322 | -1.123 |
| fm_4_10 | 4.495 | -1.315 | -0.981 |
| fm_5_10 | 4.853 | -1.200 | -0.951 |
| fm_6_10 | 4.822 | -1.228 | -0.869 |
| fm_4_12 | 4.986 | -1.030 | -0.821 |
| fm_5_12 | 3.270 | -0.391 | -0.059 |
| fm_6_12 | 4.410 | -1.165 | -0.884 |
| fm_4_14 | 4.632 | -0.482 | -0.137 |
| fm_5_14 | 4.440 | -0.439 | -0.233 |
| fm_6_14 | 4.155 | -0.169 | 0.145 |
| fm_6_16 | 4.721 | -0.948 | -0.680 |
| fm_6_18 | 3.306 | -0.479 | 0.211 |
| fm_5_20 | 3.598 | 0.214 | 0.602 |
| fm_6_20 | 3.246 | -0.291 | 0.052 |
| fm_5_22 | 3.764 | -0.549 | -0.273 |
| fm_6_22 | 4.086 | 0.749 | 1.113 |
| fm_3_27 | 5.257 | 0.718 | 1.028 |
| fm_6_27 | 4.663 | 0.716 | 1.034 |
| fm_5_30 | 5.883 | 0.789 | 1.022 |
| fm_6_30 | 3.015 | -0.355 | 0.314 |
| fm_6_33 | 3.988 | 0.961 | 1.187 |
| fm_6_36 | 2.535 | 0.635 | 1.213 |
| fm_5_42 | 4.406 | 1.066 | 1.342 |
| fm_6_42 | 7.959 | 1.246 | 1.565 |
| fm_2_48 | 6.068 | 1.232 | 1.461 |
| fm_3_48 | 7.771 | 1.278 | 1.466 |
| fm_4_48 | 3.589 | 1.031 | 1.401 |
| fm_5_48 | 8.529 | 1.332 | 1.418 |
| fm_6_48 | 6.252 | 1.330 | 1.640 |
| fm_4_54 | 7.168 | 1.209 | 1.612 |
| fm_5_54 | 7.332 | 1.398 | 1.625 |
| fm_6_54 | 7.110 | 1.306 | 1.602 |
| fm_4_60 | 7.059 | 1.459 | 1.703 |
| fm_6_60 | 8.718 | 1.444 | 1.634 |
| fm_5_60 | 8.010 | 1.513 | 1.721 |
3.4 Take away message
mirt package did not compute a valid model when missing data were present. Its coefficient results should be seen carefully.
mirt package could compute a model when the dataset had artificial imputation (2s and 0s), but it failed to achieve the M2 statistics.
4 Problem solving
4.1 Dataset (Missing data allowed)
The following code repeats the process described in the beginning.
#Slice the data
cg_items_na <- cg_original %>%
select(cg_floor:cg_30_p) #get all ASQ-I items
#change names
cg_items_na <- cg_items_na %>%
rename_at(vars(-cg_floor, -cg_ceiling),function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
#change str for numeric
cg_items_na <- cg_items_na %>%
mutate_at(vars(cg_floor, cg_ceiling), list(~as.numeric(.))) #now, all variables are numeric
#replace na with the first/last option possible
#if the floor or the ceiling were missing, I'll fix it.
cg_items_na <- cg_items_na %>%
mutate_at(vars(cg_floor), list(~if_else(is.na(.),1,.)))
cg_items_na <- cg_items_na %>%
mutate_at(vars(cg_ceiling), list(~if_else(is.na(.),82,.)))
#locate floor and ceiling
#This function will replace the values before and after with NA
altMask <- function(x, val, low, high){
sapply(1:length(x), function(idx){
ifelse(between(x[idx], low[idx], high[idx]), val[idx], NA)
})
}
#Now I'll run the function
cg_items_na %>%
mutate(rowIdx = 1:n()) %>%
gather(col, value, starts_with("y")) %>%
mutate(value = altMask(parse_number(col), value, cg_floor, cg_ceiling)) %>%
spread(col, value) %>%
arrange(rowIdx) %>%
select(-rowIdx) -> cg_items_na
#Order
cg_items_na <- cg_items_na %>% select(cg_floor, cg_ceiling, paste("y", seq(1, ncol(select(., starts_with("y"))), 1), sep=""), everything())
#supress floor and ceiling
cg_items_na <- cg_items_na %>% select(-cg_floor, -cg_ceiling)
#check
plot_missing(cg_items_na)
The plot below shows the missing quantity in this domain:
I’ll run the IRT model.
4.2 Problem solving IRT with missing data
#run the model
set.seed(123)
mod_cg_na <- mirt(cg_items_na, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_cg_na <- M2(mod_cg_na, type="C2", calcNull = FALSE, na.rm=TRUE)Unfortunately, the M2 was not computed.
#replace NA by -99
cg_items_na <- cg_items_na %>%
mutate_all(., funs(replace_na(., -9)))
write.table(cg_items_na, file = "cg_items_na.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)4.3 Problem solving IRT with Artificial imputation
Now I’ll test the dataset with the artificial imputation (2s and 0s). Note this dataset has no missing data.
#get entire data
cg_items_c_artificial <- cg_original %>%
select(cg_floor:cg_30_p) #get all ASQ-I items
#select specific items
items_up60 <- c("cg_1_2","cg_2_2","cg_3_2","cg_4_2","cg_5_2","cg_6_2","cg_4_4","cg_5_4","cg_1_6","cg_2_6","cg_3_6","cg_4_6","cg_5_6","cg_6_6","cg_5_8","cg_6_8","cg_4_10","cg_5_10","cg_6_10","cg_4_12","cg_5_12","cg_6_12","cg_4_14","cg_5_14","cg_6_14","cg_5_16","cg_6_16","cg_5_18","cg_6_18","cg_3_20","cg_4_20","cg_5_20","cg_6_20","cg_3_22","cg_4_24","cg_6_24","cg_3_27","cg_6_27","cg_5_30","cg_6_30","cg_5_36","cg_6_36","cg_5_42","cg_6_42","cg_3_48","cg_4_48","cg_6_48","cg_6_54","cg_5_54","cg_4_60","cg_6_60","cg_1_p","cg_2_p","cg_3_p","cg_4_p","cg_5_p","cg_6_p","cg_7_p","cg_8_p","cg_9_p","cg_10_p","cg_11_p","cg_12_p","cg_13_p","cg_14_p","cg_15_p","cg_16_p","cg_17_p","cg_18_p","cg_19_p","cg_20_p","cg_21_p","cg_22_p","cg_23_p","cg_24_p","cg_25_p","cg_26_p","cg_27_p","cg_28_p","cg_29_p","cg_30_p","cg_31_p")
cg_items_c_artificial <- cg_items_c_artificial %>%
select(items_up60)
cg_items_c_artificial <- cg_items_c_artificial %>%
select(-c(ends_with("_p")))
#check missing (should be 0)
plot_missing(cg_items_c_artificial)
# to flexmirt
write.table(cg_items_c_artificial, file = "cg_items_c_artificial.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)#run the model
set.seed(123)
mod_cg_artificial <- mirt(cg_items_c_artificial, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_cg_artificial <- M2(mod_cg_artificial, type="C2")This model was acceptable. Its fit were: stats M2 1.777595e+03 df 1.224000e+03 p 0.000000e+00 RMSEA 2.428330e-02 RMSEA_5 2.176405e-02 RMSEA_95 2.669580e-02 SRMSR 1.385304e-01 TLI 9.958703e-01 CFI 9.960355e-01
coef(mod_cg_artificial, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| cg_1_2 | 1.765 | -4.533 | -3.523 |
| cg_2_2 | 1.956 | -4.002 | -2.931 |
| cg_3_2 | 2.133 | -3.693 | -2.889 |
| cg_4_2 | 1.853 | -4.153 | -3.071 |
| cg_5_2 | 2.463 | -3.245 | -2.536 |
| cg_6_2 | 2.475 | -3.122 | -2.442 |
| cg_4_4 | 3.618 | -2.948 | -2.355 |
| cg_5_4 | 2.299 | -2.980 | -2.240 |
| cg_1_6 | 2.765 | -2.399 | -1.666 |
| cg_2_6 | 4.286 | -2.301 | -1.789 |
| cg_3_6 | 3.564 | -2.179 | -1.693 |
| cg_4_6 | 2.925 | -2.434 | -1.944 |
| cg_5_6 | 2.756 | -1.821 | -1.411 |
| cg_6_6 | 3.032 | -1.950 | -1.558 |
| cg_5_8 | 3.219 | -1.800 | -1.240 |
| cg_6_8 | 2.969 | -1.717 | -1.228 |
| cg_4_10 | 2.820 | -1.559 | -1.035 |
| cg_5_10 | 3.282 | -1.288 | -0.916 |
| cg_6_10 | 3.349 | -1.479 | -1.083 |
| cg_4_12 | 3.811 | -1.152 | -0.777 |
| cg_5_12 | 3.633 | -0.990 | -0.646 |
| cg_6_12 | 4.465 | -0.648 | -0.362 |
| cg_4_14 | 3.838 | -0.743 | -0.383 |
| cg_5_14 | 4.271 | -0.865 | -0.511 |
| cg_6_14 | 3.301 | -0.133 | 0.288 |
| cg_5_16 | 4.242 | -0.500 | -0.202 |
| cg_6_16 | 3.969 | -0.754 | -0.351 |
| cg_5_18 | 3.813 | 0.598 | 0.850 |
| cg_6_18 | 3.574 | -0.665 | -0.236 |
| cg_3_20 | 3.498 | -0.741 | -0.382 |
| cg_4_20 | 3.107 | -0.863 | -0.468 |
| cg_5_20 | 3.931 | -0.261 | 0.152 |
| cg_6_20 | 3.186 | -0.207 | 0.150 |
| cg_3_22 | 3.768 | -0.335 | 0.002 |
| cg_4_24 | 4.161 | -0.254 | 0.086 |
| cg_6_24 | 4.118 | -0.070 | 0.427 |
| cg_3_27 | 3.280 | -0.290 | 0.152 |
| cg_6_27 | 4.753 | 0.564 | 0.722 |
| cg_5_30 | 4.485 | 0.453 | 0.702 |
| cg_6_30 | 4.327 | 0.670 | 0.946 |
| cg_5_36 | 4.045 | 0.171 | 0.542 |
| cg_6_36 | 4.431 | 0.768 | 1.075 |
| cg_5_42 | 4.874 | 0.860 | 1.093 |
| cg_6_42 | 4.085 | 0.447 | 0.676 |
| cg_3_48 | 3.444 | 0.385 | 0.892 |
| cg_4_48 | 4.577 | 0.802 | 1.066 |
| cg_6_48 | 4.472 | 0.845 | 1.130 |
| cg_6_54 | 3.541 | 1.044 | 1.418 |
| cg_5_54 | 3.695 | 1.211 | 1.676 |
| cg_4_60 | 4.505 | 1.014 | 1.399 |
| cg_6_60 | 3.682 | 1.192 | 1.387 |
4.4 Take away message
mirt package did not compute a valid model when missing data were present. Its coefficient results should be seen carefully.
mirt package could compute a model when the dataset had artificial imputation (2s and 0s). Its results allow conclude that this model is well-adjusted.
5 Communication
5.1 Dataset (Missing data allowed)
The following code repeats the process described in the beginning.
cm_original <- asqi_cm_online
#Slice the data
cm_items_na <- cm_original %>%
select(cm_floor:cm_18_p) #get all ASQ-I items
#change names
cm_items_na <- cm_items_na %>%
rename_at(vars(-cm_floor, -cm_ceiling),
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
#change str for numeric
cm_items_na <- cm_items_na %>%
mutate_at(vars(cm_floor, cm_ceiling),
list(~as.numeric(.))) #now, all variables are numeric
# change items to 0,1 and 2
options(tibble.print_max = Inf)
#cm_items_na %>% select(-cm_floor, -cm_ceiling) %>% skimr::skim_to_list(.)
psych::describe(cm_items_na)## vars n mean sd median trimmed mad min max range skew
## cm_floor 1 850 19.55 12.79 18 19.06 14.83 1 43 42 0.28
## cm_ceiling 2 666 33.86 11.99 32 32.84 10.38 6 67 61 0.74
## y1 3 850 1.94 0.29 2 2.00 0.00 0 2 2 -5.11
## y2 4 850 1.95 0.25 2 2.00 0.00 0 2 2 -5.87
## y3 5 850 1.94 0.29 2 2.00 0.00 0 2 2 -5.12
## y4 6 850 1.93 0.30 2 2.00 0.00 0 2 2 -4.63
## y5 7 850 1.96 0.21 2 2.00 0.00 0 2 2 -6.35
## y6 8 850 1.91 0.33 2 2.00 0.00 0 2 2 -3.70
## y7 9 850 1.94 0.29 2 2.00 0.00 0 2 2 -5.50
## y8 10 850 1.94 0.26 2 2.00 0.00 0 2 2 -4.64
## y9 11 850 1.90 0.35 2 2.00 0.00 0 2 2 -3.58
## y10 12 850 1.92 0.30 2 2.00 0.00 0 2 2 -4.13
## y11 13 850 1.87 0.42 2 2.00 0.00 0 2 2 -3.37
## y12 14 850 1.82 0.47 2 1.96 0.00 0 2 2 -2.74
## y13 15 850 1.76 0.57 2 1.90 0.00 0 2 2 -2.21
## y14 16 850 1.79 0.57 2 1.96 0.00 0 2 2 -2.58
## y15 17 850 1.66 0.61 2 1.79 0.00 0 2 2 -1.58
## y16 18 850 1.74 0.64 2 1.92 0.00 0 2 2 -2.16
## y17 19 850 1.71 0.53 2 1.81 0.00 0 2 2 -1.69
## y18 20 850 1.48 0.82 2 1.61 0.00 0 2 2 -1.10
## y19 21 850 1.59 0.75 2 1.74 0.00 0 2 2 -1.44
## y20 22 850 1.41 0.86 2 1.52 0.00 0 2 2 -0.90
## y21 23 850 1.38 0.87 2 1.48 0.00 0 2 2 -0.82
## y22 24 850 1.36 0.91 2 1.45 0.00 0 2 2 -0.76
## y23 25 850 1.29 0.91 2 1.36 0.00 0 2 2 -0.60
## y24 26 850 1.16 0.93 2 1.21 0.00 0 2 2 -0.33
## y25 27 850 1.12 0.97 2 1.15 0.00 0 2 2 -0.23
## y26 28 850 1.13 0.94 2 1.16 0.00 0 2 2 -0.26
## y27 29 850 1.12 0.95 2 1.15 0.00 0 2 2 -0.24
## y28 30 850 1.01 0.96 1 1.01 1.48 0 2 2 -0.01
## y29 31 850 1.08 0.95 1 1.10 1.48 0 2 2 -0.17
## y30 32 850 0.96 0.99 0 0.94 0.00 0 2 2 0.09
## y31 33 850 0.94 0.97 0 0.93 0.00 0 2 2 0.11
## y32 34 850 0.87 0.94 0 0.84 0.00 0 2 2 0.26
## y33 35 850 0.87 0.98 0 0.84 0.00 0 2 2 0.27
## y34 36 850 0.80 0.92 0 0.74 0.00 0 2 2 0.42
## y35 37 850 0.83 0.96 0 0.79 0.00 0 2 2 0.34
## y36 38 850 0.75 0.95 0 0.69 0.00 0 2 2 0.51
## y37 39 850 0.62 0.90 0 0.53 0.00 0 2 2 0.81
## y38 40 850 0.65 0.92 0 0.56 0.00 0 2 2 0.75
## y39 41 850 0.64 0.90 0 0.55 0.00 0 2 2 0.78
## y40 42 850 0.62 0.90 0 0.53 0.00 0 2 2 0.81
## y41 43 850 0.54 0.84 0 0.42 0.00 0 2 2 1.03
## y42 44 850 0.54 0.84 0 0.42 0.00 0 2 2 1.04
## y43 45 850 0.56 0.87 0 0.44 0.00 0 2 2 0.99
## y44 46 850 0.50 0.83 0 0.38 0.00 0 2 2 1.14
## y45 47 435 0.69 0.89 0 0.61 0.00 0 2 2 0.66
## y46 48 435 0.68 0.91 0 0.60 0.00 0 2 2 0.66
## y47 49 435 0.69 0.92 0 0.61 0.00 0 2 2 0.65
## y48 50 435 0.66 0.90 0 0.58 0.00 0 2 2 0.72
## y49 51 435 0.61 0.82 0 0.52 0.00 0 2 2 0.81
## y50 52 850 0.42 0.78 0 0.28 0.00 0 2 2 1.40
## y51 53 850 0.42 0.77 0 0.28 0.00 0 2 2 1.41
## y52 54 435 0.57 0.84 0 0.46 0.00 0 2 2 0.95
## y53 55 435 0.61 0.88 0 0.51 0.00 0 2 2 0.84
## y54 56 850 0.39 0.73 0 0.24 0.00 0 2 2 1.51
## y55 57 435 0.55 0.84 0 0.44 0.00 0 2 2 1.01
## y56 58 435 0.57 0.86 0 0.47 0.00 0 2 2 0.93
## y57 59 435 0.51 0.83 0 0.39 0.00 0 2 2 1.12
## y58 60 435 0.46 0.78 0 0.33 0.00 0 2 2 1.27
## y59 61 850 0.30 0.65 0 0.13 0.00 0 2 2 1.91
## y60 62 850 0.30 0.67 0 0.12 0.00 0 2 2 1.96
## y61 63 435 0.39 0.71 0 0.24 0.00 0 2 2 1.50
## y62 64 435 0.42 0.76 0 0.27 0.00 0 2 2 1.42
## y63 65 435 0.35 0.69 0 0.19 0.00 0 2 2 1.67
## y64 66 850 0.25 0.63 0 0.07 0.00 0 2 2 2.22
## y65 67 467 2.43 4.07 0 1.80 0.00 0 10 10 1.19
## y66 68 52 8.85 2.35 10 9.29 0.00 0 10 10 -1.78
## y67 69 52 9.81 0.97 10 10.00 0.00 5 10 5 -4.66
## y68 70 52 8.75 2.40 10 9.17 0.00 0 10 10 -1.63
## y69 71 52 8.65 2.64 10 9.17 0.00 0 10 10 -1.76
## y70 72 52 8.94 2.29 10 9.40 0.00 0 10 10 -1.96
## y71 73 52 8.65 2.99 10 9.40 0.00 0 10 10 -2.00
## y72 74 52 8.85 2.55 10 9.40 0.00 0 10 10 -2.07
## kurtosis se
## cm_floor -0.98 0.44
## cm_ceiling 0.12 0.46
## y1 26.91 0.01
## y2 36.71 0.01
## y3 27.22 0.01
## y4 22.42 0.01
## y5 43.88 0.01
## y6 14.10 0.01
## y7 30.86 0.01
## y8 22.98 0.01
## y9 12.99 0.01
## y10 17.87 0.01
## y11 10.72 0.01
## y12 6.66 0.02
## y13 3.63 0.02
## y14 5.05 0.02
## y15 1.32 0.02
## y16 2.92 0.02
## y17 1.93 0.02
## y18 -0.61 0.03
## y19 0.32 0.03
## y20 -1.05 0.03
## y21 -1.18 0.03
## y22 -1.35 0.03
## y23 -1.53 0.03
## y24 -1.76 0.03
## y25 -1.90 0.03
## y26 -1.82 0.03
## y27 -1.84 0.03
## y28 -1.91 0.03
## y29 -1.88 0.03
## y30 -1.97 0.03
## y31 -1.93 0.03
## y32 -1.83 0.03
## y33 -1.91 0.03
## y34 -1.70 0.03
## y35 -1.83 0.03
## y36 -1.70 0.03
## y37 -1.26 0.03
## y38 -1.39 0.03
## y39 -1.32 0.03
## y40 -1.28 0.03
## y41 -0.78 0.03
## y42 -0.79 0.03
## y43 -0.96 0.03
## y44 -0.59 0.03
## y45 -1.41 0.04
## y46 -1.46 0.04
## y47 -1.49 0.04
## y48 -1.37 0.04
## y49 -1.04 0.04
## y50 0.11 0.03
## y51 0.18 0.03
## y52 -0.92 0.04
## y53 -1.19 0.04
## y54 0.55 0.03
## y55 -0.83 0.04
## y56 -0.99 0.04
## y57 -0.60 0.04
## y58 -0.17 0.04
## y59 2.07 0.02
## y60 2.09 0.02
## y61 0.62 0.03
## y62 0.24 0.04
## y63 1.15 0.03
## y64 3.22 0.02
## y65 -0.44 0.19
## y66 2.32 0.33
## y67 20.12 0.13
## y68 1.72 0.33
## y69 2.19 0.37
## y70 3.06 0.32
## y71 2.69 0.41
## y72 3.43 0.35#Replace 5 and 10 values to the righ code (5 equals 1, and 10 equals 2)
cm_items_na <- cm_items_na %>%
mutate_at(vars(-cm_floor, -cm_ceiling),
list(~case_when(. == 5 ~ 1, . == 10 ~ 2,
TRUE ~ .))) #changing values
#replace na with the first/last option possible
#if the floor or the ceiling were missing, I'll fix it.
cm_items_na <- cm_items_na %>%
mutate_at(vars(cm_floor), list(~if_else(is.na(.),1,.)))
cm_items_na <- cm_items_na %>%
mutate_at(vars(cm_ceiling), list(~if_else(is.na(.),72,.)))
#Now I'll run the function I've created
cm_items_na %>%
mutate(rowIdx = 1:n()) %>%
gather(col, value, starts_with("y")) %>%
mutate(value = altMask(parse_number(col), value, cm_floor, cm_ceiling)) %>%
spread(col, value) %>%
arrange(rowIdx) %>%
select(-rowIdx) -> cm_items_na
#Order
cm_items_na <- cm_items_na %>% select(cm_floor, cm_ceiling, paste("y", seq(1, ncol(select(., starts_with("y"))), 1), sep=""), everything())
#supress floor and cm_items
cm_items_na <- cm_items_na %>% select(-cm_floor, -cm_ceiling)
#chcking missing quantity
plot_missing(cm_items_na)
The plot below shows the missing quantity in this domain:
I’ll run the IRT model.
5.2 Communication with missing data
#run the model
set.seed(123)
mod_cm_na <- mirt(cm_items_na, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_cm_na <- M2(mod_cg_na, type="C2", calcNull = FALSE, na.rm=TRUE)#replace NA by -99
cm_items_na <- cm_items_na %>%
mutate_all(., funs(replace_na(., -9)))
write.table(cm_items_na, file = "cm_items_na.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)5.3 Communication IRT with Artificial imputation
Now I’ll test the dataset with the artificial imputation (2s and 0s). Note this dataset has no missing data.
cm_original <- asqi_cm_online
#get entire data
cm_items_c_artificial <- cm_original %>%
select(cm_floor:cm_18_p) #get all ASQ-I items
#Slice the data
items_up60 <- c(
"cm_1_2",
"cm_2_2",
"cm_3_2",
"cm_4_2",
"cm_5_2",
"cm_6_2",
"cm_3_4",
"cm_4_4",
"cm_5_4",
"cm_6_4",
"cm_2_6",
"cm_3_6",
"cm_4_6",
"cm_5_6",
"cm_6_6",
"cm_5_8",
"cm_6_8",
"cm_4_10",
"cm_5_10",
"cm_6_10",
"cm_5_12",
"cm_6_12",
"cm_3_14",
"cm_4_14",
"cm_5_14",
"cm_6_14",
"cm_5_16",
"cm_6_16",
"cm_4_20",
"cm_5_20",
"cm_3_22",
"cm_5_18",
"cm_6_18",
"cm_4_22",
"cm_5_22",
"cm_6_27",
"cm_5_27",
"cm_6_30",
"cm_5_33",
"cm_6_33",
"cm_6_36",
"cm_5_42",
"cm_6_42",
"cm_1_48",
"cm_2_48",
"cm_3_48",
"cm_4_48",
"cm_5_54",
"cm_6_54",
"cm_6_60",
"cm_4_60",
"cm_1_p",
"cm_2_p",
"cm_3_p",
"cm_4_p",
"cm_5_p",
"cm_6_p",
"cm_7_p",
"cm_8_p",
"cm_9_p",
"cm_10_p",
"cm_11_p",
"cm_12_p",
"cm_13_p",
"cm_14_p",
"cm_15_p",
"cm_16_p",
"cm_17_p",
"cm_18_p",
"cm_19_p",
"cm_20_p",
"cm_21_p")
cm_items_c_artificial <- cm_items_c_artificial %>%
select(items_up60)
cm_items_c_artificial <- cm_items_c_artificial %>%
dplyr::select(-c("cm_4_48",ends_with("_p")))
#check
plot_missing(cm_items_c_artificial)
# to flexmirt
write.table(cm_items_c_artificial, file = "cm_items_c_artificial.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)#run the model
set.seed(123)
mod_cm_artificial <- mirt(cm_items_c_artificial, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_cm_artificial <- M2(mod_cm_artificial, type="C2")The model had an excellent fit. 2706.1340152, 1175, 0, 0.0391772, 0.0372195, 0.0410919, 0.0918224, 0.9901948, 0.990595. The coefficients are reported in the next table.
coef(mod_cm_artificial, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| cm_1_2 | 1.837 | -3.481 | -2.635 |
| cm_2_2 | 3.489 | -2.927 | -2.214 |
| cm_3_2 | 2.934 | -3.080 | -1.958 |
| cm_4_2 | 2.747 | -3.623 | -2.568 |
| cm_5_2 | 2.445 | -2.655 | -1.912 |
| cm_6_2 | 2.631 | -3.374 | -2.480 |
| cm_3_4 | 2.075 | -2.657 | -1.153 |
| cm_4_4 | 2.334 | -3.300 | -2.320 |
| cm_5_4 | 4.165 | -2.764 | -2.256 |
| cm_6_4 | 3.091 | -3.391 | -2.189 |
| cm_2_6 | 1.993 | -2.694 | -1.766 |
| cm_3_6 | 3.074 | -2.921 | -1.884 |
| cm_4_6 | 3.278 | -3.098 | -2.021 |
| cm_5_6 | 3.438 | -1.928 | -1.604 |
| cm_6_6 | 2.532 | -2.086 | -1.025 |
| cm_5_8 | 2.797 | -2.110 | -1.390 |
| cm_6_8 | 3.874 | -1.695 | -1.450 |
| cm_4_10 | 3.851 | -1.207 | -0.832 |
| cm_5_10 | 4.918 | -0.999 | -0.654 |
| cm_6_10 | 3.951 | -0.880 | -0.690 |
| cm_5_12 | 4.170 | -1.046 | -0.726 |
| cm_6_12 | 3.796 | -0.824 | -0.478 |
| cm_3_14 | 3.425 | -0.641 | -0.226 |
| cm_4_14 | 3.332 | -1.448 | -1.035 |
| cm_5_14 | 5.773 | -0.427 | -0.273 |
| cm_6_14 | 5.153 | -0.523 | -0.183 |
| cm_5_16 | 5.508 | 0.091 | 0.301 |
| cm_6_16 | 6.665 | -0.096 | -0.001 |
| cm_4_20 | 5.173 | -0.126 | 0.086 |
| cm_5_20 | 4.473 | -0.556 | -0.175 |
| cm_3_22 | 4.604 | -0.299 | 0.029 |
| cm_5_18 | 4.413 | -0.454 | -0.118 |
| cm_6_18 | 7.031 | 0.265 | 0.437 |
| cm_4_22 | 6.583 | 0.080 | 0.167 |
| cm_5_22 | 4.990 | 0.501 | 0.738 |
| cm_6_27 | 4.623 | -0.043 | 0.332 |
| cm_5_27 | 8.091 | 0.522 | 0.745 |
| cm_6_30 | 6.262 | 0.506 | 0.772 |
| cm_5_33 | 4.159 | 0.076 | 0.521 |
| cm_6_33 | 5.115 | 0.498 | 0.679 |
| cm_6_36 | 3.847 | 1.261 | 1.553 |
| cm_5_42 | 4.401 | 0.641 | 1.037 |
| cm_6_42 | 7.449 | 0.944 | 1.349 |
| cm_1_48 | 6.503 | 0.775 | 1.046 |
| cm_2_48 | 5.674 | 0.660 | 1.007 |
| cm_3_48 | 7.106 | 0.918 | 1.249 |
| cm_5_54 | 7.224 | 0.705 | 0.884 |
| cm_6_54 | 6.744 | 0.956 | 1.217 |
| cm_6_60 | 6.038 | 1.144 | 1.551 |
| cm_4_60 | 4.077 | 1.372 | 1.620 |
5.4 Take away message
mirt package did not compute a valid model when missing data were present. Its coefficient results should be seen carefully.
mirt package could compute a model when the dataset had artificial imputation (2s and 0s). Its results allow conclude that this model is well-adjusted.
6 Personal and social
6.1 Dataset (Missing data allowed)
The following code repeats the process described in the beginning.
ps_original <- asqi_ps_online
#Slice the data
ps_items_na <- ps_original %>%
select(ps_floor:ps_12a_p) #get all ASQ-I items
#change names
ps_items_na <- ps_items_na %>%
rename_at(vars(-ps_floor, -ps_ceiling),
function(x) paste0("y",seq(1:length(x)))) #rename items to make everything easier to understand
#change str for numeric
ps_items_na <- ps_items_na %>%
mutate_at(vars(ps_floor, ps_ceiling),
funs(as.numeric(.))) #now, all variables are numeric
#replace na with the first/last option possible
#if the floor or the ceiling were missing, I'll fix it.
ps_items_na <- ps_items_na %>%
mutate_at(vars(ps_floor), funs(if_else(is.na(.),1,.)))
ps_items_na <- ps_items_na %>%
mutate_at(vars(ps_ceiling), funs(if_else(is.na(.),87,.)))
#Now I'll run the function I've created
ps_items_na %>%
mutate(rowIdx = 1:n()) %>%
gather(col, value, starts_with("y")) %>%
mutate(value = altMask(parse_number(col), value, ps_floor, ps_ceiling)) %>%
spread(col, value) %>%
arrange(rowIdx) %>%
select(-rowIdx) -> ps_items_na
#Order
ps_items_na <- ps_items_na %>% select(ps_floor, ps_ceiling, paste("y", seq(1, ncol(select(., starts_with("y"))), 1), sep=""), everything())
#supress floor and cm_items
ps_items_na <- ps_items_na %>% select(-ps_floor, -ps_ceiling)
#chcking missing quantity
plot_missing(ps_items_na)
The plot below shows the missing quantity in this domain:
I’ll run the IRT model.
6.3 Personal and social IRT with Artificial imputation
Now I’ll test the dataset with the artificial imputation (2s and 0s). Note this dataset has no missing data.
#Get entire dataset
ps_items_c_artificial <- asqi_ps_online
items_up60 <- c(
"ps_1_2",
"ps_2_2",
"ps_3_2",
"ps_4_2",
"ps_5_2",
"ps_6_2",
"ps_2_4",
"ps_4_4",
"ps_5_4",
"ps_6_4",
"ps_2_6",
"ps_3_6",
"ps_4_6",
"ps_5_6",
"ps_6_6",
"ps_5_8",
"ps_6_8",
"ps_4_10",
"ps_5_10",
"ps_6_10",
"ps_4_12",
"ps_5_12",
"ps_6_12",
"ps_4_14",
"ps_5_14",
"ps_6_14",
"ps_4_16",
"ps_6_16",
"ps_5_18",
"ps_6_18",
"ps_5_20",
"ps_6_20",
"ps_2_22",
"ps_6_22",
"ps_6_24",
"ps_6_27",
"ps_2_30",
"ps_5_30",
"ps_6_30",
"ps_6_33",
"ps_6_36",
"ps_5_42",
"ps_6_42",
"ps_2_48",
"ps_4_48",
"ps_5_48",
"ps_6_48",
"ps_6_54",
"ps_5_60",
"ps_6_60",
"ps_1s_p",
"ps_2s_p",
"ps_3s_p",
"ps_4s_p",
"ps_5s_p",
"ps_6s_p",
"ps_7s_p",
"ps_8s_p",
"ps_9s_p",
"ps_10s_p",
"ps_11s_p",
"ps_12s_p",
"ps_13s_p",
"ps_14s_p",
"ps_15s_p",
"ps_16s_p",
"ps_17s_p",
"ps_18s_p",
"ps_20s_p",
"ps_19s_p",
"ps_21s_p",
"ps_22s_p",
"ps_23s_p",
"ps_24s_p",
"ps_1a_p",
"ps_2a_p",
"ps_3a_p",
"ps_4a_p",
"ps_5a_p",
"ps_6a_p",
"ps_7a_p",
"ps_8a_p",
"ps_9a_p",
"ps_10a_p",
"ps_11a_p",
"ps_12a_p",
"ps_13a_p")
#create ds
ps_items_c_artificial <- ps_items_c_artificial %>%
dplyr::select(items_up60)
#check for missing
plot_missing(ps_items_c_artificial)
#remove missing
ps_items_c_artificial <- ps_items_c_artificial %>%
dplyr::select(-c(ends_with("_p")))
#check
plot_missing(ps_items_c_artificial)
# to flexmirt
write.table(ps_items_c_artificial, file = "ps_items_c_artificial.dat", row.names=FALSE, col.names = FALSE, sep = "\t", quote = FALSE)#run the model
set.seed(123)
mod_ps_artificial <- mirt(ps_items_c_artificial, 1, itemtype = "graded", method = "MHRM", technical=list(NCYCLES=2000))
#check the fit statistics
m2_ps_artificial <- M2(mod_ps_artificial, type="C2")The GoF indices for this model was computed and the results report a almost perfect fit: 2952.0158275, 1175, 0, 0.0338871, 0.0323518, 0.0354012, 0.1248548, 0.9911159, 0.9914785. The coefficients are reported below:
coef(mod_ps_artificial, IRTpars=TRUE, simplify = TRUE) %>%
data.frame(.) %>%
select(-means, -F1) %>%
kable(., digits = 3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))| items.a | items.b1 | items.b2 | |
|---|---|---|---|
| ps_1_2 | 1.032 | -5.324 | -3.770 |
| ps_2_2 | 0.963 | -6.564 | -4.756 |
| ps_3_2 | 1.248 | -5.317 | -3.840 |
| ps_4_2 | 1.738 | -3.931 | -2.796 |
| ps_5_2 | 2.086 | -3.274 | -2.264 |
| ps_6_2 | 1.490 | -3.971 | -3.156 |
| ps_2_4 | 1.707 | -3.035 | -2.202 |
| ps_4_4 | 1.854 | -2.916 | -1.985 |
| ps_5_4 | 1.909 | -3.413 | -2.457 |
| ps_6_4 | 2.140 | -2.697 | -1.953 |
| ps_2_6 | 1.759 | -2.447 | -1.431 |
| ps_3_6 | 2.308 | -2.356 | -1.772 |
| ps_4_6 | 2.786 | -1.921 | -1.466 |
| ps_5_6 | 2.351 | -2.010 | -1.258 |
| ps_6_6 | 2.814 | -2.265 | -1.825 |
| ps_5_8 | 3.023 | -1.567 | -1.218 |
| ps_6_8 | 4.318 | -1.517 | -1.371 |
| ps_4_10 | 3.468 | -1.358 | -0.838 |
| ps_5_10 | 3.152 | -1.580 | -1.106 |
| ps_6_10 | 3.964 | -1.119 | -0.457 |
| ps_4_12 | 3.906 | -1.038 | -0.601 |
| ps_5_12 | 3.952 | -0.967 | -0.562 |
| ps_6_12 | 2.843 | -1.162 | -0.743 |
| ps_4_14 | 4.175 | -0.810 | -0.369 |
| ps_5_14 | 3.675 | -0.636 | -0.213 |
| ps_6_14 | 3.779 | -0.787 | -0.526 |
| ps_4_16 | 1.897 | 0.036 | 0.666 |
| ps_6_16 | 4.564 | -0.769 | -0.423 |
| ps_5_18 | 3.554 | -0.421 | 0.064 |
| ps_6_18 | 4.844 | -0.814 | -0.491 |
| ps_5_20 | 3.211 | -0.114 | 0.262 |
| ps_6_20 | 3.945 | -0.356 | 0.114 |
| ps_2_22 | 4.284 | -0.835 | -0.439 |
| ps_6_22 | 3.867 | -0.814 | -0.500 |
| ps_6_24 | 3.725 | 0.283 | 0.534 |
| ps_6_27 | 3.711 | 0.515 | 0.932 |
| ps_2_30 | 4.071 | -0.483 | 0.028 |
| ps_5_30 | 4.258 | 0.148 | 0.559 |
| ps_6_30 | 4.502 | 0.090 | 0.287 |
| ps_6_33 | 3.545 | 0.469 | 0.654 |
| ps_6_36 | 2.692 | -0.269 | 0.655 |
| ps_5_42 | 3.110 | 0.405 | 0.804 |
| ps_6_42 | 3.857 | 0.356 | 0.721 |
| ps_2_48 | 3.176 | 0.770 | 0.968 |
| ps_4_48 | 3.055 | 0.337 | 0.602 |
| ps_5_48 | 3.123 | 0.597 | 1.065 |
| ps_6_48 | 3.415 | 0.469 | 0.909 |
| ps_6_54 | 2.769 | 0.983 | 1.515 |
| ps_5_60 | 3.207 | 0.696 | 0.966 |
| ps_6_60 | 2.597 | -0.305 | 0.822 |
6.4 Take away message
6.5 Take away message
mirt package did not compute a valid model when missing data were present. Its coefficient results should be seen carefully.
mirt package could compute a model when the dataset had artificial imputation (2s and 0s). Its results allow conclude that this model is well-adjusted.