hmcdm 2.1.0

Author: sunbeomk

.DS_Store

@@ -1,7 +1,7 @@
 Package: hmcdm
 Type: Package
 Title: Hidden Markov Cognitive Diagnosis Models for Learning
-Version: 2.1.0.9000
+Version: 2.1.0
 Authors@R: c(
  person("Susu", "Zhang", email = "szhan105@illinois.edu", role = c("aut")),
  person("Shiyu", "Wang", email = "swang44@uga.edu", role = c("aut")),

DESCRIPTION

@@ -6,21 +6,15 @@ S3method(print,summary.hmcdm)
 S3method(summary,hmcdm)
 export(ETAmat)
 export(OddsRatio)
-export(Q_list)
 export(Q_list_g)
 export(TPmat)
 export(hmcdm)
 export(inv_bijectionvector)
 export(rOmega)
 export(random_Q)
-export(simDINA)
-export(simNIDA)
 export(sim_RT)
-export(simrRUM)
-export(simulate_alphas_FOHM)
-export(simulate_alphas_HO_joint)
-export(simulate_alphas_HO_sep)
-export(simulate_alphas_indept)
+export(sim_alphas)
+export(sim_hmcdm)
 import(bayesplot)
 import(rstantools)
 importFrom(Rcpp,evalCpp)

NAMESPACE

@@ -1,3 +1,7 @@
+# hmcdm 2.1.0
+
+- Release of `hmcdm` package version 2.1.0.
+
 # hmcdm 2.0.0
 
 - Release of `hmcdm` package version 2.0.0.

NEWS.md

@@ -54,3 +54,17 @@
 #' @author Shiyu Wang, Yan Yang, Jeff Douglas, and Steve Culpepper
 'Test_order'
 
+
+#' Design array
+#' 
+#' `Design_array` contains item administration information at all time points in the Spatial 
+#' Rotation Learning Program.
+#' @format An array of dimension N-by-J-by-L, containing each subject's item administration.
+#' @details The data object `"Design_array"` contains an array of dimension N-by-J-by-L 
+#' indicating the items assigned (1/0) to each subject at each time point. 
+#' @source Spatial Rotation Learning Experiment at UIUC between Fall 2015 and Spring 2016.
+#' @author Shiyu Wang, Yan Yang, Jeff Douglas, and Steve Culpepper
+"Design_array"
+
+
+

R/RcppExports.R

@@ -20,7 +20,7 @@
 #' Zhang, S., Douglas, J. A., Wang, S. & Culpepper, S. A. (2019) <doi:10.1007/978-3-030-05584-4_24>
 #' @examples
 #' \donttest{
-#' output_FOHM = hmcdm(Y_real_array,Q_matrix,"DINA_FOHM",Test_order,Test_versions,10000,5000)
+#' output_FOHM = hmcdm(Y_real_array,Q_matrix,"DINA_FOHM",Design_array,1000,500)
 #' library(bayesplot)
 #' pp_check(output_FOHM)
 #' pp_check(output_FOHM, plotfun="hist", type="item_mean")
@@ -29,50 +29,47 @@
 pp_check.hmcdm <- function(object,plotfun="dens_overlay",type="total_score"){
  N <- dim(object$input_data$Response)[1]
  L <- dim(object$input_data$Response)[3]
- Jt <- dim(object$input_data$Response)[2]
- J <- Jt*L
+ J <- dim(object$input_data$Response)[2]
 
- Y_sim <- Dense2Sparse(object$input_data$Response, object$input_data$Test_order, object$input_data$Test_versions)
- Y_sim_array <- Sparse2Dense(Y_sim, object$input_data$Test_order, object$input_data$Test_versions)
- Test_order <- object$input_data$Test_order
- Test_versions <- object$input_data$Test_versions
- Q_matrix <- Array2Mat(object$input_data$Qs)
+ Y_sim <- object$input_data$Response
+ Design_array <- object$input_data$Design_array
+ Q_matrix <- object$input_data$Q_matrix
  Q_examinee <- object$input_data$Q_examinee
+ 
  Y_sim_collapsed <- matrix(NA,N,J)
  for(i in 1:N){
- test_i <- object$input_data$Test_versions[i]
  for(t in 1:L){
- t_i = object$input_data$Test_order[test_i,t]
- Y_sim_collapsed[i,(Jt*(t_i-1)+1):(Jt*t_i)] <- Y_sim_array[i,,t]
+ block_it <- which(!is.na(Design_array[i,,t]))
+ Y_sim_collapsed[i,block_it] <- Y_sim[i,block_it,t]
  }
  }
 
  if(object$Model == "DINA_HO"){
- object_fit <- Learning_fit(object, "DINA_HO", Y_sim,Q_matrix, 
- Test_order, Test_versions, Q_examinee)
+ object_fit <- Learning_fit_g(object, "DINA_HO", Y_sim,Q_matrix, 
+ Design_array, Q_examinee)
  }
  if(object$Model == "DINA_HO_RT_sep" | object$Model == "DINA_HO_RT_joint"){
- L_sim <- Dense2Sparse(object$input_data$Latency, object$input_data$Test_order, object$input_data$Test_versions)
- object_fit <- Learning_fit(object,object$Model,Y_sim,Q_matrix,
- object$input_data$Test_order,object$input_data$Test_versions,
+ L_sim <- object$input_data$Latency
+ object_fit <- Learning_fit_g(object,object$Model,Y_sim,Q_matrix,
+ Design_array,
  Q_examinee=object$input_data$Q_examinee,
- Latency_array = object$input_data$Latency, G_version = object$input_data$G_version)
+ Latency_array = L_sim, G_version = object$input_data$G_version)
  }
  if(object$Model == "rRUM_indept" | object$Model == "NIDA_indept"){
- object_fit <- Learning_fit(object,object$Model,Y_sim,Q_matrix,
- object$input_data$Test_order,object$input_data$Test_versions,
+ object_fit <- Learning_fit_g(object,object$Model,Y_sim,Q_matrix,
+ Design_array,
  R=object$input_data$R)
  }
  if(object$Model == "DINA_FOHM"){
- object_fit <- Learning_fit(object,"DINA_FOHM",Y_sim,Q_matrix,
- object$input_data$Test_order,object$input_data$Test_versions)
+ object_fit <- Learning_fit_g(object,"DINA_FOHM",Y_sim,Q_matrix,
+ Design_array)
  }
 
  if(type=="total_score"){
  ## total score
  total_score_obs <- matrix(NA, N, L)
  for(t in 1:L){
- total_score_obs[,t] <- rowSums(object$input_data$Response[,,t])
+ total_score_obs[,t] <- rowSums(object$input_data$Response[,,t], na.rm=TRUE)
  }
  obs <- rowSums(total_score_obs)
  pp <- apply(object_fit$PPs$total_score_PP,1,colSums)
@@ -81,7 +78,7 @@ pp_check.hmcdm <- function(object,plotfun="dens_overlay",type="total_score"){
  ## Item means
  obs <- rep(NA, J)
  for(j in 1:J){
- obs[j] <- mean(Y_sim_collapsed[,j])
+ obs[j] <- mean(Y_sim_collapsed[,j], na.rm=TRUE)
  }
  pp <- t(object_fit$PPs$item_mean_PP)
  }
@@ -98,27 +95,25 @@ pp_check.hmcdm <- function(object,plotfun="dens_overlay",type="total_score"){
  pp <- log(ORs_pp)
  }
  if(type=="latency_mean"){
- L_sim_array <- Sparse2Dense(L_sim, object$input_data$Test_order, object$input_data$Test_versions)
  L_sim_collapsed <- matrix(NA,N,J)
  for(i in 1:N){
- test_i <- object$input_data$Test_versions[i]
  for(t in 1:L){
- t_i = object$input_data$Test_order[test_i,t]
- L_sim_collapsed[i,(Jt*(t_i-1)+1):(Jt*t_i)] <- L_sim_array[i,,t]
+ block_it <- which(!is.na(Design_array[i,,t]))
+ L_sim_collapsed[i,block_it] <- L_sim[i,block_it,t]
  }
  }
  ## latency means
  obs <- rep(NA, J)
  for(j in 1:J){
- obs[j] <- mean(L_sim_collapsed[,j])
+ obs[j] <- mean(L_sim_collapsed[,j], na.rm=TRUE)
  }
  pp <- t(object_fit$PPs$RT_mean_PP)
  }
  if(type=="total_latency"){
  ## total score
  total_latency_obs <- matrix(NA, N, L)
  for(t in 1:L){
- total_latency_obs[,t] <- rowSums(object$input_data$Latency[,,t])
+ total_latency_obs[,t] <- rowSums(object$input_data$Latency[,,t], na.rm=TRUE)
  }
  obs <- rowSums(total_latency_obs)
  pp <- apply(object_fit$PPs$total_time_PP,1,colSums)