From 4f9220ac495d2a187d21b53d98b452ba06b1484a Mon Sep 17 00:00:00 2001 From: Robitzsch Date: Fri, 1 Dec 2023 09:28:01 +0100 Subject: [PATCH] 4.0-23 --- DESCRIPTION | 4 ++-- R/RcppExports.R | 2 +- R/xxirt.R | 10 ++++++++-- R/xxirt_newton_raphson.R | 19 +++++++++++++------ README.md | 4 ++-- inst/NEWS | 5 +++-- man/data.g308.Rd | 17 +++++++---------- src/RcppExports.cpp | 2 +- 8 files changed, 37 insertions(+), 26 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 51a69d03..07bebb81 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: sirt Type: Package Title: Supplementary Item Response Theory Models -Version: 4.0-19 -Date: 2023-09-16 12:28:54.454634 +Version: 4.0-23 +Date: 2023-11-30 22:36:27.562778 Author: Alexander Robitzsch [aut,cre] () Maintainer: Alexander Robitzsch Description: diff --git a/R/RcppExports.R b/R/RcppExports.R index 19e141aa..d20822bc 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,5 +1,5 @@ ## File Name: RcppExports.R -## File Version: 4.000019 +## File Version: 4.000023 # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 diff --git a/R/xxirt.R b/R/xxirt.R index ad8be794..a011a819 100644 --- a/R/xxirt.R +++ b/R/xxirt.R @@ -1,5 +1,5 @@ ## File Name: xxirt.R -## File Version: 1.088 +## File Version: 1.095 #--- user specified item response model @@ -75,6 +75,11 @@ xxirt <- function( dat, Theta=NULL, itemtype=NULL, customItems=NULL, par0 <- xxirt_partable_extract_freeParameters( partable=partable ) par1 <- xxirt_ThetaDistribution_extract_freeParameters( customTheta=customTheta ) + #*** + if (is.null(customTheta$some_bound)){ + customTheta$some_bound <- FALSE + } + #*** verbose verbose1 <- verbose==1 verbose2 <- verbose==2 @@ -116,6 +121,7 @@ xxirt <- function( dat, Theta=NULL, itemtype=NULL, customItems=NULL, #--- run EM algorithm em_out <- res <- do.call(what=xxirt_em_algorithm, args=em_args) + #--- collect EM output if (em_count==1){ iter_em <- iter <- res$iter @@ -169,7 +175,7 @@ xxirt <- function( dat, Theta=NULL, itemtype=NULL, customItems=NULL, if (!do_nr){ em_iterate <- FALSE } - + #*** Newton-Raphson scoring if requested res_opt_nr <- opt_values_nr <- NULL if (do_nr){ diff --git a/R/xxirt_newton_raphson.R b/R/xxirt_newton_raphson.R index 5ec6755c..5909a8ed 100644 --- a/R/xxirt_newton_raphson.R +++ b/R/xxirt_newton_raphson.R @@ -1,5 +1,5 @@ ## File Name: xxirt_newton_raphson.R -## File Version: 0.203 +## File Version: 0.208 xxirt_newton_raphson <- function(em_out, em_args, maxit_nr, optimizer_nr, @@ -29,6 +29,9 @@ xxirt_newton_raphson <- function(em_out, em_args, maxit_nr, optimizer_nr, NP <- NPI+NPT em_args$parindex_items <- 1:NPI + if (NPI==0){ + em_args$parindex_items <- NULL + } em_args$parindex_Theta <- (NPI+1):(NPI+NPT) x <- par0 @@ -56,11 +59,15 @@ xxirt_newton_raphson <- function(em_out, em_args, maxit_nr, optimizer_nr, i1 <- stats::aggregate(partable$itemnr, list(partable$parindex), min ) i2 <- stats::aggregate(partable$itemnr, list(partable$parindex), max ) - free_pars_design <- data.frame( pid=1:NPI, type='item', parlabel=names(par1) ) - free_pars_design$one_item <- i1[,2]==i2[,2] - free_pars_design$itemnr <- ifelse(free_pars_design$one_item, i1[,2], -9 ) - partable_free <- partable[ partable$parfree==1 & partable$est, ] - free_pars_design$item_group_comp <- partable_free$item_group_comp + if (NPI>0){ + free_pars_design <- data.frame( pid=1:NPI, type='item', parlabel=names(par1) ) + free_pars_design$one_item <- i1[,2]==i2[,2] + free_pars_design$itemnr <- ifelse(free_pars_design$one_item, i1[,2], -9 ) + partable_free <- partable[ partable$parfree==1 & partable$est, ] + free_pars_design$item_group_comp <- partable_free$item_group_comp + } else { + free_pars_design <- NULL + } em_args$free_pars_design <- free_pars_design em_args$group0 <- em_args$group - 1 diff --git a/README.md b/README.md index a20e077d..16866cc8 100644 --- a/README.md +++ b/README.md @@ -22,9 +22,9 @@ The CRAN version can be installed from within R using: utils::install.packages("sirt") ``` -#### GitHub version `sirt` 4.0-19 (2023-09-16) +#### GitHub version `sirt` 4.0-23 (2023-11-30) -[![](https://img.shields.io/badge/github%20version-4.0--19-orange.svg)](https://github.com/alexanderrobitzsch/sirt)   +[![](https://img.shields.io/badge/github%20version-4.0--23-orange.svg)](https://github.com/alexanderrobitzsch/sirt)   The version hosted [here](https://github.com/alexanderrobitzsch/sirt) is the development version of `sirt`. The GitHub version can be installed using `devtools` as: diff --git a/inst/NEWS b/inst/NEWS index 96f0578e..2f5e773b 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -37,7 +37,7 @@ CHANGELOG sirt ------------------------------------------------------------------------ -VERSIONS sirt 4.0 | 2023-09-16 | Last: sirt 4.0-19 +VERSIONS sirt 4.0 | 2023-11-30 | Last: sirt 4.0-23 ------------------------------------------------------------------------ FIXED * fixed incorrect handling of lower and upper bounds of item @@ -46,10 +46,11 @@ NOTE * included arguments 'lower' and 'upper' in function xxirt_createThetaDistribution() ADDED * included function dmlavaan() that allows comparing model parameters from two lavaan models fitted to the same dataset +NOTE * corrected manual of 'data.g308' (thanks to Andres Burga) DATA * included/modified datasets: --- -EXAMP * included/modified examples: dmlavaan (1) +EXAMP * included/modified examples: dmlavaan (1), data.g308 (1) diff --git a/man/data.g308.Rd b/man/data.g308.Rd index a0e47add..ab209beb 100644 --- a/man/data.g308.Rd +++ b/man/data.g308.Rd @@ -1,5 +1,5 @@ %% File Name: data.g308.Rd -%% File Version: 0.18 +%% File Version: 0.193 \name{data.g308} \alias{data.g308} @@ -64,15 +64,13 @@ dat <- data.g308 library(TAM) library(sirt) -library(combinat) # define testlets testlet <- c(1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 4, 4, 4, 4, 4, 5, 5, 6, 6, 6) #**************************************** #*** Model 1: Rasch model -mod1 <- TAM::tam.mml(resp=dat[,-1], pid=dat[,1], - control=list(maxiter=300, snodes=1500)) +mod1 <- TAM::tam.mml(resp=dat, control=list(maxiter=300, snodes=1500)) summary(mod1) #**************************************** @@ -80,16 +78,15 @@ summary(mod1) # testlets are dimensions, assign items to Q-matrix TT <- length(unique(testlet)) -Q <- matrix(0, nrow=ncol(dat)-1, ncol=TT + 1) +Q <- matrix(0, nrow=ncol(dat), ncol=TT + 1) Q[,1] <- 1 # First dimension constitutes g-factor for (tt in 1:TT){Q[testlet==tt, tt+1] <- 1} # In a testlet model, all dimensions are uncorrelated among # each other, that is, all pairwise correlations are set to 0, # which can be accomplished with the "variance.fixed" command -variance.fixed <- cbind(t( combinat::combn(TT+1,2)), 0) -mod2 <- TAM::tam.mml(resp=dat[,-1], pid=dat[,1], Q=Q, - variance.fixed=variance.fixed, +variance.fixed <- cbind(t( utils::combn(TT+1,2)), 0) +mod2 <- TAM::tam.mml(resp=dat, Q=Q, variance.fixed=variance.fixed, control=list(snodes=1500, maxiter=300)) summary(mod2) @@ -100,7 +97,7 @@ scores <- list() testlet.names <- NULL dat.pcm <- NULL for (tt in 1:max(testlet) ){ - scores[[tt]] <- rowSums (dat[,-1][, testlet==tt, drop=FALSE]) + scores[[tt]] <- rowSums (dat[, testlet==tt, drop=FALSE]) dat.pcm <- c(dat.pcm, list(c(scores[[tt]]))) testlet.names <- append(testlet.names, paste0("testlet",tt) ) } @@ -112,7 +109,7 @@ summary(mod3) #**************************************** #*** Model 4: Copula model -mod4 <- sirt::rasch.copula2 (dat=dat[,-1], itemcluster=testlet) +mod4 <- sirt::rasch.copula2 (dat=dat, itemcluster=testlet) summary(mod4) } } diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 1ecb7aee..f0124314 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1,5 +1,5 @@ //// File Name: RcppExports.cpp -//// File Version: 4.000019 +//// File Version: 4.000023 // Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393