3.3-1

alexanderrobitzsch · Apr 16, 2019 · 87beeea · 87beeea
1 parent 9bab406
commit 87beeea
Show file tree

Hide file tree

Showing 27 changed files with 277 additions and 148 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: BIFIEsurvey
 Type: Package
 Title: Tools for Survey Statistics in Educational Assessment
-Version: 3.2-17
-Date: 2019-03-29 17:13:06
+Version: 3.3-1
+Date: 2019-04-16 16:07:50
 Author: BIFIE [aut], Alexander Robitzsch [aut, cre], 
         Konrad Oberwimmer [aut]
 Maintainer: Alexander Robitzsch <robitzsch@ipn.uni-kiel.de>
@@ -28,11 +28,11 @@ Description:
 Depends:
     R (>= 3.1)
 Imports:
-    graphics, grDevices, methods, miceadds, mitools, 
-    Rcpp, stats, utils
+    methods, miceadds, Rcpp, stats, utils
 Suggests:
-    car, Hmisc, intsvy, lavaan, lavaan.survey, lme4, LSAmitR, 
-    survey, svyPVpack, TAM
+    graphics, grDevices, lavaan, lavaan.survey, mitools, survey, TAM
+Enhances:
+    car, Hmisc, intsvy, lme4, LSAmitR, svyPVpack 
 LinkingTo: 
     Rcpp, RcppArmadillo    
 License: GPL (>= 2)

diff --git a/NAMESPACE b/NAMESPACE
@@ -12,9 +12,6 @@ useDynLib(BIFIEsurvey)
 #***************************************************
 #*************** R Basics / Linking To *************
 
-importFrom(graphics, par)
-importFrom(graphics, plot)
-importFrom(grDevices, nclass.Sturges)
 importFrom(methods, getMethod)
 importFrom(methods, is)
 importFrom(Rcpp, evalCpp)
@@ -45,14 +42,15 @@ importFrom(utils, packageDescription)
 #***************************************************
 #************** Imports ****************************
 
+
 importFrom(miceadds, load.data)
+importFrom(miceadds, List2nestedList)
 importFrom(miceadds, micombine.chisquare)
 importFrom(miceadds, NMIcombine)
 importFrom(miceadds, NMIwaldtest)
 importFrom(miceadds, Reval)
 importFrom(miceadds, save.data)
-importFrom(mitools, imputationList)
-importFrom(mitools, MIcombine)
+
 
 
 
@@ -61,7 +59,9 @@ importFrom(mitools, MIcombine)
 #***************************************************
 #************** Suggests ***************************
 
-
+# importFrom(graphics, par)
+# importFrom(graphics, plot)
+# importFrom(grDevices, nclass.Sturges)
 # importFrom(lavaan, cfa)
 # importFrom(lavaan, fitMeasures)
 # importFrom(lavaan, growth)
@@ -70,6 +70,8 @@ importFrom(mitools, MIcombine)
 # importFrom(lavaan, lavInspect)
 # importFrom(lavaan, sem)
 # importFrom(lavaan.survey, lavaan.survey)
+# importFrom(mitools, imputationList)
+# importFrom(mitools, MIcombine)
 # importFrom(survey, svrepdesign)
 # importFrom(TAM, lavaanify.IRT)
 

diff --git a/R/BIFIE.BIFIEcdata2BIFIEdata.R b/R/BIFIE.BIFIEcdata2BIFIEdata.R
@@ -1,28 +1,27 @@
 ## File Name: BIFIE.BIFIEcdata2BIFIEdata.R
-## File Version: 0.11
+## File Version: 0.15
 
-#######################################################
-# conversion of BIFIEcdata to BIFIEdata object
+
+#--- conversion of BIFIEcdata to BIFIEdata object
 BIFIE.BIFIEcdata2BIFIEdata <- function( bifieobj, varnames=NULL, impdata.index=NULL )
 {
     if ( ! bifieobj$cdata ){
         stop( "You may want to use 'BIFIE.BIFIEdata2BIFIEcdata'\n")
     }
 
-    #******** select some imputed datasets or some variables
+    #*** select some imputed datasets or some variables
     bifieobj <- BIFIE.cdata.select( bifieobj=bifieobj, varnames=varnames,
                     impdata.index=impdata.index )
-
-    #***** conversion to BIFIEdata object
-    bifieobj$datalistM <- bifiesurvey_rcpp_bifiecdata2bifiedata( datalistM_ind=as.matrix(bifieobj$datalistM_ind),
-                            datalistM_imputed=as.matrix(bifieobj$datalistM_imputed),
-                            Nimp=bifieobj$Nimp, dat1=as.matrix(bifieobj$dat1),
-                            datalistM_impindex=as.matrix(bifieobj$datalistM_impindex) )$datalistM
+    #*** conversion to BIFIEdata object
+    bifieobj$datalistM <- bifiesurvey_rcpp_bifiecdata2bifiedata(
+                                datalistM_ind=as.matrix(bifieobj$datalistM_ind),
+                                datalistM_imputed=as.matrix(bifieobj$datalistM_imputed),
+                                Nimp=bifieobj$Nimp, dat1=as.matrix(bifieobj$dat1),
+                                datalistM_impindex=as.matrix(bifieobj$datalistM_impindex) )$datalistM
     bifieobj$cdata <- FALSE
     bifieobj$datalistM_imputed <- NULL
     bifieobj$datalistM_impindex <- NULL
     bifieobj$datalistM_ind <- NULL
     bifieobj$wgtrep <- as.matrix(bifieobj$wgtrep)
     return(bifieobj)
 }
-##############################################################
diff --git a/R/BIFIE.BIFIEdata2datalist.R b/R/BIFIE.BIFIEdata2datalist.R
@@ -1,13 +1,18 @@
 ## File Name: BIFIE.BIFIEdata2datalist.R
-## File Version: 0.13
+## File Version: 0.19
 
 
 #--- converts a BIFIEdata object into a list of multiply imputed datasets
 BIFIE.BIFIEdata2datalist <- function( bifieobj, varnames=NULL,
         impdata.index=NULL, as_data_frame=FALSE )
 {
+    Nimp <- bifieobj$Nimp
+    NMI <- bifieobj$NMI
     bifieobj <- BIFIEdata.select(bifieobj=bifieobj, varnames=varnames,
-                    impdata.index=impdata.index )
+                        impdata.index=impdata.index )
+    if (bifieobj$cdata){
+        bifieobj <- BIFIE.BIFIEcdata2BIFIEdata( bifieobj=bifieobj)
+    }
     datalistM <- bifieobj$datalistM
     variables <- bifieobj$variables
     cndat1 <- colnames(bifieobj$dat1)

diff --git a/R/BIFIE.bifiedata2bifiecdata.R b/R/BIFIE.bifiedata2bifiecdata.R
@@ -1,19 +1,19 @@
 ## File Name: BIFIE.bifiedata2bifiecdata.R
-## File Version: 2.19
+## File Version: 2.22
 
-#######################################################
-# conversion of BIFIEdata to BIFIEcdata
+
+#--- conversion of BIFIEdata to BIFIEcdata
 BIFIE.BIFIEdata2BIFIEcdata <- function( bifieobj, varnames=NULL, impdata.index=NULL )
 {
     if ( bifieobj$cdata ){
         stop( "You may want to use 'BIFIE.BIFIEcdata2BIFIEdata'\n")
     }
-    #******** select some imputed datasets or some variables
+    #*** select some imputed datasets or some variables
     bifieobj <- BIFIE.data.select( bifieobj=bifieobj, varnames=varnames,
                     impdata.index=impdata.index )
-
-    #**** data conversion
-    res1 <- bifiesurvey_rcpp_bifiedata2bifiecdata( datalistM=bifieobj$datalistM, Nimp=bifieobj$Nimp )
+    #*** data conversion
+    res1 <- bifiesurvey_rcpp_bifiedata2bifiecdata( datalistM=bifieobj$datalistM,
+                        Nimp=bifieobj$Nimp )
     bifieobj$cdata <- TRUE
     bifieobj$datalistM <- NULL
     bifieobj$datalistM_ind <- res1$datalistM_ind
@@ -23,4 +23,3 @@ BIFIE.BIFIEdata2BIFIEcdata <- function( bifieobj, varnames=NULL, impdata.index=N
     bifieobj$time <- Sys.time()
     return(bifieobj)
 }
-#######################################################
diff --git a/R/BIFIE.hist.R b/R/BIFIE.hist.R
@@ -1,19 +1,18 @@
 ## File Name: BIFIE.hist.R
-## File Version: 0.25
+## File Version: 0.283
 
 
-#######################################################################
-# Histogram
+#--- Histogram
 BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
-        group=NULL, group_values=NULL  ){
-    #****
+        group=NULL, group_values=NULL  )
+{
     s1 <- Sys.time()
     cl <- match.call()
     bifieobj <- BIFIEobj
     if (bifieobj$cdata){
         varnames <- unique( c( vars, group, "one") )
         bifieobj <- BIFIE.BIFIEcdata2BIFIEdata( bifieobj, varnames=varnames )
-                        }
+    }
     FF <- Nimp <- bifieobj$Nimp
     N <- bifieobj$N
     dat1 <- bifieobj$dat1
@@ -28,17 +27,12 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
                         which( varnames==vv ) } ) )
 
     if ( is.null(breaks) ){
+        requireNamespace("grDevices")
         x <- dat1[, vars_index ]
         breaks <- pretty(x, n=grDevices::nclass.Sturges(x))
-                }
-
-        RR <- 0
-#    if (RR==1){ RR <- 0 }
-#    if ( ! se ){
-#        wgtrep <- matrix( wgt, ncol=1 )
-#        RR <- 0
-#                }
+    }
 
+    RR <- 0
     # vars values
     VV <- length(vars)
 
@@ -48,8 +42,7 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
     if (nogroup){
         group <- "one"
         group_values <- c(1)
-            }
-
+    }
 
     #@@@@***
     group_index <- match( group, varnames )
@@ -58,7 +51,7 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
     if ( is.null(group_values ) ){
         t1 <- bifie_table( datalistM[, group_index ] )
         group_values <- sort( as.numeric( paste( names(t1) ) ))
-                }
+    }
 
     #@@@@***
     res00 <- BIFIE_create_pseudogroup( datalistM, group, group_index, group_values )
@@ -69,8 +62,6 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
     res00$group -> group
     #@@@@***
 
-
-
     #**************************************************************************#
     # Rcpp call
     res <- bifie_hist(  datalistM, wgt_, wgtrep,
@@ -92,33 +83,29 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
         if ( stats::sd ( diff(res$mids) ) < .000001 ){ h1$equidist <- TRUE } else { h1$equidist <- FALSE }
         class(h1) <- "histogram"
         histobj[[gg]] <- h1
-        # histobj[[gg]] <- h1$xname
-                    }
+    }
     names(histobj) <- paste0( vars, "_", group, group_values )
     #*************************** OUTPUT ***************************************
     s2 <- Sys.time()
-    timediff <- c( s1, s2 ) #, paste(s2-s1 ) )
-    res1 <- list( "histobj"=histobj,
-            "output"=res,
-            "timediff"=timediff,
-            "N"=N, "Nimp"=Nimp, "RR"=RR, "fayfac"=fayfac,
-            "NMI"=BIFIEobj$NMI, "Nimp_NMI"=BIFIEobj$Nimp_NMI,
-            "GG"=GG, "CALL"=cl)
+    timediff <- c( s1, s2 )
+    res1 <- list( histobj=histobj, output=res, timediff=timediff,
+                    N=N, Nimp=Nimp, RR=RR, fayfac=fayfac, NMI=BIFIEobj$NMI,
+                    Nimp_NMI=BIFIEobj$Nimp_NMI, GG=GG, CALL=cl)
     class(res1) <- "BIFIE.hist"
     return(res1)
-        }
-###################################################################################
+}
+
 
-####################################################################################
-# summary for BIFIE.hist function
+#** summary for BIFIE.hist function
 summary.BIFIE.hist <- function( object,  ... )
 {
     BIFIE.summary(object)
 }
-##########################################################################
-# plot function
+
+#** plot function
 plot.BIFIE.hist <- function( x, ask=TRUE, ... )
 {
+    requireNamespace("graphics")
     res <- x
     GG <- res$GG
     for (gg in 1:GG){

diff --git a/R/BIFIE.lavaan.survey.R b/R/BIFIE.lavaan.survey.R
@@ -1,5 +1,5 @@
 ## File Name: BIFIE.lavaan.survey.R
-## File Version: 0.597
+## File Version: 0.624
 
 
 BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
@@ -38,11 +38,19 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
         Nimp <- svyrepdes$Nimp
         fayfac <- svyrepdes$fayfac
         NMI <- svyrepdes$NMI
+        if (NMI){
+            lavaan_survey_default <- FALSE
+        }
+        Nimp_NMI <- svyrepdes$Nimp_NMI
+        svyrepdes$NMI <- FALSE
         RR <- svyrepdes$RR
-        bifie_nmi_error_message(fun="BIFIE.lavaan.survey", NMI=NMI)
-        variables <- BIFIE_lavaan_survey_define_variables(lavmodel=lavmodel,
-                            svyrepdes=svyrepdes)
-        datalist <- BIFIE.BIFIEdata2datalist(bifieobj=svyrepdes, varnames=variables)
+        if (lavaan_survey_default){
+            svyrepdes <- BIFIEdata2svrepdesign(bifieobj=svyrepdes)
+        } else {
+            variables <- BIFIE_lavaan_survey_define_variables(lavmodel=lavmodel,
+                                svyrepdes=svyrepdes)
+            datalist <- BIFIE.BIFIEdata2datalist(bifieobj=svyrepdes, varnames=variables)
+        }
     }
     N <- nrow(data0)
 
@@ -55,8 +63,7 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
 
     #* wrapper to lavaan.survey
     if (lavaan_survey_default){
-        res <- BIFIE_lavaan_survey_lavaan_survey(lavaan.fit=lavfit,
-                            survey.design=svyrepdes)
+        res <- BIFIE_lavaan_survey_lavaan_survey(lavaan.fit=lavfit, survey.design=svyrepdes)
         fitstat <- BIFIE_lavaan_fitMeasures(object=res, fit.measures=fit.measures)
         results <- BIFIE_lavaan_coef(object=res)
         variances <- BIFIE_lavaan_vcov(object=res)
@@ -73,16 +80,25 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
             res <- BIFIE_lavaan_survey_lavaan_survey(lavaan.fit=lavfit,
                             survey.design=svyrepdes0)
             results[[ii]] <- BIFIE_lavaan_coef(object=res)
-            variances[[ii]] <- BIFIE_lavaan_vcov(object=lavfit)
+            variances[[ii]] <- BIFIE_lavaan_vcov(object=res)
             fitstat[[ii]] <- BIFIE_lavaan_fitMeasures(object=res, fit.measures=fit.measures)
             partable[[ii]] <- res@ParTable
         }
 
+        results <- bifie_extend_list_length2(x=results)
+        variances <- bifie_extend_list_length2(x=variances)
+
         # combine fit statistics
         fitstat <- bifie_lavaan_survey_combine_fit_measures(fitstat=fitstat, Nimp=Nimp)
 
-        # inference parameters
-        inf_res <- mitools::MIcombine(results=results, variances=variances)
+        if (! NMI){
+            # inference parameters for multiply imputed datasets
+            inf_res <- BIFIE_mitools_MIcombine(results=results, variances=variances)
+        } else {
+            # nested multiply imputed datasets
+            inf_res <- bifie_lavaan_survey_NMIcombine(results=results,
+                            variances=variances, Nimp_NMI=Nimp_NMI)
+        }
 
         #--- include merged parameters
         res@Fit@x <- as.vector(inf_res$coefficients)
@@ -98,7 +114,7 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
     s2 <- Sys.time()
     time <- c(s1, s2)
     res1 <- list(lavfit=res, fitstat=fitstat, CALL=CALL, time=time,
-                    NMI=NMI, fayfac=fayfac, N=N, Nimp=Nimp, RR=RR,
+                    NMI=NMI, fayfac=fayfac, N=N, Nimp=Nimp, Nimp_NMI=Nimp_NMI, RR=RR,
                     results=results, variances=variances, partable=partable )
     class(res1) <- "BIFIE.lavaan.survey"
     return(res1)

diff --git a/R/BIFIE.logistreg.R b/R/BIFIE.logistreg.R
@@ -1,5 +1,5 @@
 ## File Name: BIFIE.logistreg.R
-## File Version: 0.431
+## File Version: 0.432
 
 
 #-- logistic regression
@@ -87,11 +87,11 @@ BIFIE.logistreg <- function( BIFIEobj, dep=NULL, pre=NULL,
     #@@@@***
 
     #--- Rcpp call to logistic regression
-    res <- bifiesurvey_rcpp_logistreg( datalist=datalistM, wgt1=wgt_, 
-                wgtrep=as.matrix(wgtrep), dep_index=dep_index-1, pre_index=pre_index-1, 
+    res <- bifiesurvey_rcpp_logistreg( datalist=datalistM, wgt1=wgt_,
+                wgtrep=as.matrix(wgtrep), dep_index=dep_index-1, pre_index=pre_index-1,
                 fayfac=fayfac, NI=Nimp, group_index1=group_index-1, group_values=group_values,
                 eps=eps, maxiter=maxiter )
-                
+
     GG <- length(group_values)
     ZZ <- VV+1
     p1 <- c( rep("b",VV), "R2" )