@ -1,5 +1,5 @@
simIRT <- function ( NBOBS = 2000 , DIM , MU , COV , COVM , DIS , DIF , PMI , PMAX , ACC , CLEAR , STORE , REP , PREF , DRAW ,
DRAWALL, ICC , GR = 0 , RAND , DEL = 0 , RSM1 , RSM2 , THR , TIT , PCM , ID , GENP , GENI ) {
simIRT <- function ( NBOBS = 2000 , DIM = NULL , MU = NULL , COV = NULL , COVM = NULL , DIS = NULL , DIF = NULL , PMI N= NULL , PMAX = NULL , ACC = NULL , CLEAR = NULL , STORE = NULL , REP = NULL , PREF = NULL , DRAW = NULL ,
TYPEDIF= NULL , DRAWALL= NULL , ICC , GR = 0 , RAND = NULL , DEL TAGR = 0 , RSM1 = NULL , RSM2 = NULL , THR = NULL , TIT = NULL , PCM = NULL , ID = NULL , GENP = NULL , GENI = NULL ) {
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.' )
@ -26,7 +26,7 @@ if (!is.null(DIM)) {
if ( ! is.null ( DIF ) ) {
nbdiff <- length ( DIF )
tmp <- DIF[1 ]
tmp <- TYPE DIF
if ( tmp == ' gauss' | tmp == ' uniform' ) {
typediff <- tmp
}
@ -44,10 +44,172 @@ if (!is.null(DIM)) {
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' ) {
}