You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
275 lines
7.7 KiB
R
275 lines
7.7 KiB
R
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,
|
|
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) {
|
|
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.')
|
|
}
|
|
|
|
if ( is.null(CLEAR) & is.null(STORE) ) {
|
|
stop('Error 198: You must use at least one of these two options: clear and/or store.')
|
|
}
|
|
|
|
if (!is.null(DIM)) {
|
|
nbdim <- length(DIM)
|
|
if (nbdim > 2 & is.null(COVM)) {
|
|
stop('Error 198: You can simulate data with one or two dimensions, and you have indicated more dimensions in the DIM option. Please correct it.')
|
|
}
|
|
|
|
if (!is.null(COVM)) {
|
|
nbrowcovm <- nrow(COVM)
|
|
if (nbdim != nbrowcovm) {
|
|
stop('Error 198: DIM and COVM dimension mismatch. Please correct.')
|
|
}
|
|
}
|
|
|
|
nbitems <- sum(DIM)
|
|
|
|
if (!is.null(DIF)) {
|
|
nbdiff <- length(DIF)
|
|
tmp <- TYPEDIF
|
|
if (tmp=='gauss' | tmp=='uniform') {
|
|
typediff <- tmp
|
|
}
|
|
else if (nbdiff != nbitems) {
|
|
stop('Error 198: "You have indicated a number of difficulty parameters (DIF option) different of the number of items to simulate (DIM option). Please correct these options.')
|
|
}
|
|
}
|
|
|
|
else if (is.null(DIF)) {
|
|
DIF <- vector(mode='list', length=DIM)
|
|
for (d in seq(1,DIM)) {
|
|
DIF[[d]] <- c('gauss',0,1)
|
|
}
|
|
typediff <- 'gauss'
|
|
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') {
|
|
min <- c()
|
|
max <- c()
|
|
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 <- rep(-2,length(DIM))
|
|
max <- rep(2,length(DIM))
|
|
}
|
|
else {
|
|
stop('Your DIF option is incorrect. Please correct.')
|
|
}
|
|
for (d in seq(1,length(DIM))) {
|
|
for (i in seq(1,DIM[d])) {
|
|
DIF <- c(DIF, min[d]+(max[d]-min[d])*i/(DIM[d]+1) ) # Pas compris, demander à JB
|
|
}
|
|
}
|
|
}
|
|
|
|
else if (typediff=='gauss') {
|
|
meang <- c()
|
|
varg <- c()
|
|
if (nbdiff %/% (2*length(DIM))==1) {
|
|
for (d in seq(1,length(DIM))) {
|
|
meang[d] <- DIF[(d-1)*2+2]
|
|
varg[d] <- DIF[(d-1)*2+3]
|
|
}
|
|
}
|
|
else if (nbdiff == 1) {
|
|
meang <- rep(0,length(DIM))
|
|
varg <- rep(1,length(DIM))
|
|
}
|
|
else {
|
|
stop('Error 198: Your DIF option is incorrect. Please correct.')
|
|
}
|
|
for (d in seq(1,length(DIM))) {
|
|
for (i in seq(1,DIM[d])) {
|
|
tmp <- qnorm(p=i/(DIM[d]+1))*sqrt(varg[d])+meang[d]
|
|
DIF <- c(DIF, tmp)
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
nbrsm <- c()
|
|
for (d in 1:2) {
|
|
if (!is.null(get(paste0('RSM',d)))) {
|
|
nbrsm[d] <- length(get(paste0('RSM',d)))
|
|
for (i in seq(2,nbrsm[d]+1)) {
|
|
rsm[[d]][i] <- get(paste0("RSM",d))[i-1] # RSM doit etre une liste de vecteurs
|
|
if (!is.null(THR) & rsm[[d]][i]<0) {
|
|
stop('Error 198: With the THR option, the numbers defined in RSM1 and RSM2 must nonnegative')
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if (!is.null(DIF) & is.null(PCM)) {
|
|
PCM <- as.matrix(DIF)
|
|
}
|
|
|
|
matdiff <- as.matrix(rep(0,nbitems))
|
|
matdisc <- as.matrix(rep(0,nbitems))
|
|
matpmin <- as.matrix(rep(0,nbitems))
|
|
matpmax <- as.matrix(rep(0,nbitems))
|
|
matacc <- as.matrix(rep(0,nbitems))
|
|
matmu <- as.matrix(rep(0,length(DIM)))
|
|
matmu <- as.matrix(rep(0,(length(DIM)+1)*length(DIM)/2 ))
|
|
|
|
if (nbdisc !=0) {
|
|
matdisc <- as.matrix(DISC)
|
|
}
|
|
else {
|
|
matdisc <- rep(1,nbitems)
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
}
|