1.3-2

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: immer
 Type: Package
 Title: Item Response Models for Multiple Ratings
-Version: 1.2-10
-Date: 2020-08-16 17:17:13
+Version: 1.3-2
+Date: 2022-04-13 10:22:26
 Author: 
     Alexander Robitzsch [aut, cre], Jan Steinfeld [aut]
 Maintainer: Alexander Robitzsch <[email protected]>

R/RcppExports.R

@@ -1,5 +1,5 @@
 ## File Name: RcppExports.R
-## File Version: 1.002010
+## File Version: 1.003002
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

R/immer_FACETS.R

@@ -1,5 +1,5 @@
 ## File Name: immer_FACETS.R
-## File Version: 0.43
+## File Version: 0.46
 
 #--- Wrapper to FACDOS (Linacre, 1999)
 immer_FACETS <- function(
@@ -122,7 +122,7 @@ immer_FACETS <- function(
       } else {
         filenames <- c(filenames,"Outputfile"=Out)
       }
-   
+
 
   woScor <- grep("Scorefile",inputfile,ignore.case=TRUE)
     Scor <- inputfile[woScor] ; Scor <- grepInput(Scor)
@@ -132,7 +132,7 @@ immer_FACETS <- function(
       } else {
         filenames <- c(filenames,"Scorefile"=Scor)
       }
-    
+
 
   woResid <- grep("Residualfile",inputfile,ignore.case=TRUE)
     Resid <- inputfile[woResid] ; Resid <- grepInput(Resid)
@@ -142,7 +142,7 @@ immer_FACETS <- function(
       } else {
         filenames <- c(filenames,"Residualfile"=Resid)
       }
-    
+
 #  woCate <- grep("ISFILE",inputfile,ignore.case=TRUE)
 #    Cate <- inputfile[woCate] ; Resid <- grepInput(Cate)
 #    if(!is.null(path.dosbox)){
@@ -230,7 +230,7 @@ immer_FACETS <- function(
              )
              writeLines( start.facets, file.path(path.facets,"mymodel.bat") )
 
-             shell(file.path(path.facets,"startDOS.bat"), intern = TRUE, wait = TRUE)
+             shell(file.path(path.facets,"startDOS.bat"), intern=TRUE, wait=TRUE)
 
              while (file.exists(file.path(path.facets,"startDOS.bat"))) {
                 Sys.sleep(1)
@@ -288,7 +288,7 @@ immer_FACETS <- function(
 
   filenames <- sapply(filenames,function(x) substr(x,1,nchar(x)-4))
   fileListe <- sapply(filenames,function(x) grep(x,files,value=TRUE))
-  
+
   # lapply(fileListe,FUN=function(x) sapply(x,function(x)readLines(x,skipNul=TRUE,)))
   # namScorefile <- c("T.Score","T.Count","Obs.Avge","Fair.Avge","Measure","S.E.","InfitMS","InfitZ","OutfitMS","OutfitZ","PtMea","PtMeExp","Discrim","Displace","Status","Group","Weight","Lable","Teams","F-Number","F-Label" )
   score <- try(

R/immer_install.R

@@ -1,12 +1,12 @@
 ## File Name: immer_install.R
-## File Version: 0.14
+## File Version: 0.17
 ## File Name: immer_install.R
 ## File Version: 0.12
 
 #####################################################
 # installation of the free FACETS DOS_Version
 # for this the DOSBOX is needed
-immer_install <- function(DosBox_path = NULL, Facets_path = NULL){
+immer_install <- function(DosBox_path=NULL, Facets_path=NULL){
   os_system <- Sys.info()["sysname"]
   user <- Sys.info()['user']
   # Ausgabe fuer den User
@@ -19,10 +19,10 @@ Darwin=
 {cat("I'm a Mac. Install Facets and Dosbox for Mac \n")}
   )
 
-if(os_system == "Windows"){
+if(os_system=="Windows"){
   # Link for dos-version of FACETS
   link_Facets <- "http://www.winsteps.com/a/facdos.zip"
-  
+
   # Facets_path <-
   #   file.path("C:","Users",user,"Downloads")
   # win DOSbox
@@ -34,41 +34,41 @@ if(os_system == "Windows"){
     destination_dosBox <-
       paste0("C:\\Users\\",user,"\\Downloads\\")
   } else {
-    destination_dosBox <- 
+    destination_dosBox <-
       DosBox_path
   }
-  if (!dir.exists(file.path(destination_dosBox))) { 
+  if (!dir.exists(file.path(destination_dosBox))) {
       dir.create(file.path(destination_dosBox))
     }
 
   if(is.null(Facets_path)){
     destination_facets <-
       paste0("C:\\Users\\",user,"\\Documents\\facets")
   } else {
-    destination_facets <- 
+    destination_facets <-
       Facets_path
   }
 
-  if (!dir.exists(file.path(destination_facets))) { 
+  if (!dir.exists(file.path(destination_facets))) {
     dir.create(file.path(destination_facets))
   }
-  
+
   # -----------------------------------------
   # download files
   error_facets <- tryCatch(
     download.file(
-      url = link_Facets,
-      destfile = file.path(destination_facets,"facdos.zip"),
-      method = "internal"
+      url=link_Facets,
+      destfile=file.path(destination_facets,"facdos.zip"),
+      method="internal"
     )
   )
   # JS Verison 0.09: changed method to 'auto'
   error_DosBox <- tryCatch(
     download.file(
-      url = link_DosBox,
-      destfile = file.path(destination_dosBox,"DOSBoxPortable.exe"),
-      method = "auto",
-      mode = "wb"
+      url=link_DosBox,
+      destfile=file.path(destination_dosBox,"DOSBoxPortable.exe"),
+      method="auto",
+      mode="wb"
     )
   )
   cat( "install the DOSbox: \n")
@@ -79,15 +79,15 @@ if(os_system == "Windows"){
 
   # Den Admin des Computers herausfinden: und Installation von DosBox
   # -----------------------------------------
-    if(error_DosBox != 0){
+    if(error_DosBox !=0){
       cat("Attention, there was an error while downloading the DosBox,
           please try again or install die DosBox manually \n")
       cat(paste0("for the manual installation pleas go to: \n",link_DosBox,"\n",
                  "after the download process finished we recomand to install
                  the DosBox into \n--> \\Users\\yourUser\\Documents <--"))
     }
 
-    if(error_DosBox == 0){
+    if(error_DosBox==0){
     # JS Verison 0.09: changed installation process, no admin privilegs needed
 
       writeLines(c("...starting installation process of DosBox",
@@ -97,7 +97,7 @@ if(os_system == "Windows"){
       # findeAdmin <- paste0("net localgroup ",gsub("\\*","",admin[grep("adm|Adm",admin)]))
       # test <- system(findeAdmin,intern=TRUE)
       # administrator <- test[grep("--",test)+1]
-      system("cmd.exe", input = paste0("start ",destination_dosBox))
+      system("cmd.exe", input=paste0("start ",destination_dosBox))
 
       # -----------------------------------------
       # Edit the configFile to speed up the process [if the installation is successful]

R/immer_jml.R

@@ -1,8 +1,9 @@
 ## File Name: immer_jml.R
-## File Version: 0.9674
+## File Version: 1.011
 
 
-immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, irtmodel="PCM",
+immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL,
+                weights=NULL, irtmodel="PCM",
                 pid=NULL, rater=NULL, eps=.3, est_method="eps_adj",
                 maxiter=1000, conv=1E-5, max_incr=3, incr_fac=1.1, maxiter_update=10, maxiter_line_search=6,
                 conv_update=1E-5, verbose=TRUE, use_Rcpp=TRUE, shortcut=TRUE )
@@ -11,15 +12,21 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
     CALL <- match.call()
 
     #-- process rating data
-    res <- immer_proc_data( dat=dat, pid=pid, rater=rater, weights=NULL, maxK=maxK)
+    res <- immer_proc_data( dat=dat, pid=pid, rater=rater, weights=weights, maxK=maxK)
     dat <- res$dat2.NA
     pid <- res$pid
     maxK <- res$maxK
     K <- res$K
     pseudoitems_design <- res$pseudoitems_design
 
+    use_weights <- FALSE
+    if (! is.null(weights)){
+        use_Rcpp <- TRUE
+        use_weights <- TRUE
+    }
+
     #-- shortcut for analyzing the dataset
-    res <- immer_jml_proc_shortcut( dat=dat, pid=pid, shortcut=shortcut, weights=NULL)
+    res <- immer_jml_proc_shortcut( dat=dat, pid=pid, shortcut=shortcut, weights=weights)
     dat <- res$dat
     pid <- res$pid
     shortcut <- res$shortcut
@@ -70,7 +77,6 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
                                 max_pers=person$max_pers, eps=eps)
     }
 
-
     dat_score <- array( dat_resp * person$eps_i, dim=c(N,I,K+1) )
     dat_score2 <- dat_score
     for (ii in 1:I){
@@ -144,9 +150,11 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
         theta0 <- theta
         deviance0 <- deviance
         #** update item parameters
-        args_item <- list( score_items=score_items, I=I, K=K, b=b, A=A, xsi=xsi, theta=theta, N=N, dat_resp=dat_resp,
-                    max_incr=max_incr, maxiter_update=maxiter_update, conv_update=conv_update,
-                    b_fixed=b_fixed, ItemScore=ItemScore, shortcut_index=shortcut_index, weights=weights )
+        args_item <- list( score_items=score_items, I=I, K=K, b=b, A=A, xsi=xsi,
+                    theta=theta, N=N, dat_resp=dat_resp, max_incr=max_incr,
+                    maxiter_update=maxiter_update, conv_update=conv_update,
+                    b_fixed=b_fixed, ItemScore=ItemScore, shortcut_index=shortcut_index,
+                    weights=weights, use_weights=use_weights )
         res <- do.call( what=fct_item, args=args_item)
         b <- res$b
         xsi <- res$xsi
@@ -161,7 +169,7 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
         theta <- res$theta
         theta_der2 <- res$theta_der2
         probs <- res$probs
-        
+
         #* trim theta increment
         incr <- theta - theta0
         max_incr <- max_incr/incr_fac
@@ -180,7 +188,6 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
             # immer_jml_print_progress_line_search( verbose=verbose, deviance=deviance, digits_deviance=6)
             lambda <- 1
             lambda_fac <- 2
-            # lambda_fac <- 1.5
             xsi_old <- xsi0
             b_old <- b
             probs_old <- probs
@@ -210,7 +217,7 @@ immer_jml <- function(dat, A=NULL, maxK=NULL, center_theta=TRUE, b_fixed=NULL, i
                 iter_in <- iter_in + 1
                 # immer_jml_print_progress_line_search( verbose=verbose, deviance=deviance, digits_deviance=6)
             }
-            if (iter_in >= maxiter_ls){
+            if (iter_in >=maxiter_ls){
                 xsi <- .5*(xsi_old + xsi)
                 theta <- .5*(theta_old + theta)
                 b <- immer_jml_calc_item_intercepts(A=A, xsi=xsi)

R/immer_jml_update_item_R.R

@@ -1,10 +1,10 @@
 ## File Name: immer_jml_update_item_R.R
-## File Version: 0.79
+## File Version: 0.801
 
 
 immer_jml_update_item_R <- function( score_items, ItemScore, I, K, b, A, xsi, theta,
-        N, dat_resp, max_incr,     maxiter_update, conv_update, b_fixed, shortcut_index,
-        weights )
+        N, dat_resp, max_incr, maxiter_update, conv_update, b_fixed, shortcut_index,
+        weights, use_weights=TRUE )
 {
     iterate <- TRUE
     iter <- 0

R/immer_jml_update_item_Rcpp.R

@@ -1,9 +1,10 @@
 ## File Name: immer_jml_update_item_Rcpp.R
-## File Version: 0.41
+## File Version: 0.463
 
 
 immer_jml_update_item_Rcpp <- function( score_items, ItemScore, I, K, b, A, xsi, theta,
-    N, dat_resp, max_incr, maxiter_update, conv_update, b_fixed, shortcut_index, weights )
+    N, dat_resp, max_incr, maxiter_update, conv_update, b_fixed, shortcut_index, weights,
+    use_weights=FALSE)
 {
     iterate <- TRUE
     iter <- 0
@@ -15,6 +16,11 @@ immer_jml_update_item_Rcpp <- function( score_items, ItemScore, I, K, b, A, xsi,
     update <- as.vector(shortcut_index$update)
     update_weights <- as.vector(shortcut_index$update_weights)
 
+    if (TRUE){
+        update <- rep(1,length(update))
+        update_weights <- weights
+    }
+
     while(iterate){
         b0 <- b
         xsi0 <- xsi

R/immer_latent_regression.R

@@ -1,5 +1,5 @@
 ## File Name: immer_latent_regression.R
-## File Version: 0.39
+## File Version: 0.41
 
 immer_latent_regression <- function( like, theta=NULL, Y=NULL, group=NULL,
         weights=NULL, conv=1E-5, maxit=200, verbose=TRUE)
@@ -49,7 +49,7 @@ immer_latent_regression <- function( like, theta=NULL, Y=NULL, group=NULL,
     }
     Xw <- X * weights
 
-    XtX <- immer_ginv( x = t(X) %*% Xw )
+    XtX <- immer_ginv( x=t(X) %*% Xw )
     thetaM <- matrix( theta, nrow=N, ncol=TP, byrow=TRUE)
     mu <- as.vector( X %*% beta )
     sigma <- gamma[ group ]

R/immer_proc_data.R

@@ -1,5 +1,5 @@
 ## File Name: immer_proc_data.R
-## File Version: 0.16
+## File Version: 0.17
 
 immer_proc_data <- function( dat, pid=NULL, rater=NULL, weights=NULL, maxK=NULL)
 {
@@ -15,7 +15,8 @@ immer_proc_data <- function( dat, pid=NULL, rater=NULL, weights=NULL, maxK=NULL)
         rater <- rep(0,N1)
     }
     #-- apply sirt::rm_proc_data() function for processing rating data
-    res <- sirt::rm_proc_data( dat=dat, pid=pid, rater=rater, rater_item_int=FALSE, reference_rater=NULL )
+    res <- sirt::rm_proc_data( dat=dat, pid=pid, rater=rater, rater_item_int=FALSE,
+                    reference_rater=NULL )
     N <- res$N
     res$pid <- res$person.index$pid
     #-- maxK and K

README.md

@@ -8,7 +8,7 @@ If you use `immer` and have suggestions for improvement or have found bugs, plea
 
 The manual may be found here [https://alexanderrobitzsch.github.io/immer/](https://alexanderrobitzsch.github.io/immer/) 
 
-#### CRAN version `immer` 1.1-35 (2018-12-11)
+#### CRAN version `immer` 1.2-19 (2022-04-11)
 
 
 [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version-last-release/immer)](https://cran.r-project.org/package=immer)
@@ -22,9 +22,9 @@ The CRAN version can be installed from within R using:
 utils::install.packages("immer")
 ```
 
-#### GitHub version `immer` 1.2-10 (2020-08-16)
+#### GitHub version `immer` 1.3-2 (2022-04-13)
 
-[![](https://img.shields.io/badge/github%20version-1.2--10-orange.svg)](https://github.com/alexanderrobitzsch/immer)  
+[![](https://img.shields.io/badge/github%20version-1.3--2-orange.svg)](https://github.com/alexanderrobitzsch/immer)  
 
 The version hosted [here](https://github.com/alexanderrobitzsch/immer) is the development version of `immer`. 
 The GitHub version can be installed using `devtools` as: