add option

Author: philchalmers

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: mirt
-Version: 1.44.5
+Version: 1.44.6
 Type: Package
 Title: Multidimensional Item Response Theory
 Authors@R: c( person("Phil", family="Chalmers", email =

NEWS.md

@@ -1,5 +1,8 @@
 # Changes in mirt 1.45
 
+- Added argument `fscores(..., expected.info = FALSE)` to allow computation of the 
+  expected vs observed information
+
 - Fixed extraction bug in `randef()` when `lr.random` structures were used
 
 - `extract.item()` and `extract.group()` now support objects 

R/fscores.R

@@ -67,6 +67,9 @@
 #'     \item \code{"classify"} for the posteriori classification probabilities (only
 #'       applicable when the input model was of class \code{MixtureClass})
 #'  }
+#' @param expected.info logical; instead of using the observed information when
+#'   \code{method = 'ML'} or \code{method = 'WLE'} use the expected information computed via
+#'   \code{\link{testinfo}}? Only currently supported for unidimensional models
 #' @param quadpts number of quadrature to use per dimension. If not specified, a suitable
 #'   one will be created which decreases as the number of dimensions increases
 #'   (and therefore for estimates such as EAP, will be less accurate). This is determined from
@@ -280,9 +283,13 @@ fscores <- function(object, method = "EAP", full.scores = TRUE, rotate = 'oblimi
                     return.acov = FALSE, mean = NULL, cov = NULL, covdata = NULL,
                     verbose = TRUE, full.scores.SE = FALSE, theta_lim = c(-6,6), MI = 0,
                     use_dentype_estimate=FALSE, QMC = FALSE, custom_den = NULL,
-                    custom_theta = NULL, min_expected = 1, max_theta = 20, start = NULL, ...)
+                    custom_theta = NULL, expected.info=FALSE,
+                    min_expected = 1, max_theta = 20, start = NULL, ...)
 {
     if(method == 'WML') method <- 'WLE'
+    if(expected.info)
+        stopifnot("expected.info only currently supported unidimensional models"=
+                  extract.mirt(object, 'nfact') == 1)
     if(!is(object, 'DiscreteClass')){
         if(QMC && is.null(quadpts)) quadpts <- 5000
         if(is.null(quadpts))
@@ -333,7 +340,7 @@ fscores <- function(object, method = "EAP", full.scores = TRUE, rotate = 'oblimi
                             plausible.draws = plausible.draws, custom_den=custom_den,
                             custom_theta=custom_theta, Target=Target, min_expected=min_expected,
                             plausible.type=plausible.type, max_theta=max_theta, start=start,
-                            use_dentype_estimate=use_dentype_estimate,
+                            use_dentype_estimate=use_dentype_estimate, expected.info=expected.info,
                             append_response.pattern=append_response.pattern, ...)
     ret
 }

R/fscores.internal.R

@@ -10,7 +10,7 @@ setMethod(
 	                      plausible.draws, full.scores.SE, return.acov = FALSE,
                           QMC, custom_den = NULL, custom_theta = NULL,
 	                      min_expected, plausible.type, start, EAPsum.scores,
-	                      use_dentype_estimate, leave_missing = FALSE, ...)
+	                      use_dentype_estimate, leave_missing = FALSE, expected.info, ...)
 	{
         den_fun <- mirt_dmvnorm
         item_weights_long <- rep(item_weights, extract.mirt(object, "K"))
@@ -391,6 +391,8 @@ setMethod(
         if(any(is.na(scores) & !is.nan(scores)))
             warning('NAs returned for response patterns with no data. Consider removing',
                     call.=FALSE)
+        if(expected.info)
+            SEscores[is.finite(scores)] <- 1/sqrt(testinfo(object, scores[is.finite(scores)]))
 		if (full.scores){
             if(USETABDATA){
                 tabdata2 <- object@Data$tabdata[keep, , drop=FALSE]