simul_these/Modules/simirt.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)
}





}