Skip to content

Commit

Permalink
Showing 142 changed files with 1,340 additions and 1,125 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: sirt
Type: Package
Title: Supplementary Item Response Theory Models
Version: 3.1-18
Date: 2018-12-04 17:06:53
Version: 3.1-27
Date: 2018-12-05 15:34:05
Author: Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>)
Maintainer: Alexander Robitzsch <robitzsch@ipn.uni-kiel.de>
Description:
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
@@ -203,7 +203,6 @@ export(dinvgamma2)
export(dirichlet.mle)
export(dirichlet.simul)
export(eigenvalues.manymatrices)
export(eigenvalues.sirt)
export(equating.rasch)
export(equating.rasch.jackknife)
export(expl.detect)
@@ -331,6 +330,7 @@ export(sirt_colMeans)
export(sirt_colMedians)
export(sirt_colMins)
export(sirt_colSDs)
export(sirt_eigenvalues)
export(sirt_fisherz)
export(sirt_matrix2)
export(sirt_optimizer)
62 changes: 31 additions & 31 deletions R/RcppExports.R
Original file line number Diff line number Diff line change
@@ -1,32 +1,8 @@
## File Name: RcppExports.R
## File Version: 3.001018
## File Version: 3.001027
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

eigenvaluesDsirt <- function(Xr, D, maxit, conv) {
.Call('_sirt_eigenvaluesDsirt', PACKAGE='sirt', Xr, D, maxit, conv)
}

firsteigenvalsirt2 <- function(X, maxit, conv, K) {
.Call('_sirt_firsteigenvalsirt2', PACKAGE='sirt', X, maxit, conv, K)
}

parameters_jackknife <- function(PARS) {
.Call('_sirt_parameters_jackknife', PACKAGE='sirt', PARS)
}

evm_aux <- function(B, I, powD, maxit, conv, K) {
.Call('_sirt_evm_aux', PACKAGE='sirt', B, I, powD, maxit, conv, K)
}

choppin_rowaveraging <- function(B, I, priorweight) {
.Call('_sirt_choppin_rowaveraging', PACKAGE='sirt', B, I, priorweight)
}

evm_comp_matrix_poly <- function(dat, dat_resp, weights, JJ, jackunits, powD, progress_, row_index, col_index) {
.Call('_sirt_evm_comp_matrix_poly', PACKAGE='sirt', dat, dat_resp, weights, JJ, jackunits, powD, progress_, row_index, col_index)
}

gooijer_csn_table <- function(dat, dat_perm, RR, NS, progress, progress_vec, score_index) {
.Call('_sirt_gooijer_csn_table', PACKAGE='sirt', dat, dat_perm, RR, NS, progress, progress_vec, score_index)
}
@@ -63,10 +39,6 @@ md_pattern_csource <- function(dat) {
.Call('_sirt_md_pattern_csource', PACKAGE='sirt', dat)
}

monoreg_rowwise_Cpp <- function(YM, WM) {
.Call('_sirt_monoreg_rowwise_Cpp', PACKAGE='sirt', YM, WM)
}

mle_pcm_group_C <- function(dat, dat_resp, groupM, b, a, maxK, theta0, conv, maxiter) {
.Call('_sirt_mle_pcm_group_C', PACKAGE='sirt', dat, dat_resp, groupM, b, a, maxK, theta0, conv, maxiter)
}
@@ -87,8 +59,8 @@ polychoric2_estequation <- function(frtab, maxK, rho, thresh1n, thresh2n, maxK1,
.Call('_sirt_polychoric2_estequation', PACKAGE='sirt', frtab, maxK, rho, thresh1n, thresh2n, maxK1, maxK2)
}

polychoric2_itempair <- function(v1, v2, maxK, maxiter) {
.Call('_sirt_polychoric2_itempair', PACKAGE='sirt', v1, v2, maxK, maxiter)
polychoric2_itempair <- function(v1, v2, maxK_, maxiter) {
.Call('_sirt_polychoric2_itempair', PACKAGE='sirt', v1, v2, maxK_, maxiter)
}

tetrachoric2_rcpp_aux <- function(dfr, h, maxiter) {
@@ -159,6 +131,30 @@ MML2_CALCPOST_V3 <- function(DAT2, DAT2RESP, PROBS) {
.Call('_sirt_MML2_CALCPOST_V3', PACKAGE='sirt', DAT2, DAT2RESP, PROBS)
}

sirt_rcpp_first_eigenvalue <- function(X, maxit, conv, K) {
.Call('_sirt_sirt_rcpp_first_eigenvalue', PACKAGE='sirt', X, maxit, conv, K)
}

sirt_rcpp_D_eigenvalues <- function(Xr, D, maxit, conv) {
.Call('_sirt_sirt_rcpp_D_eigenvalues', PACKAGE='sirt', Xr, D, maxit, conv)
}

sirt_rcpp_choppin_row_averaging <- function(B, I, priorweight) {
.Call('_sirt_sirt_rcpp_choppin_row_averaging', PACKAGE='sirt', B, I, priorweight)
}

sirt_rcpp_evm_compute <- function(B, I, powD, maxit, conv, K) {
.Call('_sirt_sirt_rcpp_evm_compute', PACKAGE='sirt', B, I, powD, maxit, conv, K)
}

sirt_rcpp_evm_comp_poly <- function(dat, dat_resp, weights, JJ, jackunits, powD, progress_, row_index, col_index) {
.Call('_sirt_sirt_rcpp_evm_comp_poly', PACKAGE='sirt', dat, dat_resp, weights, JJ, jackunits, powD, progress_, row_index, col_index)
}

sirt_rcpp_inference_jackknife <- function(PARS) {
.Call('_sirt_sirt_rcpp_inference_jackknife', PACKAGE='sirt', PARS)
}

sirt_rcpp_invariance_alignment_lambda_transformed <- function(lambda, psi0) {
.Call('_sirt_sirt_rcpp_invariance_alignment_lambda_transformed', PACKAGE='sirt', lambda, psi0)
}
@@ -183,6 +179,10 @@ sirt_rcpp_invariance_alignment_opt_grad <- function(nu, lambda, alpha0, psi0, gr
.Call('_sirt_sirt_rcpp_invariance_alignment_opt_grad', PACKAGE='sirt', nu, lambda, alpha0, psi0, group_combis, wgt, align_scale, align_pow, eps, wgt_combi, type)
}

sirt_rcpp_monoreg_rowwise <- function(YM, WM) {
.Call('_sirt_sirt_rcpp_monoreg_rowwise', PACKAGE='sirt', YM, WM)
}

noharm_compute_dj <- function(Fval, Pval, I, D) {
.Call('_sirt_noharm_compute_dj', PACKAGE='sirt', Fval, Pval, I, D)
}
8 changes: 8 additions & 0 deletions R/coef.rasch.evm.pcm.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
## File Name: coef.rasch.evm.pcm.R
## File Version: 0.11


coef.rasch.evm.pcm <- function( object, ... )
{
return(object$coef)
}
12 changes: 0 additions & 12 deletions R/eigenvalues.sirt.R

This file was deleted.

4 changes: 2 additions & 2 deletions R/gom.jml.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
## File Name: gom.jml.R
## File Version: 0.23
## File Version: 0.24

########################################
# GOM JML
@@ -100,7 +100,7 @@ summary.gom.jml <- function( object, ... ){
cat( "Number of items=", object$ic$I, "\n" )
cat( "Number of classes=", object$ic$K, "\n" )
cat( "Number of estimated parameters=", object$ic$np, "\n" )
cat( " Item parameters (ni) =", object$ic$np.item, "\n" )
cat( " Item parameters (ni)=", object$ic$np.item, "\n" )
cat( " Person parameters (np)=", object$ic$np.person, "\n" )
cat( "AICi=", round( object$ic$AICi, 2 ), " | penalty=", round( object$ic$AICi - object$ic$deviance,2 ),
" | AICi=-2*LL + 2*(ni) \n" )
2 changes: 1 addition & 1 deletion R/hard_thresholding.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
## File Name: hard_thresholding.R
## File Version: 0.03
## File Version: 0.04


hard_thresholding <- function( x, lambda )
2 changes: 1 addition & 1 deletion R/invariance.alignment.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
## File Name: invariance.alignment.R
## File Version: 3.601
## File Version: 3.602


invariance.alignment <- function( lambda, nu, wgt=NULL,
13 changes: 6 additions & 7 deletions R/isop_tests_cpp.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,10 @@
## File Name: isop_tests_cpp.R
## File Version: 0.03
## File Version: 0.04


##########################################################
# call to Rcpp function
isop_tests_cpp <- function ( dat, dat.resp, weights, jackunits, JJ ){
isop_tests_C( dat=dat, dat_resp=dat.resp, weights=weights,
jackunits=jackunits, JJ=JJ )
isop_tests_cpp <- function( dat, dat.resp, weights, jackunits, JJ )
{
res <- isop_tests_C( dat=dat, dat_resp=dat.resp, weights=weights,
jackunits=jackunits, JJ=JJ )
return(res)
}
#############################################################
49 changes: 23 additions & 26 deletions R/linking.haberman.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
## File Name: linking.haberman.R
## File Version: 2.52
## File Version: 2.53

##################################################
# Linking Haberman ETS Research Report

#**** Linking Haberman ETS Research Report
linking.haberman <- function( itempars, personpars=NULL,
a_trim=Inf, b_trim=Inf, a_log=TRUE,
conv=.00001, maxiter=1000, progress=TRUE ){
a_trim=Inf, b_trim=Inf, a_log=TRUE, conv=.00001, maxiter=1000, progress=TRUE )
{

CALL <- match.call()
s1 <- Sys.time()
@@ -138,13 +138,11 @@ linking.haberman <- function( itempars, personpars=NULL,
personpars[[ll]] <- pp1
}
}
#*************************
# calculate R-squared measures of invariance

#****** calculate R-squared measures of invariance
# select items for R2 calculation for which at least
# two studies are available.
selitems <- which( rowSums( 1 - is.na( a.orig ) ) > 1 )

Rsquared.partial.invariance <- Rsquared.invariance <- c(NA,NA)
names(Rsquared.invariance) <- c("slopes", "intercepts" )
names(Rsquared.partial.invariance) <- c("slopes", "intercepts" )
@@ -154,18 +152,18 @@ linking.haberman <- function( itempars, personpars=NULL,
a.res <- a.orig - aj1

Rsquared.invariance["slopes"] <- 1 -
sum0( a.res[ selitems,]^2 ) / sum0( a.orig[ selitems, ]^2 )
sirt_sum( a.res[ selitems,]^2 ) / sirt_sum( a.orig[ selitems, ]^2 )
Rsquared.partial.invariance["slopes"] <- 1 -
sum0( a.res[ selitems,]^2 * aj_wgtM[selitems,] ) /
sum0( a.orig[ selitems, ]^2 * aj_wgtM[selitems, ] )
sirt_sum( a.res[ selitems,]^2 * aj_wgtM[selitems,] ) /
sirt_sum( a.orig[ selitems, ]^2 * aj_wgtM[selitems, ] )
bj1 <- 1 / AtM *( Bj + BtM )
b.res <- b.orig - bj1

Rsquared.partial.invariance["intercepts"] <- 1 -
sum0( b.res[ selitems,]^2 * Bj_wgtM[selitems,] ) /
sum0( b.orig[ selitems, ]^2 * Bj_wgtM[selitems,] )
sirt_sum( b.res[ selitems,]^2 * Bj_wgtM[selitems,] ) /
sirt_sum( b.orig[ selitems, ]^2 * Bj_wgtM[selitems,] )
Rsquared.invariance["intercepts"] <- 1 -
sum0( b.res[ selitems,]^2 ) / sum0( b.orig[ selitems, ]^2 )
sirt_sum( b.res[ selitems,]^2 ) / sirt_sum( b.orig[ selitems, ]^2 )
es.invariance <- rbind( Rsquared.invariance,
sqrt( 1- Rsquared.invariance ) )
rownames(es.invariance) <- c("R2", "sqrtU2")
@@ -177,18 +175,17 @@ linking.haberman <- function( itempars, personpars=NULL,
linking_slopes <- stats::sd( transf.pars$At ) < 1E-10

res <- list(
transf.pars=transf.pars, transf.itempars=transf.itempars,
transf.personpars=transf.personpars, joint.itempars=joint.itempars,
a.trans=aM, b.trans=bM, a.orig=a.orig, b.orig=b.orig,
a.resid=aj_resid, b.resid=Bj_resid, personpars=personpars,
es.invariance=es.invariance, es.robust=es.partial.invariance,
selitems=selitems, a_trim=a_trim, b_trim=b_trim,
a.wgt=aj_wgtM, b.wgt=Bj_wgtM, a.wgt.adj=aj_wgt_adj, b.wgt.adj=Bj_wgt_adj,
a.vcov=aj_vcov, b.vcov=Bj_vcov, a.item_stat=aj_item_stat,
b.item_stat=Bj_item_stat, linking_slopes=linking_slopes,
description='Linking according to Haberman (2009)',
CALL=CALL, time=s1
)
transf.pars=transf.pars, transf.itempars=transf.itempars,
transf.personpars=transf.personpars, joint.itempars=joint.itempars,
a.trans=aM, b.trans=bM, a.orig=a.orig, b.orig=b.orig,
a.resid=aj_resid, b.resid=Bj_resid, personpars=personpars,
es.invariance=es.invariance, es.robust=es.partial.invariance,
selitems=selitems, a_trim=a_trim, b_trim=b_trim,
a.wgt=aj_wgtM, b.wgt=Bj_wgtM, a.wgt.adj=aj_wgt_adj, b.wgt.adj=Bj_wgt_adj,
a.vcov=aj_vcov, b.vcov=Bj_vcov, a.item_stat=aj_item_stat,
b.item_stat=Bj_item_stat, linking_slopes=linking_slopes,
description='Linking according to Haberman (2009)',
CALL=CALL, time=s1 )
class(res) <- "linking.haberman"
return(res)
}
12 changes: 12 additions & 0 deletions R/monoreg.colwise.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
## File Name: monoreg.colwise.R
## File Version: 0.11


# monotone regression for all columns in a matrix
monoreg.colwise <- function(yM, wM)
{
yM <- as.matrix(t(yM))
wM <- as.matrix(t(wM))
res <- sirt_rcpp_monoreg_rowwise( YM=yM, WM=wM )
return(t(res))
}
18 changes: 6 additions & 12 deletions R/monoreg.rowwise.R
Original file line number Diff line number Diff line change
@@ -1,19 +1,13 @@
## File Name: monoreg.rowwise.R
## File Version: 0.06
## File Version: 0.09


##############################################################
# monotone regression for all rows in a matrix
monoreg.rowwise <- function(yM,wM){
monoreg.rowwise <- function(yM, wM)
{
yM <- as.matrix(yM)
wM <- as.matrix(wM)
res <- monoreg_rowwise_Cpp( yM, wM )
res <- sirt_rcpp_monoreg_rowwise( YM=yM, WM=wM )
return(res)
}
##############################################################
# monotone regression for all columns in a matrix
monoreg.colwise <- function(yM,wM){
yM <- as.matrix(yM)
wM <- as.matrix(wM)
res <- monoreg_rowwise_Cpp( t(yM), t(wM) )
return(t(res))
}

Loading

0 comments on commit a8bdeeb

Please sign in to comment.