4.2-89

alexanderrobitzsch · Nov 13, 2024 · 4a6c208 · 4a6c208
1 parent 4fe8ce0
commit 4a6c208
Show file tree

Hide file tree

Showing 69 changed files with 706 additions and 265 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: sirt
 Type: Package
 Title: Supplementary Item Response Theory Models
-Version: 4.2-73
-Date: 2024-09-07 13:27:24
+Version: 4.2-89
+Date: 2024-11-13 10:10:05
 Author: Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>)
 Maintainer: Alexander Robitzsch <[email protected]>
 Description: 

diff --git a/R/IRT.expectedCounts.mirt.R b/R/IRT.expectedCounts.mirt.R
@@ -1,5 +1,5 @@
 ## File Name: IRT.expectedCounts.mirt.R
-## File Version: 0.081
+## File Version: 0.082
 
 # IRT.expectedCounts.mirt
 
@@ -28,7 +28,7 @@ IRT.expectedCounts.MultipleGroupClass <- function( object, ... )
     ind_group <- list()
     pweights <- list()
     type <- 'exp_counts'
-    for (gg in 1:G){
+    for (gg in 1L:G){
         object <- mirt.wrapper.posterior(mirt.obj=mobj, group=groups[gg])
         if (gg==1){
             theta <- object$theta.k
@@ -39,10 +39,10 @@ IRT.expectedCounts.MultipleGroupClass <- function( object, ... )
         ind_group[[gg]] <- object$ind_group
         pweights[[gg]] <- object$pweights
     }
-    dims <- dim(ll_list[[1]])[1:3]
+    dims <- dim(ll_list[[1]])[1L:3]
     ll <- array(NA, dim=c(dims, G))
     ll_pw <- rep(NA, object$N_orig)
-    for (gg in 1:G){
+    for (gg in 1L:G){
         ll[,,,gg] <- ll_list[[gg]]
         ll_pw[ ind_group[[gg]] ] <- pweights[[gg]]
     }

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

diff --git a/R/attach.environment.sirt.R b/R/attach.environment.sirt.R
@@ -1,11 +1,13 @@
 ## File Name: attach.environment.sirt.R
-## File Version: 0.07
-##################################################
-# attach all elements of an object in an environment
-.attach.environment.sirt <- function( res, envir ){
+## File Version: 0.081
+
+
+#--- attach all elements of an object in an environment
+.attach.environment.sirt <- function( res, envir )
+{
     CC <- length(res)
-    for (cc in 1:CC){
+    for (cc in 1L:CC){
         assign( names(res)[cc], res[[cc]], envir=envir )
-                    }
-            }
-##################################################
+    }
+}
+
diff --git a/R/automatic.recode.R b/R/automatic.recode.R
@@ -1,5 +1,5 @@
 ## File Name: automatic.recode.R
-## File Version: 1.193
+## File Version: 1.194
 
 #*** automatic recoding of a dataset
 automatic.recode <- function( data, exclude=NULL, pstart.min=.6,
@@ -12,7 +12,7 @@ automatic.recode <- function( data, exclude=NULL, pstart.min=.6,
     # compute frequencies
     fstart <- TAM::tam.ctt3( data, allocate=allocate, progress=FALSE)
     I <- ncol(data)
-    prbar <- floor( 10 * ( 1:I ) / (I+1) )
+    prbar <- floor( 10 * ( 1L:I ) / (I+1) )
     prbar <- c(1,which( diff(prbar)==1 )  )
 
     fstart1 <- fstart

diff --git a/R/brm.irf.R b/R/brm.irf.R
@@ -1,5 +1,5 @@
 ## File Name: brm.irf.R
-## File Version: 0.11
+## File Version: 0.121
 
 #--- item response function (discretized) beta response model
 brm.irf <- function( Theta, delta, tau, ncat, thdim=1, eps=1E-10 )
@@ -15,7 +15,7 @@ brm.irf <- function( Theta, delta, tau, ncat, thdim=1, eps=1E-10 )
     m1 <- exp( m1 / 2 )
     m2 <- - Theta[,thdim] + delta + tau
     m2 <- exp( m2 / 2 )
-    for (cc in 1:ncat){
+    for (cc in 1L:ncat){
         probs[,cc] <- stats::dbeta( mp[cc], shape1=m1, shape2=m2 )
     }
     probs <- probs + eps

diff --git a/R/brm.sim.R b/R/brm.sim.R
@@ -1,5 +1,5 @@
 ## File Name: brm.sim.R
-## File Version: 0.121
+## File Version: 0.123
 
 
 #-- brm.sim
@@ -12,7 +12,7 @@ brm.sim <- function( theta, delta, tau, K=NULL)
     if ( ! is.null(K) ){
         br <- seq( 0, 1, len=K+1 )
     }
-    for (ii in 1:I){
+    for (ii in 1L:I){
         # ii <- 1
         m1 <- exp( ( theta - delta[ii] + tau[ii] ) / 2 )
         n1 <- exp( ( - theta + delta[ii] + tau[ii] ) / 2 )

diff --git a/R/categorize.R b/R/categorize.R
@@ -1,5 +1,5 @@
 ## File Name: categorize.R
-## File Version: 0.192
+## File Version: 0.193
 
 
 #--- categorize variables into classes
@@ -12,7 +12,7 @@ categorize <- function( dat, categorical=NULL, quant=NULL, lowest=0)
     dfr <- NULL
     if (! is.null( categorical) ){
         VV <- length(categorical)
-        for (vv in 1:VV){
+        for (vv in 1L:VV){
             var.vv <- categorical[vv]
             dat.vv <- dat[,var.vv]
             vals.vv <- sort( unique( dat.vv ) )
@@ -31,7 +31,7 @@ categorize <- function( dat, categorical=NULL, quant=NULL, lowest=0)
         vars <- names(quant)
         VV <- length(vars)
 
-        for (vv in 1:VV){
+        for (vv in 1L:VV){
             vars.vv <- vars[vv]
             q1 <- quant[ vars.vv ]
             quant.vv <- stats::quantile( dat[,vars.vv], na.rm=TRUE,

diff --git a/R/conf.detect.R b/R/conf.detect.R
@@ -1,5 +1,5 @@
 ## File Name: conf.detect.R
-## File Version: 1.211
+## File Version: 1.212
 
 
 # Confirmatory DETECT analysis
@@ -38,7 +38,7 @@ conf.detect <- function( data, score, itemcluster, bwscale=1.1, progress=TRUE,
     } else {
         ccovtable.list <- list()
         args_ccov_np$progress <- FALSE
-        for (pp in 1:PP){
+        for (pp in 1L:PP){
             cat( paste( 'DETECT Calculation Score ', pp, '\n', sep='') ) ;
             utils::flush.console()
             args_ccov_np$score <- score[,pp]

diff --git a/R/create.ccov.R b/R/create.ccov.R
@@ -1,5 +1,5 @@
 ## File Name: create.ccov.R
-## File Version: 1.08
+## File Version: 1.091
 
 
 #**** auxiliary function for creating a covariance matrix
@@ -10,7 +10,7 @@ create.ccov <- function( cc, data )
     ccov.matrix <- matrix( 0, nrow=I, ncol=I)
     rownames(ccov.matrix) <- colnames(ccov.matrix) <- colnames(data)
     LL <- nrow(ccc)
-    for (ll in 1:LL){
+    for (ll in 1L:LL){
         ccov.matrix[ ccc$item1ID[ll], ccc$item2ID[ll] ] <- ccc$ccov[ll]
         ccov.matrix[ ccc$item2ID[ll], ccc$item1ID[ll] ] <-
                         ccov.matrix[ ccc$item1ID[ll], ccc$item2ID[ll] ]

diff --git a/R/data.prep.R b/R/data.prep.R
@@ -1,5 +1,5 @@
 ## File Name: data.prep.R
-## File Version: 1.149
+## File Version: 1.153
 
 #----- data preparations for rasch.jml and rasch.mml
 data.prep <- function( dat, weights=NULL, use.freqpatt=TRUE,
@@ -25,7 +25,7 @@ data.prep <- function( dat, weights=NULL, use.freqpatt=TRUE,
         freq.patt <- apply( dat.9, 1, FUN=function(ll){ paste(ll, collapse='' ) } )  #
         dat1 <- data.frame( table( freq.patt ) )
     } else {
-        freq.patt <- paste('FP', 1000000 + 1:n, sep='')
+        freq.patt <- paste('FP', 1000000 + 1L:n, sep='')
         dat1 <- data.frame( freq.patt )
         colnames(dat1)[1] <- 'freq.patt'
     }
@@ -51,8 +51,8 @@ data.prep <- function( dat, weights=NULL, use.freqpatt=TRUE,
         dat2[ dat2==9 ] <- 0
         # mean right
         dat1$mean <- rowSums( dat2 * dat2.resp )  / rowSums( dat2.resp )
-        freq.patt <- data.frame(  freq.patt, rowMeans( dat, na.rm=TRUE ), 1:n )
-        colnames(freq.patt)[2:3] <- c('mean', 'index' )
+        freq.patt <- data.frame(  freq.patt, rowMeans( dat, na.rm=TRUE ), 1L:n )
+        colnames(freq.patt)[2L:3] <- c('mean', 'index' )
         list( dat=dat, dat2=dat2, dat2.resp=dat2.resp, dat1=dat1,
                 freq.patt=freq.patt, I=I, n=n, dat9=dat.9 )
 }
@@ -66,8 +66,10 @@ data.prep <- function( dat, weights=NULL, use.freqpatt=TRUE,
 .prnum <- function( matr, digits )
 {
     VV <- ncol(matr)
-    for (vv in 1:VV){
-        if ( is.numeric( matr[,vv]) ){ matr[,vv] <- round( matr[,vv], digits ) }
+    for (vv in 1L:VV){
+        if ( is.numeric( matr[,vv]) ){
+            matr[,vv] <- round( matr[,vv], digits )
+        }
     }
     print(matr)
 }
@@ -79,7 +81,7 @@ resp.pattern2 <- function(x)
 {
     n <- nrow(x)
     p <- ncol(x)
-    mdp <- (x %*% (2^((1:ncol(x)) - 1))) + 1
+    mdp <- (x %*% (2^((1L:ncol(x)) - 1))) + 1
     misspattern <- mdp[,1]
     misspattern <- list( miss.pattern=mdp[,1],
                         mp.index=match( mdp[,1], sort( unique(mdp[,1] ) ) ) )

diff --git a/R/data.recode.sirt.R b/R/data.recode.sirt.R
@@ -1,5 +1,5 @@
 ## File Name: data.recode.sirt.R
-## File Version: 0.01
+## File Version: 0.02
 
 
 #*** utility function for recoding a raw dataset
@@ -9,7 +9,7 @@ data.recode.sirt <- function( data.raw, keys )
     V <- ncol(data.raw)
     data.scored <- matrix( 0, nrow(data.raw), ncol(data.raw) )
     colnames(data.scored) <- colnames(data.raw )
-    for (vv in 1:V){
+    for (vv in 1L:V){
         data.scored[,vv] <- 1* ( paste(data.raw[,vv])==
                     paste(item.stat[ item.stat$item==colnames(data.raw)[vv], 'key' ]) )
         data.scored[ paste( data.raw[,vv] )=='NA', vv ] <- NA

diff --git a/R/data.wide2long.R b/R/data.wide2long.R
@@ -1,5 +1,5 @@
 ## File Name: data.wide2long.R
-## File Version: 0.261
+## File Version: 0.263
 
 
 #--- converts a data frame in wide format into long format
@@ -10,27 +10,27 @@ data.wide2long <- function( dat, id=NULL, X=NULL, Q=NULL)
     N <- nrow(dat)
     dat1 <- matrix( t(dat[,items]), nrow=N*I, ncol=1, byrow=FALSE )
     dat2 <- data.frame( dat1 )
-    colnames(dat2) <- "resp"
-    dat1 <- data.frame( id_index=rep(1:N, each=I ) )
+    colnames(dat2) <- 'resp'
+    dat1 <- data.frame( id_index=rep(1L:N, each=I ) )
     if ( ! is.null(id) ){
         dat1 <- cbind( dat1, rep( dat[, id], each=I ) )
         colnames(dat1)[2] <- id
     }
-    dat1 <- cbind( dat1, item=rep( items, N ), item_index=rep(1:I, N),
+    dat1 <- cbind( dat1, item=rep( items, N ), item_index=rep(1L:I, N),
                     resp=dat2$resp )
     if ( ! is.null(X) ){
-        dat1 <- cbind( dat1, X[ rep(1:N, each=I ), ] )
+        dat1 <- cbind( dat1, X[ rep(1L:N, each=I ), ] )
     }
     rownames(dat1) <- NULL
     if ( ! is.null(Q) ){
         if ( is.null(colnames(Q) ) ){
-            colnames(Q) <- paste0("q",1:ncol(Q) )
+            colnames(Q) <- paste0('q',1L:ncol(Q) )
         }
-        if ( sum( colnames(Q) %in% "item" )==0 ){
+        if ( sum( colnames(Q) %in% 'item' )==0 ){
             Q <- as.data.frame(Q)
             Q$item <- colnames(dat)
         }
-        dat1 <- merge( x=dat1, y=Q, by="item", all.x=TRUE )
+        dat1 <- merge( x=dat1, y=Q, by='item', all.x=TRUE )
     }
     dat1 <- dat1[ order( 1E9*dat1$id_index + dat1$item_index ), ]
     dat1 <- data.frame( rowindex=1:(N*I), dat1 )

diff --git a/R/detect.index.R b/R/detect.index.R
@@ -1,5 +1,5 @@
 ## File Name: detect.index.R
-## File Version: 0.351
+## File Version: 0.352
 
 
 
@@ -24,27 +24,27 @@ detect.index <- function( ccovtable, itemcluster )
     ii <- 1
     indizes[ii] <- 100*mean(ccov*delta)
     weighted.indizes[ii] <- 100*stats::weighted.mean( ccov * delta, sqrt_N )
-    parnames[ii] <- "DETECT"
+    parnames[ii] <- 'DETECT'
     #--- ASSI
     ii <- 2
     indizes[ii] <- mean( sign_ccov * delta )
     weighted.indizes[ii] <- stats::weighted.mean( sign_ccov * delta, sqrt_N )
-    parnames[ii] <- "ASSI"
+    parnames[ii] <- 'ASSI'
     #--- RATIO
     ii <- 3
     indizes[ii] <- sum( ccov * delta ) / sum( abs_ccov )
     weighted.indizes[ii] <- sum( ccov * delta * sqrt_N ) / sum( abs_ccov * sqrt_N )
-    parnames[ii] <- "RATIO"
+    parnames[ii] <- 'RATIO'
     #--- MADCOV
     ii <- 4
     indizes[ii] <- 100 * mean( abs_ccov )
     weighted.indizes[ii] <- 100* stats::weighted.mean( abs_ccov, sqrt_N )
-    parnames[ii] <- "MADCOV100"
+    parnames[ii] <- 'MADCOV100'
     #--- MCOV
     ii <- 5
     indizes[ii] <- 100 * mean( ccov )
     weighted.indizes[ii] <- 100* stats::weighted.mean( ccov, sqrt_N )
-    parnames[ii] <- "MCOV100"
+    parnames[ii] <- 'MCOV100'
 
     #--- output
     res <- data.frame( unweighted=indizes, weighted=weighted.indizes )