Skip to content

Commit 0b03aad

Browse files
alexanderrobitzschalexanderrobitzsch
committed
4.3-13
1 parent e47c6ae commit 0b03aad

40 files changed

+376
-167
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Package: TAM
22
Type: Package
33
Title: Test Analysis Modules
4-
Version: 4.3-4
5-
Date: 2024-09-09 14:17:19
4+
Version: 4.3-13
5+
Date: 2025-04-05 23:23:20
66
Author:
77
Alexander Robitzsch [aut,cre] (<https://orcid.org/0000-0002-8226-3132>),
88
Thomas Kiefer [aut],

‎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.003004
2+
## File Version: 4.003013
33
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
44
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
55

‎R/Scale.R‎

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

4-
5-
6-
#####################################################
7-
# S3 method Scale
4+
#*** S3 method Scale
85
Scale <- function (object, ...)
96
{
10-
UseMethod("Scale")
7+
UseMethod('Scale')
118
}
12-
#####################################################

‎R/add.colnames.resp.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,11 @@
11
## File Name: add.colnames.resp.R
2-
## File Version: 9.09
2+
## File Version: 9.101
33

44
add.colnames.resp <- function(resp)
55
{
66
if( is.null(colnames(resp)) ){
77
I <- ncol(resp)
8-
colnames(resp) <- paste0("I",1:I)
8+
colnames(resp) <- paste0('I',1L:I)
99
}
1010
return(resp)
1111
}

‎R/tam.linking.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: tam.linking.R
2-
## File Version: 0.349
2+
## File Version: 0.368
33

44
tam.linking <- function( tamobj_list, type="Hae", method="joint",
55
pow_rob_hae=1, eps_rob_hae=1e-4, theta=NULL, wgt=NULL, wgt_sd=2, fix.slope=FALSE,
@@ -18,28 +18,28 @@ tam.linking <- function( tamobj_list, type="Hae", method="joint",
1818
theta <- matrix( theta, ncol=1)
1919
#--- extract parameters
2020
parameters_list <- list()
21-
for (mm in 1:NM){
21+
for (mm in 1L:NM){
2222
parameters_list[[mm]] <- tam_linking_extract_parameters(
2323
tamobj=tamobj_list[[mm]],
2424
elim_items=elim_items[[mm]] )
2525
}
2626

2727
#**** LINKING
28-
entries <- c("linking_items", "B", "A", "AXsi", "guess", "M", "SD")
28+
entries <- c('linking_items', 'B', 'A', 'AXsi', 'guess', 'M', 'SD')
2929
linking_list <- list()
3030
linking_args <- list( theta=theta, wgt=wgt, type=type, fix.slope=fix.slope,
3131
pow_rob_hae=pow_rob_hae, eps_rob_hae=eps_rob_hae,
3232
par_init=par_init)
3333

3434
#--- subfunction chain linking
35-
if (method=="chain"){
35+
if (method=='chain'){
3636
res <- tam_linking_chain( NM=NM, parameters_list=parameters_list,
3737
entries=entries, verbose=verbose, linking_args=linking_args,
3838
linking_list=linking_list)
3939
}
4040

4141
#--- subfunction joint linking
42-
if (method=="joint"){
42+
if (method=='joint'){
4343
res <- tam_linking_joint(NM=NM, parameters_list=parameters_list,
4444
linking_args=linking_args)
4545
}
@@ -60,6 +60,6 @@ tam.linking <- function( tamobj_list, type="Hae", method="joint",
6060
N_common=N_common, theta=theta, wgt=wgt, NS=NM, type=type,
6161
method=method, pow_rob_hae=pow_rob_hae, eps_rob_hae=eps_rob_hae,
6262
par=par, CALL=CALL,time=time)
63-
class(res) <- "tam.linking"
63+
class(res) <- 'tam.linking'
6464
return(res)
6565
}

‎R/tam.mml.wle2.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: tam.mml.wle2.R
2-
## File Version: 0.869
2+
## File Version: 0.871
33

44
################################################################
55
tam.mml.wle2 <- function( tamobj, score.resp=NULL, WLE=TRUE, adj=.3, Msteps=20,
@@ -12,6 +12,7 @@ tam.mml.wle2 <- function( tamobj, score.resp=NULL, WLE=TRUE, adj=.3, Msteps=20,
1212
res <- tam_mml_wle_proc_input_data( tamobj=tamobj, score.resp=score.resp )
1313
AXsi <- res$AXsi
1414
B <- res$B
15+
1516
resp <- res$resp
1617
resp.ind <- res$resp.ind
1718
resp_ind_bool <- resp.ind==1

‎R/tam_irf_3pl.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
## File Name: tam_irf_3pl.R
2-
## File Version: 0.07
2+
## File Version: 0.087
33

44
tam_irf_3pl <- function(theta, AXsi, B, guess=NULL, subtract_max=TRUE)
55
{

‎R/tam_linking_2studies.R‎

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,19 @@
11
## File Name: tam_linking_2studies.R
2-
## File Version: 0.224
2+
## File Version: 0.246
33

44
tam_linking_2studies <- function( B1, AXsi1, guess1, B2, AXsi2, guess2, theta,
5-
wgt, type, M1=0, SD1=1, M2=0, SD2=1, fix.slope=FALSE, pow_rob_hae=1)
5+
wgt, type, M1=0, SD1=1, M2=0, SD2=1, fix.slope=FALSE, pow_rob_hae=1,
6+
eps_rob_hae=1e-4)
67
{
78
CALL <- match.call()
89
#--- preliminaries
910
TP <- nrow(theta)
1011
K <- ncol(AXsi1)
1112
I <- nrow(AXsi1)
13+
1214
#--- define linking function
13-
linking_criterion_2studies <- function(x){
15+
linking_criterion_2studies <- function(x)
16+
{
1417
#-- study 1
1518
probs1 <- tam_irf_3pl(theta=theta, AXsi=AXsi1, B=B1, guess=guess1)
1619
probs1[ is.na(probs1) ] <- 0
@@ -23,9 +26,11 @@ tam_linking_2studies <- function( B1, AXsi1, guess1, B2, AXsi2, guess2, theta,
2326
probs2[ is.na(probs2) ] <- 0
2427
#-- discrepancy function
2528
crit <- tam_linking_irf_discrepancy(probs1=probs1, probs2=probs2, wgt=wgt,
26-
type=type, pow_rob_hae=pow_rob_hae)
29+
type=type, pow_rob_hae=pow_rob_hae,
30+
eps_rob_hae=eps_rob_hae)
2731
return(crit)
2832
}
33+
2934
#--- optimization
3035
lower <- c(-Inf,-Inf)
3136
upper <- c(Inf,Inf)
@@ -35,32 +40,33 @@ tam_linking_2studies <- function( B1, AXsi1, guess1, B2, AXsi2, guess2, theta,
3540
upper[1] <- 1 + eps
3641
}
3742
optim_result <- stats::optim( par=c(1,0), fn=linking_criterion_2studies,
38-
method="L-BFGS", lower=lower, upper=upper)
43+
method='L-BFGS', lower=lower, upper=upper)
3944
#--- transformations
4045
trafo_items <- optim_result$par
41-
names(trafo_items) <- c("a","b")
46+
names(trafo_items) <- c('a','b')
4247
trafo_persons <- 1 / trafo_items
43-
trafo_persons["b"] <- - trafo_items["b"] / trafo_items["a"]
48+
trafo_persons['b'] <- - trafo_items['b'] / trafo_items['a']
4449

45-
#--- transformed distribution
50+
#--- compute transformed distribution
4651
M_SD <- tam_linking_2studies_create_M_SD( M1=M1, SD1=SD1, M2=M2, SD2=SD2,
4752
trafo_persons=trafo_persons )
4853
#--- transformations of item parameters
4954
# X=0: 0
50-
# X=1: B_i1 * (a*TH + b) + Axsi1_i
51-
# X=2: B_i2 * (a*TH + b) + Axsi2_i
55+
# X=1L: B_i1 * (a*TH + b) + Axsi1_i
56+
# X=2L: B_i2 * (a*TH + b) + Axsi2_i
5257
# ...
5358
B2_trans <- B2
5459
AXsi2_trans <- AXsi2
55-
for (kk in 2:K){
56-
B2_trans[,kk,] <- B2[,kk,] * trafo_items["a"]
57-
AXsi2_trans[,kk] <- B2[,kk,] * trafo_items["b"] + AXsi2[,kk]
60+
for (kk in 2L:K){
61+
B2_trans[,kk,] <- B2[,kk,] * trafo_items['a']
62+
AXsi2_trans[,kk] <- B2[,kk,] * trafo_items['b'] + AXsi2[,kk]
5863
}
5964
#--- OUTPUT
60-
res <- list( optim_result=optim_result, TP=TP, I=I, M_SD=M_SD, trafo_items=trafo_items,
61-
trafo_persons=trafo_persons, B1=B1, AXsi1=AXsi1, B2=B2, AXsi2=AXsi2,
62-
B2_trans=B2_trans, AXsi2_trans=AXsi2_trans, guess1=guess1, guess2=guess2,
63-
type=type, theta=theta, wgt=wgt, CALL=CALL)
64-
class(res) <- "tam_linking_2studies"
65+
res <- list( optim_result=optim_result, TP=TP, I=I, M_SD=M_SD,
66+
trafo_items=trafo_items, trafo_persons=trafo_persons,
67+
B1=B1, AXsi1=AXsi1, B2=B2, AXsi2=AXsi2,
68+
B2_trans=B2_trans, AXsi2_trans=AXsi2_trans, guess1=guess1,
69+
guess2=guess2, type=type, theta=theta, wgt=wgt, CALL=CALL)
70+
class(res) <- 'tam_linking_2studies'
6571
return(res)
6672
}

‎R/tam_linking_2studies_create_M_SD.R‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,25 @@
11
## File Name: tam_linking_2studies_create_M_SD.R
2-
## File Version: 0.07
2+
## File Version: 0.081
33

44
tam_linking_2studies_create_M_SD <- function(M1, SD1, M2, SD2, trafo_persons)
55
{
66
G1 <- length(M1)
77
G2 <- length(M2)
88
GT <- G1+G2
99
M_SD <- matrix( 0, nrow=GT, ncol=2 )
10-
colnames(M_SD) <- c("M", "SD")
10+
colnames(M_SD) <- c('M', 'SD')
1111
# M_SD <- as.data.frame(M_SD)
1212
rownames(M_SD) <- tam_linking_2studies_create_M_SD_rownames(G1=G1, G2=G2)
1313
ind1 <- seq(1,G1)
14-
M_SD[ ind1, "M"] <- M1
15-
M_SD[ ind1, "SD"] <- SD1
14+
M_SD[ ind1, 'M'] <- M1
15+
M_SD[ ind1, 'SD'] <- SD1
1616
ind2 <- G1 + seq(1,G2)
17-
M_SD[ ind2, "M"] <- M2
18-
M_SD[ ind2, "SD"] <- SD2
17+
M_SD[ ind2, 'M'] <- M2
18+
M_SD[ ind2, 'SD'] <- SD2
1919
#-- transformations
20-
M_SD[ind2, "SD"] <- M_SD[ind2, "SD"] * trafo_persons["a"]
21-
M_SD[ind2, "M"] <- M_SD[ind2, "M"] * trafo_persons["a"] + trafo_persons["b"]
22-
attr( M_SD, "N_groups") <- c(G1, G2)
20+
M_SD[ind2, 'SD'] <- M_SD[ind2, 'SD'] * trafo_persons['a']
21+
M_SD[ind2, 'M'] <- M_SD[ind2, 'M'] * trafo_persons['a'] + trafo_persons['b']
22+
attr( M_SD, 'N_groups') <- c(G1, G2)
2323
#--- output
2424
return(M_SD)
2525
}

‎R/tam_linking_2studies_create_M_SD_rownames.R‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,20 @@
11
## File Name: tam_linking_2studies_create_M_SD_rownames.R
2-
## File Version: 0.03
2+
## File Version: 0.043
33

4-
tam_linking_2studies_create_M_SD_rownames <- function(G1, G2, study1="study1", study2="study2")
4+
tam_linking_2studies_create_M_SD_rownames <- function(G1, G2,
5+
study1="study1", study2="study2")
56
{
67
row_names <- NULL
78
if (G1==1){
89
v1 <- study1
910
} else {
10-
v1 <- paste0("study1-group",1:G1)
11+
v1 <- paste0('study1-group',1L:G1)
1112
}
1213
row_names <- c( row_names, v1 )
1314
if (G2==1){
1415
v1 <- study2
1516
} else {
16-
v1 <- paste0("study2-group",1:G2)
17+
v1 <- paste0('study2-group',1L:G2)
1718
}
1819
row_names <- c( row_names, v1 )
1920
return(row_names)

0 commit comments

Comments
 (0)