Updated simirt.R

main
Corentin Choisy 1 year ago
parent a82848938e
commit b97d14840b

@ -1,5 +1,5 @@
simIRT <- function(NBOBS=2000,DIM,MU,COV,COVM,DIS,DIF,PMI,PMAX,ACC,CLEAR,STORE,REP,PREF,DRAW, simIRT <- function(NBOBS=2000,DIM=NULL,MU=NULL,COV=NULL,COVM=NULL,DIS=NULL,DIF=NULL,PMIN=NULL,PMAX=NULL,ACC=NULL,CLEAR=NULL,STORE=NULL,REP=NULL,PREF=NULL,DRAW=NULL,
DRAWALL,ICC,GR=0,RAND,DEL=0,RSM1,RSM2,THR,TIT,PCM,ID,GENP,GENI) { TYPEDIF=NULL,DRAWALL=NULL,ICC,GR=0,RAND=NULL,DELTAGR=0,RSM1=NULL,RSM2=NULL,THR=NULL,TIT=NULL,PCM=NULL,ID=NULL,GENP=NULL,GENI=NULL) {
if (GR < 0 | GR > 1) { if (GR < 0 | GR > 1) {
stop('Error 198: The GR option defines a probability. The values defined by this option must be greater (or equal) to 0 and lesser (or equal) to 1.') stop('Error 198: The GR option defines a probability. The values defined by this option must be greater (or equal) to 0 and lesser (or equal) to 1.')
@ -26,7 +26,7 @@ if (!is.null(DIM)) {
if (!is.null(DIF)) { if (!is.null(DIF)) {
nbdiff <- length(DIF) nbdiff <- length(DIF)
tmp <- DIF[1] tmp <- TYPEDIF
if (tmp=='gauss' | tmp=='uniform') { if (tmp=='gauss' | tmp=='uniform') {
typediff <- tmp typediff <- tmp
} }
@ -44,10 +44,172 @@ if (!is.null(DIM)) {
nbdiff <- length(DIF)*3 nbdiff <- length(DIF)*3
} }
}
else if (is.null(DIM)) {
if (is.null(DIF) & is.null(PCM)) {
stop('Error 198: You must indicate the number of items to simulate in the DIM, DIF or PCM options.')
}
else if (!is.null(COVM)) {
nbrowcovm <- nrow(COVM)
if (nbrowcovm>1) {
stop('Error 198: You affected dimensions with COVM, but you did not affect each item to a dimension with the DIM option. Please correct DIM.')
}
}
else if (!is.null(PCM)) {
nbitems <- nrow(PCM)
DIM <- c(1)
}
else {
nbdiff <- length(DIF)
nbitems <- nbdiff
DIM <- c(1)
}
}
if ( (GR!=0 | DELTAGR!=0) & any(DIM != 1) & length(DIM)==1 ) {
stop('The GR and DELTAGR options are available only with unidimensional simulated data.')
}
if (is.null(PREF)) {
PREF <- 'item'
}
nbprefix <- length(PREF)
if (nbprefix!=length(DIM) & nbprefix!=1) { # ici, DIM est un vecteur contenant les nombres d'items par dim, mais est juste le nbre de dim dans stata
stop('Error 198: The PREF option is incorrect because the number of prefixes is different from the number of dimensions set in DIM. Please correct.')
}
if (nbprefix!=length(DIM)) {
alphab <- c('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z')
prefix <- paste0(prefix,alphab[seq(1,length(DIM))])
}
if (is.null(COVM)) {
nbcov <- length(COV)
if (length(DIM)==1) {
if (is.null(COV)) {
COV <- 1
}
if (nbcov>1) {
stop('Error 198: You simulate only one dimension, you must indicate only the variance of the simulated latent trait in the COV argument.')
}
if (COV <0) {
stop('Error 198: The variance of the latent trait cannot be negative. Please correct the COV option.')
}
covmatrix2 <- COV # cov doit être une matrice pré formatée
}
else if (length(DIM)==2) {
if (nbcov!=4 & nbcov>0) {
stop("Error 198: You simulate 2 dimensions. The COV option must be a 2x2 covariance matrix.")
}
else if (nbcov==0) {
if (length(DIM)==1) {
COV <- 1
}
else if (length(DIM)==2) {
COV <- matrix(c(1,0,0,1),nrow=2,byrow = T)
}
nbcov <- length(COV)
}
if (nbcov==4) {
cov1 <- COV[1,1]
cov2 <- COV[2,2]
cov3 <- COV[1,2]
rho <- cov3/sqrt(cov1*cov2)
if (cov1<0 | cov2<0 | rho< -1 | rho>1) {
stop('Error 198: The covariance matrix in COV is not correct. Please correct it.')
}
}
covmatrix2 <- COV
}
COVM <- COV
}
nbmu <- length(MU)
if (nbmu!=length(DIM) & nbmu!=0) {
stop('Error 198: You must indicate as many values in MU as the number of dimensions in DIM.')
}
nbdisc <- length(DIS)
if (nbdisc!=nbitems & nbdisc!=0) {
stop('Error 198: You must indicate as many values in DISC as the number of items in DIM and DIF.')
}
nbpmin <- length(PMIN)
if (nbpmin!=nbitems & nbpmin!=0) {
stop('Error 198: You must indicate as many values in PMIN as the number of items in DIM and DIF.')
}
nbpmax <- length(PMAX)
if (nbpmax!=nbitems & nbpmax!=0) {
stop('Error 198: You must indicate as many values in PMAX as the number of items in DIM and DIF.')
}
nbacc <- length(ACC)
if (nbacc != nbitems & nbacc!=0) {
stop('Error 198: You must indicate as many values in ACC as the number of items in DIM and DIF.')
}
if (!is.null(THR) & any(!is.null(c(DIS,PMIN,PMAX,ACC)))) {
stop('Error 198: If you use the THR option, you cannot use DIS, PMIN, PMAX or ACC.')
}
if (any(!is.null(c(RSM1,RSM2))) & any(!is.null(c(DIS,PMIN,PMAX,ACC)))) {
stop('Error 198: If you use the RSM1 and/or RSM2 option, you cannot use DIS, PMIN, PMAX or ACC.')
}
if (!is.null(PCM) & any(!is.null(c(DIS,PMIN,PMAX,ACC)))) {
stop('Error 198: If you use the PCM option, you cannot use DIS, PMIN, PMAX or ACC.')
}
if (any(!is.null(c(RSM1,RSM2))) & !is.null(PCM)) {
stop('Error 198: If you use the RSM1 and/or RSM2 option, you cannot use PCM.')
}
if (!is.null(RSM2) & length(DIM)==1) {
stop('Error 198: You cannot use RSM2 if you simulate only one dimension.')
}
if (is.null(ID)) {
ID <- 'ID'
}
##### Paramètres
hour <- as.numeric(substr(Sys.time(),12,13))
minu <- as.numeric(substr(Sys.time(),15,16))
sec <- as.numeric(substr(Sys.time(),18,19))
jour <- as.numeric(substr(Sys.Date(),9,10))
s <- 256484+1000000*sec+10000*minu+100*hour+jour
set.seed(s)
while(s>2^31-1) {
s <- s/231
}
set.seed(s)
if (typediff=='uniform') {
if (nbdiff %/% 2*length(DIM)==1) {
min <- DIF[(1:length(DIM)-1)*2+2]
max <- DIF[(1:length(DIM)-1)*2+3]
}
else if (nbdiff==1) {
min <- c(-2)
max <- c(2)
}
else {
stop('Your DIF option is incorrect. Please correct.')
}
for (d in seq(1,length(DIM))) {
for (i in seq(1,DIM[d])) {
DIF[i] <- min[d]+(max[d]-min[d])*i/(DIM[d]+1)
}
}
}
else if (typediff=='gauss') {
} }

@ -151,6 +151,8 @@ if (`group'!=0|`deltagroup'!=0)&`dim'!=1 {
exit exit
} }
if "`prefix'"=="" { if "`prefix'"=="" {
local prefix item local prefix item
} }
@ -172,6 +174,17 @@ else {
local prefix`d' `prefix'`tmp' local prefix`d' `prefix'`tmp'
} }
} }
if "`covmatrix'"=="" { if "`covmatrix'"=="" {
tempname covmatrix2 tempname covmatrix2
local nbcov:word count `cov' local nbcov:word count `cov'
@ -191,6 +204,15 @@ if "`covmatrix'"=="" {
} }
matrix `covmatrix2'=(`cov') matrix `covmatrix2'=(`cov')
} }
else if `dim'==2 { else if `dim'==2 {
if `nbcov'!=3&`nbcov'>0 { if `nbcov'!=3&`nbcov'>0 {
di in red "You simulate two dimensions. You must indicate exactly 3 values in the {hi:cov} option (Variance of the first simulated latent trait, Variance of the second simulated latent trait, Covariance between the two simulated latent traits)." di in red "You simulate two dimensions. You must indicate exactly 3 values in the {hi:cov} option (Variance of the first simulated latent trait, Variance of the second simulated latent trait, Covariance between the two simulated latent traits)."
@ -222,6 +244,13 @@ if "`covmatrix'"=="" {
local covmatrix `covmatrix2' local covmatrix `covmatrix2'
} }
local nbmu:word count `mu' local nbmu:word count `mu'
if `nbmu'!=`dim'&`nbmu'!=0 { if `nbmu'!=`dim'&`nbmu'!=0 {
di in red "You must indicate as many values in the {hi:mu} option as the number of dimension(s) (`dim')" di in red "You must indicate as many values in the {hi:mu} option as the number of dimension(s) (`dim')"
@ -316,6 +345,10 @@ while $seed>2^31-1 {
qui set seed $seed qui set seed $seed
if "`typediff'"=="uniform" { if "`typediff'"=="uniform" {
if `nbdiff'==`=`dim'*2+1' { if `nbdiff'==`=`dim'*2+1' {
local min`d':word `=(`d'-1)*2+2' of `diff' local min`d':word `=(`d'-1)*2+2' of `diff'
@ -336,6 +369,14 @@ if "`typediff'"=="uniform" {
} }
} }
} }
else if "`typediff'"=="gauss" { else if "`typediff'"=="gauss" {
if `nbdiff'==`=`dim'*2+1' { if `nbdiff'==`=`dim'*2+1' {
forvalues d=1/`dim' { forvalues d=1/`dim' {
@ -363,6 +404,12 @@ else if "`typediff'"=="gauss" {
} }
} }
forvalues d=1/`dim' { forvalues d=1/`dim' {
if "`rsm`d''"!="" { if "`rsm`d''"!="" {
local nbrsm`d':word count `rsm`d'' local nbrsm`d':word count `rsm`d''

Loading…
Cancel
Save