3.13-143

alexanderrobitzsch · Apr 17, 2023 · 5ef47e7 · 5ef47e7
1 parent 0e25144
commit 5ef47e7
Show file tree

Hide file tree

Showing 41 changed files with 431 additions and 302 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: sirt
 Type: Package
 Title: Supplementary Item Response Theory Models
-Version: 3.13-128
-Date: 2023-04-02 12:30:22
+Version: 3.13-143
+Date: 2023-04-16 23:04:46
 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,18 +1,18 @@
 ## File Name: IRT.expectedCounts.mirt.R
-## File Version: 0.07
+## File Version: 0.081
 
 # IRT.expectedCounts.mirt
 
 #- counts single group
 IRT.expectedCounts.SingleGroupClass <- function( object, ... )
 {
-    type <- "exp_counts"
+    type <- 'exp_counts'
     object <- mirt.wrapper.posterior(mirt.obj=object)
     ll <- object[[type]]
-    attr(ll,"theta") <- object$theta.k
-    attr(ll,"prob.theta") <- object$pi.k
-    attr(ll,"G") <- 1
-    attr(ll,"pweights") <- object$pweights
+    attr(ll,'theta') <- object$theta.k
+    attr(ll,'prob.theta') <- object$pi.k
+    attr(ll,'G') <- 1
+    attr(ll,'pweights') <- object$pweights
     return(ll)
 }
 
@@ -27,7 +27,7 @@ IRT.expectedCounts.MultipleGroupClass <- function( object, ... )
     ll_list <- list()
     ind_group <- list()
     pweights <- list()
-    type <- "exp_counts"
+    type <- 'exp_counts'
     for (gg in 1:G){
         object <- mirt.wrapper.posterior(mirt.obj=mobj, group=groups[gg])
         if (gg==1){
@@ -47,9 +47,9 @@ IRT.expectedCounts.MultipleGroupClass <- function( object, ... )
         ll_pw[ ind_group[[gg]] ] <- pweights[[gg]]
     }
     prob.theta <- matrix( unlist(prob.theta), nrow=TP, ncol=G)
-    attr(ll,"theta") <- theta
-    attr(ll,"prob.theta") <- prob.theta
-    attr(ll,"G") <- G
-    attr(ll,"pweights") <- ll_pw
+    attr(ll,'theta') <- theta
+    attr(ll,'prob.theta') <- prob.theta
+    attr(ll,'G') <- G
+    attr(ll,'pweights') <- ll_pw
     return(ll)
 }
diff --git a/R/IRT.expectedCounts_sirt.R b/R/IRT.expectedCounts_sirt.R
@@ -1,15 +1,15 @@
 ## File Name: IRT.expectedCounts_sirt.R
-## File Version: 0.16
+## File Version: 0.171
 
 
 
 #*** object of class xxirt
 IRT.expectedCounts.xxirt <- function( object, ... )
 {
     ll <- object$n.ik
-    attr(ll,"theta") <- object$Theta
-    attr(ll,"prob.theta") <- object$probs_Theta
-    attr(ll,"G") <- object$G
+    attr(ll,'theta') <- object$Theta
+    attr(ll,'prob.theta') <- object$probs_Theta
+    attr(ll,'G') <- object$G
     return(ll)
 }
 
@@ -22,10 +22,10 @@ IRT.expectedCounts.rasch.mml <- function( object, ... )
     ll <- array(0, dim=c(dims[1],2,dims[2],dims[3]))
     ll[,2,,] <- rjk
     ll[,1,,] <- njk-rjk
-    attr(ll,"theta") <- object$theta.k
-    attr(ll,"prob.theta") <- object$pi.k
-    attr(ll,"G") <- object$G
-    attr(ll,"dimnames") <- list()
-    attr(ll,"dimnames")[[1]] <- colnames(object$dat)
+    attr(ll,'theta') <- object$theta.k
+    attr(ll,'prob.theta') <- object$pi.k
+    attr(ll,'G') <- object$G
+    attr(ll,'dimnames') <- list()
+    attr(ll,'dimnames')[[1]] <- colnames(object$dat)
     return(ll)
 }
diff --git a/R/IRT.factor.scores.sirt.R b/R/IRT.factor.scores.sirt.R
@@ -1,40 +1,39 @@
 ## File Name: IRT.factor.scores.sirt.R
-## File Version: 0.16
+## File Version: 0.173
 
 
-########################################################################
-# rm.facets
+#--- rm.facets
 IRT.factor.scores.rm.facets <- function( object, type="EAP", ... )
 {
     # admissible factor score types
-    x1 <- c("EAP","MLE","WLE")
+    x1 <- c('EAP','MLE','WLE')
     if ( ! ( type %in% x1 ) ){
-        stop("Requested type is not supported!\n")
-                    }
+        stop('Requested type is not supported!\n')
+    }
     #**** EAP
-    if ( type=="EAP"){
+    if ( type=='EAP'){
         res <- object$person
-        res <- res[, c("pid", "EAP", "SE.EAP") ]
-        attr(res,"type") <- type
-        attr(res,"reliability") <- object$EAP.rel
+        res <- res[, c('pid', 'EAP', 'SE.EAP') ]
+        attr(res,'type') <- type
+        attr(res,'reliability') <- object$EAP.rel
     }
     #**** MLE or WLE
-    if ( type %in% c("MLE","WLE") ){
+    if ( type %in% c('MLE','WLE') ){
         data <- object$procdata$dat2.NA
         a <- object$ipars.dat2$a
         b <- object$ipars.dat2$b
         theta0 <- object$person$EAP
-        WLE <- if( type=="WLE"){ TRUE } else {FALSE }
+        WLE <- if( type=='WLE'){ TRUE } else { FALSE }
         res <- rm_facets_pp_mle( data=data, a=a, b=b, theta=theta0,  WLE=WLE,
-                    maxiter=30, maxincr=3, h=.001, convP=.001, maxval=9.99,
-                    progress=TRUE )
-        res <- data.frame("pid"=object$person$pid, res )
-        attr(res,"type") <- type
-        attr(res,"reliability") <- mle.reliability( meas=res$est, se.meas=res$se )
+                        maxiter=30, maxincr=3, h=1e-3, convP=1e-3, maxval=9.99,
+                        progress=TRUE )
+        res <- data.frame(pid=object$person$pid, res )
+        attr(res,'type') <- type
+        attr(res,'reliability') <- mle.reliability( meas=res$est, se.meas=res$se )
     }
     return(res)
 }
-########################################################################
-# rm.sdt
+
+#--- rm.sdt
 IRT.factor.scores.rm.sdt <- IRT.factor.scores.rm.facets
-########################################################################
+
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,5 +1,5 @@
 ## File Name: RcppExports.R
-## File Version: 3.013128
+## File Version: 3.013143
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

diff --git a/R/equating.rasch.R b/R/equating.rasch.R
@@ -1,16 +1,16 @@
 ## File Name: equating.rasch.R
-## File Version: 0.244
+## File Version: 0.247
 
 
 #---- Equating (linking) in the Rasch model
 equating.rasch <- function( x, y, theta=seq( -4, 4, len=100),
         alpha1=0, alpha2=0 )
 {
     # Data preparation
-    x[,1] <- gsub( " ", "", paste( x[,1] ) )
-    y[,1] <- gsub( " ", "", paste( y[,1] ) )
+    x[,1] <- gsub( ' ', '', paste( x[,1] ) )
+    y[,1] <- gsub( ' ', '', paste( y[,1] ) )
     b.xy <- data.frame( merge( x, y, by.x=1, by.y=1 ) )
-    colnames(b.xy) <- c("item", "Itempar.Gr1", "Itempar.Gr2" )
+    colnames(b.xy) <- c('item', 'Itempar.Gr1', 'Itempar.Gr2' )
     b.xy <- stats::na.omit( b.xy )
     # mean-mean method
     B.mm <- mean(b.xy[,3]) - mean(b.xy[,2])
@@ -36,22 +36,22 @@ equating.rasch <- function( x, y, theta=seq( -4, 4, len=100),
     B.sl <- stats::optimize( f=sl, interval=opt_interval )$minimum
     # collect all parameter estimates
     B.est <- data.frame( B.mm, B.ha, B.sl )
-    colnames(B.est) <- c("Mean.Mean", "Haebara", "Stocking.Lord")
+    colnames(B.est) <- c('Mean.Mean', 'Haebara', 'Stocking.Lord')
     # Transformation of item parameters (according to Stocking-Lord)
-    b.xy$TransfItempar.Gr1 <- b.xy[,2] + B.est[1,"Stocking.Lord"]
-    x[,2] <- x[,2] + B.est[1,"Stocking.Lord"]
+    b.xy$TransfItempar.Gr1 <- b.xy[,2] + B.est[1,'Stocking.Lord']
+    x[,2] <- x[,2] + B.est[1,'Stocking.Lord']
     # transformed parameters
     transf.par <- merge( x=x, y=y, by.x=1, by.y=1, all=TRUE )
-    colnames(transf.par) <- c("item", "TransfItempar.Gr1", "Itempar.Gr2"  )
+    colnames(transf.par) <- c('item', 'TransfItempar.Gr1', 'Itempar.Gr2'  )
     transf.par <- transf.par[ order( paste(transf.par$item ) ), ]
     # calculate variance and linking error
     des <- data.frame( N.Items=nrow(b.xy),
                             SD=stats::sd( b.xy$TransfItempar.Gr1 - b.xy$Itempar.Gr2 ) )
     des$Var <- des$SD^2
-    des$linkerror <- sqrt( des["SD"]^2 / des["N.Items"] )[1,1]
+    des$linkerror <- sqrt( des['SD']^2 / des['N.Items'] )[1,1]
     #--- output
-    res <- list( "B.est"=B.est, "descriptives"=des,
-                        "anchor"=b.xy[, c(1,2,4,3)], "transf.par"=transf.par )
+    res <- list( B.est=B.est, descriptives=des, anchor=b.xy[, c(1,2,4,3)],
+                        transf.par=transf.par )
     return(res)
 }
 

diff --git a/R/equating.rasch.jackknife.R b/R/equating.rasch.jackknife.R
@@ -1,5 +1,5 @@
 ## File Name: equating.rasch.jackknife.R
-## File Version: 0.14
+## File Version: 0.155
 
 
 
@@ -11,53 +11,57 @@ equating.rasch.jackknife <- function( pars.data, display=TRUE, se.linkerror=FALS
     itemunits <- unique( pars.data[,1] )
     N.units <- length( itemunits )
     N.items <- nrow( pars.data )
-    pars.data[,4] <- paste("I", 1:N.items,sep="")
+    pars.data[,4] <- paste('I', 1:N.items,sep='')
     # display
     if (display){
-        cat( paste( "Jackknife Equating Procedure (Stocking-Lord)\n",
-                        N.items, " Items in ", N.units, " Units\n", sep="") )
+        cat( paste( 'Jackknife Equating Procedure (Stocking-Lord)\n',
+                        N.items, ' Items in ', N.units, ' Units\n', sep='') )
     }
     # equating without jackknife
     mod1 <- equating.rasch( pars.data[, c( 4, 2) ], pars.data[, c(4, 3) ] )
-    res1 <- data.frame( "unit"=itemunits, "shift"=0, "SD"=0, "linkerror"=0)
+    res1 <- data.frame( 'unit'=itemunits, 'shift'=0, 'SD'=0, 'linkerror'=0)
 
     # perform jackknife
     for (nn in 1:N.units){
         pars.data1 <- pars.data[ pars.data[,1] !=itemunits[nn], ]
         mod.nn <- equating.rasch( x=pars.data1[, c(4,2) ], y=pars.data1[, c(4,3) ] )
-        res1[ nn, "shift" ] <- mod.nn$B.est$Stocking.Lord
-        res1[ nn, "SD" ] <- mod.nn$descriptives$SD
+        res1[ nn, 'shift' ] <- mod.nn$B.est$Stocking.Lord
+        res1[ nn, 'SD' ] <- mod.nn$descriptives$SD
 
         # Jackknife of the linking error
         if (se.linkerror){
             itemunits.nn <- itemunits[ - nn ]
             l1 <- NULL
             for (ii in itemunits.nn){
                 pars.data1.ii <- pars.data1[ paste(pars.data1[,1]) !=ii, ]
-                mod.ii <- equating.rasch( x=pars.data1.ii[,c(4,2)], y=pars.data1.ii[,c(4,3)],
+                mod.ii <- equating.rasch( x=pars.data1.ii[,c(4,2)],
+                                            y=pars.data1.ii[,c(4,3)],
                                             alpha1=alpha1, alpha2=alpha2)
                 l1 <- c(l1, mod.ii$B.est$Stocking.Lord )
             }
-            res1[ nn, "linkerror"] <-  sqrt( ( N.units - 2 ) / ( N.units -1 ) * sum( ( l1 - res1[ nn, "shift" ]  )^2 ) )
+            res1[ nn, 'linkerror'] <-  sqrt( ( N.units - 2 ) / ( N.units -1 ) *
+                                            sum( ( l1 - res1[ nn, 'shift' ]  )^2 ) )
         }
         # display progress
         if (display){
-            cat( paste( nn, " ", sep="" ) )
+            cat( paste( nn, ' ', sep='' ) )
             utils::flush.console()
-            if ( nn%%10==0){ cat("\n") }
+            if ( nn%%10==0){ cat('\n') }
         }
     }
-    cat("\n")
-    linkerror <- sqrt( ( N.units - 1 ) / N.units * sum( ( res1[,2] - mod1$B.est$Stocking.Lord )^2 ) )
-    se.sd <- sqrt( ( N.units - 1 ) / N.units * sum( ( res1[,3] - mod1$descriptives$SD )^2 ) )
+    cat('\n')
+    le_fac <- ( N.units - 1 ) / N.units
+    linkerror <- sqrt(  le_fac * sum( ( res1[,2] - mod1$B.est$Stocking.Lord )^2 ) )
+    se.sd <- sqrt( le_fac * sum( ( res1[,3] - mod1$descriptives$SD )^2 ) )
     if (se.linkerror){
-        se.linkerror <- sqrt( ( N.units - 1 ) / N.units * sum( ( res1[,4] - linkerror )^2 ) )
+        se.linkerror <- sqrt( le_fac * sum( ( res1[,4] - linkerror )^2 ) )
     } else {
         se.linkerror <- NA
     }
     #--- output
-    descriptives <- data.frame( N.items=N.items, N.units=N.units, shift=mod1$B.est$Stocking.Lord,
-                        SD=mod1$descriptives$SD, linkerror.jackknife=linkerror,
+    descriptives <- data.frame( N.items=N.items, N.units=N.units,
+                            shift=mod1$B.est$Stocking.Lord,
+                            SD=mod1$descriptives$SD, linkerror.jackknife=linkerror,
                         SE.SD.jackknife=se.sd, se.linkerror.jackknife=se.linkerror )
     res <- list( pars.data=pars.data, itemunits=itemunits, descriptives=descriptives )
     return(res)