2.0.8

Author: Wenchao-Ma

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: GDINA
 Type: Package
 Title: The Generalized DINA Model Framework
-Version: 2.0.5
-Date: 2018-3-26
+Version: 2.0.8
+Date: 2018-3-28
 Authors@R: c(person(given = "Wenchao",family = "Ma", role = c("aut", "cre", "cph"),email = "wenchao.ma@ua.edu"),person(given = "Jimmy", family = "de la Torre", role = c("aut", "cph")), person(given="Miguel",family = "Sorrel",role = "ctb"))
 Description: A set of psychometric tools for cognitive diagnosis modeling for both dichotomous and polytomous responses. Various cognitive diagnosis models can be estimated, include the generalized deterministic inputs, noisy and gate (G-DINA) model by de la Torre (2011) <DOI:10.1007/s11336-011-9207-7>, the sequential G-DINA model by Ma and de la Torre (2016) <DOI:10.1111/bmsp.12070>, and many other models they subsume. Joint attribute distribution can be independent, saturated, higher-order, loglinear smoothed or structured. Q-matrix validation, item and model fit statistics, model comparison at test and item level and differential item functioning can also be conducted. A graphical user interface is also provided.
 License: GPL-3

NEWS.md

@@ -1,5 +1,5 @@
-# GDINA 2.0.-
-* Fixed  - bugs in C++ codes
+# GDINA 2.0.7
+* bug fixed
 
 # GDINA 2.0
 * This is a major update including a large number of new features. The `GDINA` function has been largely rewritten for both flexibility and speed. 

R/Est.R

@@ -19,7 +19,7 @@ Est <- function(dat, Q, model, sequential,att.dist, att.prior,saturated,
   myControl <- list(
     maxitr = 2000,
     conv.crit = 1e-4,
-    conv.type = "max.ip.change",
+    conv.type = c("ip","mp"),
     nstarts = 3L,
     lower.p = 1e-4,
     upper.p = 1 - 1e-4,
@@ -322,7 +322,6 @@ Est <- function(dat, Q, model, sequential,att.dist, att.prior,saturated,
     neg2LL <- NA
   }
   initial.parm <- item.parm
-  parm0 <- list(ip = c(item.parm), prior = c(exp(logprior)), neg2LL = 0)
 
 
   ##############################
@@ -332,11 +331,13 @@ Est <- function(dat, Q, model, sequential,att.dist, att.prior,saturated,
   #############################
   itr <- 0L
   delta <- calc_delta(item.parm, DesignMatrices = DesignMatrices, linkfunc = linkfunc)
-  # parm0  <-  item.parm
+
+  parm0 <- list(ip = c(item.parm), prior = c(exp(logprior)), neg2LL = 0, delt = unlist(delta))
 
   dif.parm <- list(ip = 0,
                    prior = 0,
-                   neg2LL = 0)
+                   neg2LL = 0,
+                   delt = 0)
   ##############################
   #
   #           E-M
@@ -369,7 +370,7 @@ Est <- function(dat, Q, model, sequential,att.dist, att.prior,saturated,
                     auglag_args = auglag_args,solnp_args = solnp_args,nloptr_args = nloptr_args)
 
     item.parm <- optims$item.parm
-    delta <- c(optims$delta)
+    delta <- optims$delta
 
 
     struc.parm <- structural.parm(AlphaPattern = AlphaPattern, no.mg = no.mg, logprior=estep$logprior,
@@ -394,26 +395,31 @@ Est <- function(dat, Q, model, sequential,att.dist, att.prior,saturated,
 
     parm1 <- list(ip = c(item.parm),
                   prior = c(exp(estep$logprior)),
-                  neg2LL = -2 * estep$LL)
+                  neg2LL = -2 * estep$LL,
+                  delt = unlist(delta))
 
     dif.parm <- list(ip = max(abs(parm1$ip-parm0$ip),na.rm = TRUE),
                      prior = max(abs(parm1$prior-parm0$prior),na.rm = TRUE),
-                     neg2LL = parm0$neg2LL-parm1$neg2LL)
+                     neg2LL = parm0$neg2LL-parm1$neg2LL,
+                     delt = max(abs(parm1$delt-parm0$delt),na.rm = TRUE))
 
     parm0 <- parm1
     itr <- itr + 1
+    maxchg <- 0
+    if(any(tolower(control$conv.type)=="ip"))  maxchg <- max(maxchg,dif.parm$ip)
+    if(any(tolower(control$conv.type)=="delta"))  maxchg <- max(maxchg,dif.parm$delt)
+    if(any(tolower(control$conv.type)=="mp"))  maxchg <- max(maxchg,dif.parm$prior)
+    if(any(tolower(control$conv.type)=="neg2ll"))  maxchg <- max(maxchg,abs(dif.parm$neg2LL))
 
     if(verbose==1) {
-      cat('\rIter =',itr,' Max. abs. change =',formatC(max(dif.parm$ip,dif.parm$prior),digits = 5, format = "f"),
+      cat('\rIter =',itr,' Max. abs. change =',formatC(maxchg,digits = 5, format = "f"),
           ' Deviance  =',formatC(-2 * estep$LL,digits = 3, format = "f"),'                                                                                 ')
     }else if (verbose==2) {
-      cat('Iter =',itr,' Max. abs. change =',formatC(max(dif.parm$ip,dif.parm$prior),digits = 5, format = "f"),
+      cat('Iter =',itr,' Max. abs. change =',formatC(maxchg,digits = 5, format = "f"),
           ' Deviance  =',formatC(-2 * estep$LL,digits = 3, format = "f"),'                                                                                \n')
     }
 
-    if((tolower(control$conv.type)=="dev.change"&abs(dif.parm$neg2LL)<control$conv.crit)|
-       (tolower(control$conv.type)=="max.ip.change"&dif.parm$ip<control$conv.crit)|
-       (tolower(control$conv.type)=="max.parm.change"&max(dif.parm$ip,dif.parm$prior)<control$conv.crit)) break
+    if(maxchg < control$conv.crit) break
   }
 
   logprior0 <- logprior # old log priors
@@ -456,13 +462,13 @@ if(!att.str){
       npar <- npar + K
     }
   }
-  neg2LL=-2 * estep$LL
+  neg2LL <- -2 * estep$LL
 
   item.prob <- vector("list",J)
   initial.parm <- m2l(initial.parm)
   for (j in seq_len(J)){
     item.prob[[j]] <- item.parm[j,1:Lj[j]]
-    names(initial.parm[[j]]) <- names(item.prob[[j]]) <- paste0("P(",apply(alpha2(Kj[j]),1,paste0,collapse = ""),")")
+    names(initial.parm[[j]]) <- names(item.prob[[j]]) <- paste0("P(",apply(attributepattern(Kj[j]),1,paste0,collapse = ""),")")
   }
   postP <- exp(t(estep$logprior))
   pf <- LC.Prob <- uP(parloc,item.parm)
@@ -503,7 +509,7 @@ if(!att.str){
                          expectedCorrect = estep$Rg, expectedTotal = estep$Ng,initial.parm = initial.parm),
        options = list(dat = originalData, Q = originalQ, Qm = Q, Qcm = Qcm, model = model,
                       itr = itr, dif.LL = dif.parm$neg2LL,dif.p=dif.parm$ip,dif.prior=dif.parm$prior,
-                      att.dist=att.dist, higher.order=higher.order,att.prior = att.prior,
+                      att.dist=att.dist, higher.order=higher.order,att.prior = att.prior, latent.var = latent.var,
                       mono.constraint = mono.constraint, item.names = item.names,group = group, gr = gr,
                       att.str= att.str,  seq.dat = dat, no.group = no.mg, group.label = gr.label,
                       verbose = verbose, catprob.parm = catprob.parm,sequential = sequential,

R/GDINA.R

@@ -14,7 +14,7 @@
 #' the C-RUM (Hartz, 2002), a special case of the GDM (von Davier, 2008), and that the R-RUM
 #' is also known as a special case of the generalized NIDA model (de la Torre, 2011).
 #'
-#' In addition, users are allowed to specify design matrix and link function for each item and
+#' In addition, users are allowed to specify design matrix and link function for each item, and
 #' distinct models may be used in a single test for different items.
 #' The attributes can be either dichotomous or polytomous
 #' (Chen & de la Torre, 2013). Joint attribute distribution may be modelled using independent or saturated model,
@@ -212,9 +212,11 @@
 #'      \item \code{maxitr} A vector for each item or nonzero category, or a scalar which will be used for all
 #'    items or nonzero categories to specify the maximum number of EM cycles allowed. Default = 2000.
 #'     \item \code{conv.crit} The convergence criterion for max absolute change in item parameters or deviance. Default = 0.0001.
-#'     \item \code{conv.type} How is the convergence criterion evaluated? Can be \code{"max.ip.change"}, indicating
-#'    the maximum absolute change in success probabilities, or \code{"dev.change"}, representing
-#'    the absolute change in deviance.
+#'     \item \code{conv.type} How is the convergence criterion evaluated? A vector with possible elements: \code{"ip"}, indicating
+#'    the maximum absolute change in item success probabilities, \code{"mp"}, representing
+#'    the maximum absolute change in mixing proportion parameters, \code{"delta"}, indicating the maximum absolute change in delta
+#'    parameters or \code{neg2LL} indicating the absolute change in negative two times loglikeihood. Multiple criteria can be specified.
+#'    If so, all criteria need to be met. Default = c("ip", "mp").
 #'     \item \code{nstarts} how many sets of starting values? Default = 1.
 #'     \item \code{lower.p} A vector for each item or nonzero category,
 #'    or a scalar which will be used for all items or nonzero categories to specify the lower bound for success probabilities.
@@ -798,11 +800,11 @@
 #' # for comparison, use change in -2LL as convergence criterion
 #' # LCDM
 #' lcdm <- GDINA(dat = dat, Q = Q, model = "UDF", design.matrix = D,
-#' linkfunc = "logit", control=list(conv.type="dev.change"),solver="slsqp")
+#' linkfunc = "logit", control=list(conv.type="neg2LL"),solver="slsqp")
 #'
 #' # identity link GDINA
 #' iGDINA <- GDINA(dat = dat, Q = Q, model = "GDINA",
-#' control=list(conv.type="dev.change"),solver="slsqp")
+#' control=list(conv.type="neg2LL"),solver="slsqp")
 #'
 #' # compare two models => identical
 #' anova(lcdm,iGDINA)
@@ -822,11 +824,11 @@
 #' # for comparison, use change in -2LL as convergence criterion
 #' # RRUM
 #' logACDM <- GDINA(dat = dat, Q = Q, model = "UDF", design.matrix = D,
-#' linkfunc = "log", control=list(conv.type="dev.change"),solver="slsqp")
+#' linkfunc = "log", control=list(conv.type="neg2LL"),solver="slsqp")
 #'
 #' # identity link GDINA
 #' RRUM <- GDINA(dat = dat, Q = Q, model = "RRUM",
-#'               control=list(conv.type="dev.change"),solver="slsqp")
+#'               control=list(conv.type="neg2LL"),solver="slsqp")
 #'
 #' # compare two models => identical
 #' anova(logACDM,RRUM)

R/Mstep.R

@@ -13,7 +13,7 @@ opts <- list()
              ConstrMatrix=ConstrMatrix[[j]],linkfunc=linkfunc[j],eps=1e-16,ConstrType=ConstrType[j])
     if(is.null(optims)) stop(paste("M-step fails for item",j,"at iteration",itr),call. = FALSE)
 
-     delta[[j]] <- optims$delta
+     delta[[j]] <- c(optims$delta)
      item.parm[j,1:(2^Kj[j])] <- optims$phat
     opts[[j]] <- optims
   }

R/extract.R

@@ -286,6 +286,7 @@ extract.GDINA <- function(object,what,SE.type = 2,...){
                 item.names = object$options$item.names,
                 itemprob.history = object$diagnos$itemprob.matrix,
                 Kj = {rowSums(extract(object,"Q"))},
+                latent.var = object$options$latent.var,
                 LCprob.parm = object$LC.prob,
                 LCpf.parm = {
                   LCpf <- patt <- eta(as.matrix(extract(object,"Q")))

R/print.GDINA.R

@@ -22,9 +22,13 @@ print.GDINA <-
     # cat("\n-----------------------------------------------\n")
     cat("Model")
     cat("\n-----------------------------------------------\n")
-    cat("Fitted model(s)       =", unique(extract.GDINA(x,"models")), "\n")
+    lv <- NULL
+    if(extract(x,"latent.var")=="bugs"){
+      lv <- "Bug"
+    }
+    cat("Fitted model(s)       =", lv,unique(extract.GDINA(x,"models")), "\n")
     cat("Attribute structure   =",extract(x,"att.dist"),"\n")
-    if (extract.GDINA(x,"ngroup")==1&&extract.GDINA(x,"att.dist")=="higher.order") cat("Higher-order model    =",extract(x,"higher.order")$model,"\n")
+    if (any(extract.GDINA(x,"att.dist")=="higher.order")) cat("Higher-order model    =",extract(x,"higher.order")$model,"\n")
     tmp <- max(extract.GDINA(x,"Q"))
     cat("Attribute level       =",ifelse(tmp>1,"Polytomous","Dichotomous"),"\n")
     cat("===============================================\n")
@@ -33,8 +37,8 @@ print.GDINA <-
     cat("Number of iterations  =", max(extract.GDINA(x,"nitr")), "\n")
     cat("For the final iteration:\n")
     cat("  Max abs change in item success prob. =", formatC(extract(x,"dif.p"), digits = 4, format = "f"), "\n")
-    cat("  Max abs change in population prop.   =", formatC(extract(x,"dif.prior"), digits = 4, format = "f"), "\n")
-    cat("  Change in deviance                   =", formatC(extract(x,"dif.LL"), digits = 4, format = "f"), "\n")
+    cat("  Max abs change in mixing proportions =", formatC(extract(x,"dif.prior"), digits = 4, format = "f"), "\n")
+    cat("  Change in -2 log-likelihood          =", formatC(extract(x,"dif.LL"), digits = 4, format = "f"), "\n")
     cat("Time used             =", format(extract(x,"time"), digits = 4), "\n")
   }
 #' @export

R/utils.R

@@ -43,6 +43,8 @@ if (!is.null(catprob.parm)){
   if (att.str) {
     if (max(Q)>1) stop("Attribute structure cannot be specified if attributes are polytomous.",call. = FALSE)
     if(any(att.dist=="higher.order")) stop("Higher-order structure is not allowed if att.str = TRUE.",call.=FALSE)
+    if(any(att.dist=="independent")) stop("Independent structure is not allowed if att.str = TRUE.",call.=FALSE)
+    if(any(att.dist=="loglinear")) stop("Loglinear structure is not allowed if att.str = TRUE.",call.=FALSE)
     if(any(model<0|model>2))stop("Only DINA, DINO and G-DINA is allowed for structured attributes.",call. = FALSE)
   }