Skip to content

Commit bcda334

Browse files
alexanderrobitzschalexanderrobitzsch
committed
4.2-124
1 parent b7b47c0 commit bcda334

23 files changed

+88
-77
lines changed

‎DESCRIPTION‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,13 @@
11
Package: sirt
22
Type: Package
33
Title: Supplementary Item Response Theory Models
4-
Version: 4.2-121
5-
Date: 2025-05-12 12:25:44
6-
Author: Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>)
4+
Version: 4.2-124
5+
Date: 2025-05-20 11:56:18
6+
Authors@R: c( person(given = "Alexander",
7+
family = "Robitzsch",
8+
role = c("aut", "cre"),
9+
email = "robitzsch@ipn.uni-kiel.de",
10+
comment = c(ORCID = "0000-0002-8226-3132")) )
711
Maintainer: Alexander Robitzsch <robitzsch@ipn.uni-kiel.de>
812
Description:
913
Supplementary functions for item response models aiming

‎R/RcppExports.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: RcppExports.R
2-
## File Version: 4.002121
2+
## File Version: 4.002124
33
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
44
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
55

‎R/dif.logisticregression.R‎

Lines changed: 6 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,12 @@
11
## File Name: dif.logisticregression.R
2-
## File Version: 1.204
2+
## File Version: 1.206
3+
4+
35

4-
#---------------------------------------------------------------------------------------##
56
# This function performs itemwise DIF analysis by using logistic regression methods ##
67
# uniform and nonuniform DIF ##
78
dif.logistic.regression <- function( dat, group, score, quant=1.645)
89
{
9-
# INPUT:
10-
# dat ... data frame (must only include item responses)
11-
# group ... group identifier (this has to be a dummy variable)
12-
# score ... matching criterion
13-
1410
I <- ncol(dat)
1511
matr <- NULL
1612
cat('Items ')
@@ -21,8 +17,7 @@ dif.logistic.regression <- function( dat, group, score, quant=1.645)
2117
mod3 <- stats::glm( y ~ score + group + score*group, data=dat.ii,
2218
family='binomial')
2319

24-
h1 <- data.frame( item=colnames(dat)[ii], N=sum( 1- is.na( dat[,ii] ),
25-
na.rm=TRUE))
20+
h1 <- data.frame( item=colnames(dat)[ii], N=sum(1-is.na(dat[,ii]), na.rm=TRUE))
2621
h1$R <- min(group)
2722
h1$F <- max(group)
2823
h1$nR <- sum( ( 1- is.na( dat[,ii] ) )* (1-group), na.rm=T)
@@ -56,7 +51,7 @@ dif.logistic.regression <- function( dat, group, score, quant=1.645)
5651
cat( ii, ' ' )
5752
utils::flush.console()
5853
if ( ii %% 15==0 ){ cat('\n') }
59-
}
54+
}
6055
cat('\n')
6156
# include variable of adjusted p values
6257
matr[, 'pdiff.adj' ] <- matr$pR - matr$pF - mean( matr$pR - matr$pF )
@@ -79,12 +74,10 @@ dif.logistic.regression <- function( dat, group, score, quant=1.645)
7974
#**** calculation of DIF variance
8075
dif1 <- dif.variance( dif=matr$uniformDIF, se.dif=matr$se.uniformDIF )
8176
matr <- data.frame( matr[, seq(1,ind1)], uniform.EBDIF=dif1$eb.dif,
82-
DIF.SD=dif1$unweighted.DIFSD, matr[, seq(ind1+1, ncol(matr)) ] )
77+
DIF.SD=dif1$unweighted.DIFSD, matr[, seq(ind1+1, ncol(matr)) ] )
8378
cat( paste0('\nDIF SD=', round(dif1$unweighted.DIFSD, 3 ) ), '\n')
8479
# sorting of the items
8580
g1 <- rank( matr$uniformDIF )
8681
matr <- data.frame( itemnr=1L:nrow(matr), sortDIFindex=g1, matr )
8782
return(matr)
8883
}
89-
#------------------------------------------------------------------------------
90-

‎R/linking.haberman.lq.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: linking.haberman.lq.R
2-
## File Version: 0.256
2+
## File Version: 0.257
33

44
linking.haberman.lq <- function(itempars, pow=2, eps=1e-3, a_log=TRUE,
55
use_nu=FALSE, est_pow=FALSE, lower_pow=.1, upper_pow=3, method="joint",
@@ -148,7 +148,7 @@ linking.haberman.lq <- function(itempars, pow=2, eps=1e-3, a_log=TRUE,
148148
res_vcov <- NULL
149149
if (le){
150150
res_vcov <- linking_haberman_lq_pw_le(des=des_pw_slopes, res_optim=res_optim,
151-
vcov_list=vcov_list)
151+
vcov_list=vcov_list, itempars=itempars)
152152
} # end if le==TRUE
153153

154154
#- include joint item parameters

‎R/linking_haberman_lq_pw_le.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,8 @@
11
## File Name: linking_haberman_lq_pw_le.R
2-
## File Version: 0.132
2+
## File Version: 0.135
33

4-
linking_haberman_lq_pw_le <- function(des, res_optim, vcov_list=NULL, symm_hess=FALSE)
4+
linking_haberman_lq_pw_le <- function(des, res_optim, itempars,
5+
vcov_list=NULL, symm_hess=FALSE)
56
{
67
requireNamespace('MASS')
78
ind_studies <- des$ind_studies

‎R/lq_fit.R‎

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: lq_fit.R
2-
## File Version: 0.163
2+
## File Version: 0.165
33

44
lq_fit <- function(y, X, w=NULL, pow=2, eps=1e-3, beta_init=NULL,
55
est_pow=FALSE, optimizer="optim", eps_vec=10^seq(0,-10, by=-.5),
@@ -34,22 +34,23 @@ lq_fit <- function(y, X, w=NULL, pow=2, eps=1e-3, beta_init=NULL,
3434
return(val)
3535
}
3636

37-
grad_optim <- function(x, y, X, Xs, pow, eps, w)
38-
{
39-
beta <- x
40-
# e <- ( y - X %*% beta )[,1]
41-
e <- sirt_rcpp_lq_fit_matrix_mult( Z=Xs, y=y, beta=beta)
42-
pow2 <- pow/2-1
43-
h1 <- pow*exp(pow2 * log( e^2 + eps ))*e*w
44-
# der <- - colSums(X*h1)
45-
px <- ncol(X)
46-
der <- sirt_rcpp_lq_fit_sparse_matrix_derivative(Z=Xs, h1=h1, px=px)
47-
return(der)
37+
if (pow>0){
38+
grad_optim <- function(x, y, X, Xs, pow, eps, w)
39+
{
40+
beta <- x
41+
# e <- ( y - X %*% beta )[,1]
42+
e <- sirt_rcpp_lq_fit_matrix_mult( Z=Xs, y=y, beta=beta)
43+
pow2 <- pow/2-1
44+
h1 <- pow*exp(pow2 * log( e^2 + eps ))*e*w
45+
# der <- - colSums(X*h1)
46+
px <- ncol(X)
47+
der <- sirt_rcpp_lq_fit_sparse_matrix_derivative(Z=Xs, h1=h1, px=px)
48+
return(der)
49+
}
4850
}
4951

50-
5152
if (pow==0){
52-
grad_optim <- function(x, y, X, pow, eps, w, Xs=NULL)
53+
grad_optim <- function(x, y, X, Xs, pow, eps, w)
5354
{
5455
NP <- length(x)
5556
grad <- rep(NA, NP)

‎R/package_version_date.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
11
## File Name: package_version_date.R
2-
## File Version: 0.08
2+
## File Version: 0.091
33

44
package_version_date <- function(package)
55
{
66
d1 <- utils::packageDescription(pkg=package)
7-
res <- paste( d1$Package, " ", d1$Version,
8-
" (", d1$Date, ")", sep="")
7+
res <- paste( d1$Package, ' ', d1$Version,
8+
' (', d1$Date, ')', sep='')
99
return(res)
1010
}

‎R/parmsummary_extend.R‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,27 @@
11
## File Name: parmsummary_extend.R
2-
## File Version: 0.12
2+
## File Version: 0.131
33

4-
####################################################
5-
# extend parameter summary
6-
parmsummary_extend <- function( dfr, level=.95,
7-
est_label="est", se_label="se",df_label="df" )
4+
5+
#--- extend parameter summary
6+
parmsummary_extend <- function( dfr, level=.95, est_label="est", se_label="se",
7+
df_label="df" )
88
{
99
dfr <- as.data.frame(dfr)
1010
#-- compute t values and p values
1111
dfr$t <- dfr[,est_label] / dfr[,se_label]
1212
dfr$p <- 2 * stats::pnorm( - abs(dfr$t) )
1313
#-- compute confidence intervals
1414
if ( ! is.null(level) ){
15-
if ( "df" %in% colnames(dfr) ){
15+
if ( 'df' %in% colnames(dfr) ){
1616
quant <- - stats::qt( (1-level)/2, df=dfr$df)
1717
} else {
1818
quant <- - stats::qnorm( (1-level)/2 )
1919
}
20-
dfr[, paste0("lower", 100*level ) ] <-
20+
dfr[, paste0('lower', 100*level ) ] <-
2121
dfr[,est_label] - quant * dfr[, se_label ]
22-
dfr[, paste0("upper", 100*level ) ] <-
22+
dfr[, paste0('upper', 100*level ) ] <-
2323
dfr[,est_label] + quant * dfr[, se_label ]
2424
}
2525
#-- output
2626
return(dfr)
2727
}
28-
#####################################################

‎R/pbivnorm2.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: pbivnorm2.R
2-
## File Version: 1.162
2+
## File Version: 1.166
33

44

55
#*** approximation of the bivariate normal integral
@@ -47,7 +47,7 @@ pbivnorm2 <- function( x, y, rho )
4747
# adjust formula in case of APPROX. (ii)
4848
if ( length(ind2) > 0 ){
4949
# CW. Formula in (ii), p. 264
50-
prob1[ind2] <- 1 - stats::pnorm( -a1[ind2] ) - stats::pnorm( -b1[ind2] ) + prob1[ind2]
50+
prob1[ind2] <- 1-stats::pnorm(-a1[ind2])-stats::pnorm(-b1[ind2])+prob1[ind2]
5151
}
5252
# # negative correlations
5353
if ( length(ind.neg) > 0 ){

‎R/tam2mirt_freed.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: tam2mirt_freed.R
2-
## File Version: 0.155
2+
## File Version: 0.156
33

44
#*** return lavaan syntax with freed parameters
55
tam2mirt_freed <- function( D, factors, B, dat, AXsi,
@@ -44,7 +44,7 @@ tam2mirt_freed <- function( D, factors, B, dat, AXsi,
4444
lavsyn <- paste0( lavsyn, '\n', syn0 )
4545
# syntax for variances
4646
if (inherits(tamobj,'tam.mml')){
47-
g1 <- paste0( 'Cov_', 1:D, 1:D )
47+
g1 <- paste0( 'Cov_', 1L:D, 1L:D )
4848
syn0 <- paste0( factors, ' ~~ ', g1, '*',factors )
4949
syn0 <- paste0( syn0, collapse='\n')
5050
lavsyn <- paste0( lavsyn, '\n', syn0 )

0 commit comments

Comments
 (0)