Updated simirt.R

2023-12-26 17:08:12 +01:00
parent a82848938e
commit b97d14840b
2 changed files with 212 additions and 3 deletions
--- a/Modules/simirt.R
+++ b/Modules/simirt.R
@ -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,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.')
@ -26,7 +26,7 @@ if (!is.null(DIM)) {

  if (!is.null(DIF)) {
    nbdiff <- length(DIF)
-    tmp <- DIF[1]
+    tmp <- TYPEDIF
    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') {
+  
 }


--- a/Modules/simirt.ado
+++ b/Modules/simirt.ado
@ -151,6 +151,8 @@ if (`group'!=0|`deltagroup'!=0)&`dim'!=1 {
   exit
 }

+
+
 if "`prefix'"=="" {
   local prefix item
 }
@ -172,6 +174,17 @@ else {
      local prefix`d' `prefix'`tmp'
   }
 }
+
+
+
+
+
+
+
+
+
+
+
 if "`covmatrix'"=="" {
   tempname covmatrix2
   local nbcov:word count `cov'
@ -191,6 +204,15 @@ if "`covmatrix'"=="" {
      }
      matrix `covmatrix2'=(`cov')
   }
+
+
+
+
+
+
+
+
+
   else if `dim'==2 {
      if `nbcov'!=3&`nbcov'>0 {
         di in red "You simulate two dimensions. You must indicate exactly 3 values in the {hi:cov} option (Variance of the first simulated latent trait, Variance of the second simulated latent trait, Covariance between the two simulated latent traits)."
@ -222,6 +244,13 @@ if "`covmatrix'"=="" {
   local covmatrix `covmatrix2'
 }

+
+
+
+
+
+
+
 local nbmu:word count `mu'
 if `nbmu'!=`dim'&`nbmu'!=0 {
   di in red "You must indicate as many values in the {hi:mu} option as the number of dimension(s) (`dim')"
@ -316,6 +345,10 @@ while $seed>2^31-1 {

 qui set seed $seed

+
+
+
+
 if "`typediff'"=="uniform" {
      if `nbdiff'==`=`dim'*2+1' {
         local min`d':word `=(`d'-1)*2+2' of `diff'
@ -336,6 +369,14 @@ if "`typediff'"=="uniform" {
         }
      }
 }
+
+
+
+
+
+
+
+
 else if "`typediff'"=="gauss" {
   if `nbdiff'==`=`dim'*2+1' {
         forvalues d=1/`dim' {
@ -363,6 +404,12 @@ else if "`typediff'"=="gauss" {
   }
 }

+
+
+
+
+
+
 forvalues d=1/`dim' {
   if "`rsm`d''"!="" {
      local nbrsm`d':word count `rsm`d''