corentinchoisy/simul_these
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Cleaned up code

Browse Source
This commit is contained in:
Corentin Choisy
2024-05-30 16:50:38 +02:00
parent 6086d74551
commit fd0d2de43f
50 changed files with 370 additions and 8057 deletions
Download Patch File Download Diff File Expand all files Collapse all files

274
Modules/simirt.R
View File

@ -1,274 +0,0 @@
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)
}
}