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) } }