3.4-1

alexanderrobitzsch · Jun 12, 2019 · 8777cda · 8777cda
1 parent 8dc6b02
commit 8777cda
Show file tree

Hide file tree

Showing 59 changed files with 166 additions and 185 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.3-6
-Date: 2019-05-12 11:41:41
+Version: 3.4-1
+Date: 2019-06-12 17:17:21
 Author: BIFIE [aut], Alexander Robitzsch [aut, cre], 
         Konrad Oberwimmer [aut]
 Maintainer: Alexander Robitzsch <robitzsch@ipn.uni-kiel.de>
@@ -32,7 +32,7 @@ Imports:
 Suggests:
     graphics, grDevices, lavaan, lavaan.survey, mitools, survey, TAM
 Enhances:
-    car, Hmisc, intsvy, lme4, LSAmitR, svyPVpack 
+    Hmisc, intsvy, LSAmitR, svyPVpack 
 LinkingTo: 
     Rcpp, RcppArmadillo    
 License: GPL (>= 2)

diff --git a/R/BIFIE.cdata.select.R b/R/BIFIE.cdata.select.R
@@ -1,45 +1,38 @@
 ## File Name: BIFIE.cdata.select.R
-## File Version: 1.11
+## File Version: 1.13
 
 
-#######################################################################
-# selection variables or datasets in BIFIEcdata objects
+#--- selection variables or datasets in BIFIEcdata objects
 BIFIE.cdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ){
 
     if ( ! bifieobj$cdata ){
         stop("Use 'BIFIE.data.select' or the general function 'BIFIEdata.select'")
-                        }
+    }
 
     # retain variable "one"
     varnames0 <- bifieobj$varnames
     if ( ! is.null(varnames) ){
             varnames <- union( varnames, intersect( "one", varnames0) )
-                            }
+    }
 
     #******* do some variable checking
     if ( ! is.null(varnames) ){
-#        h1 <- setdiff( varnames, colnames(bifieobj$dat1) )
         h1 <- setdiff( varnames, bifieobj$varnames )
-
         if ( length(h1) > 0 ){
             stop( paste0( "Following variables not in BIFIEdata object:\n  ",
                         paste0( h1, collapse=" " ) ) )
-                            }
-                        }
+        }
+    }
 
     #******** select some imputed datasets
     if ( ! is.null(impdata.index ) ){
-        # i1 <- impdata.index - 1
         i1 <- impdata.index
         bifieobj$datalistM_imputed <- bifieobj$datalistM_imputed[, i1, drop=FALSE]
-#        h1 <- bifieobj$datalistM_imputed[,"_imp"]
-#        bifieobj$datalistM_imputed[,"_imp"] <- match( h1, i1 ) - 1
         bifieobj$Nimp <- length(i1)
-                }
+    }
 
     #********* select some variables
     if ( ! is.null( varnames) ){
-
         dfr1 <- data.frame( "varnames"=bifieobj$varnames,
                     "index"=seq(1,length(bifieobj$varnames) ) )
         dfr1$selectvars <- 1 * ( dfr1$varnames %in% varnames )
@@ -48,20 +41,14 @@ BIFIE.cdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ){
         i1 <- bifieobj$datalistM_impindex[,2] %in% ( dfr1$index - 1 )
         bifieobj$datalistM_imputed <- bifieobj$datalistM_imputed[ i1,, drop=FALSE]
         bifieobj$datalistM_impindex <- bifieobj$datalistM_impindex[ i1,, drop=FALSE]
-
         impindex2 <- match( bifieobj$datalistM_impindex[,2], dfr1$index - 1 ) - 1
         bifieobj$datalistM_impindex[,2] <- impindex2
-
-#        bifieobj$datalistM_imputed[,"variable"] <-
-#                    match( bifieobj$datalistM_imputed[,"variable"] + 1, dfr1$index ) - 1
         bifieobj$dat1 <- bifieobj$dat1[, dfr1$index, drop=FALSE]
         bifieobj$varnames <- bifieobj$varnames[ dfr1$index ]
-
         # process variable list
         bifieobj$variables <- bifieobj$variables[  dfr1$index,, drop=FALSE]
     }
 
     bifieobj$Nvars <- ncol(bifieobj$dat1)
     return(bifieobj)
-        }
-############################################################################
+}
diff --git a/R/BIFIE.data.R b/R/BIFIE.data.R
@@ -1,9 +1,8 @@
 ## File Name: BIFIE.data.R
-## File Version: 1.44
+## File Version: 1.471
 
-##################################################################
-# Convert a list of multiply imputed datasets into an object
-#      of class BIFIEdata
+
+# Convert a list of multiply imputed datasets into an object of class BIFIEdata
 BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
         pv_vars=NULL, pvpre=NULL, cdata=FALSE, NMI=FALSE )
 {
@@ -19,9 +18,9 @@ BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
         }
         if (!is.null(pvpre)){
             cn_data <- colnames(data.list)
-            pv_vars <- bifie_data_select_pv_vars(pvpre=pvpre, cn_data=cn_data)
+            pv_vars <- BIFIE_data_select_pv_vars(pvpre=pvpre, cn_data=cn_data)
         }
-        data.list <- bifie_data_pv_vars_create_datlist(pvpre=pvpre, pv_vars=pv_vars,
+        data.list <- BIFIE_data_pv_vars_create_datlist(pvpre=pvpre, pv_vars=pv_vars,
                 jktype=jktype, data=data.list)
     }
 
@@ -96,8 +95,7 @@ BIFIE.data <- function( data.list, wgt=NULL, wgtrep=NULL, fayfac=1,
         res <- BIFIE.BIFIEdata2BIFIEcdata( bifieobj=res, varnames=NULL )
                 }
     return(res)
-    }
-########################################################################
+}
 
 #**************** print method ***********************
 print.BIFIEdata <- function(x,...){
@@ -119,4 +117,3 @@ print.BIFIEdata <- function(x,...){
     v1 <- paste0( x$N, " cases and ",    x$Nvars, " variables \n" )
     cat(v1)
 }
-########################################################
diff --git a/R/BIFIE.data.jack.R b/R/BIFIE.data.jack.R
@@ -1,7 +1,8 @@
 ## File Name: BIFIE.data.jack.R
-## File Version: 1.67
-###########################################################
-# BIFIE.data objects for designs with jackknife zones
+## File Version: 1.703
+
+
+#--- BIFIE.data objects for designs with jackknife zones
 BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
     jkzone=NULL, jkrep=NULL, jkfac=NULL, fayfac=NULL,
     wgtrep="W_FSTR", pvpre=paste0("PV",1:5), ngr=100,
@@ -29,8 +30,8 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
         dataL <- data
     }
     data <- as.data.frame( data )
-    #*********************************************************
-    # using fixed jackknife zones
+
+    #*** using fixed jackknife zones
     if (jktype=="JK_GROUP"){
         N <- nrow(data)
         if ( is.null(wgt) ){
@@ -43,8 +44,6 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
         jkfac <- 0
     }
 
-
-    #**********************************************************
     #*** defaults for jackknife creation: random groups
     if (jktype=="JK_RANDOM"){
         N <- nrow(data)
@@ -71,7 +70,6 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
         jkfac <- 0
     }
 
-    #**********************************************************
     #**** defaults for TIMSS
     if (jktype %in% c("JK_TIMSS","JK_TIMSS2") ){
         if ( is.null(jkrep) ){
@@ -85,7 +83,7 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
         }
         jkfac <- 2
     }
-    #***********************************************************
+
     #**** defaults for PISA
     if (jktype=="RW_PISA"){
         jkrep <- NULL
@@ -98,13 +96,14 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
         repvars <- grep( wgtrep, cn_data )
         RR <- length(repvars)
 
-        pv_vars <- bifie_data_select_pv_vars(pvpre, cn_data )
+        pv_vars <- BIFIE_data_select_pv_vars(pvpre, cn_data )
         datarep <- data[, repvars ]
         RR <- ncol(datarep)
         fayfac <- 1 /  RR / ( 1 - .5)^2
         data <- data[, - repvars ]
     }
-    #******** generate replicate weights
+
+    #**** generate replicate weights
     if ( jktype %in% c("JK_TIMSS", "JK_GROUP", "JK_RANDOM", "JK_TIMSS2") ) {
         # redefine jackknife zones
         jkzones1 <- unique( data[,jkzone] )
@@ -145,7 +144,7 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
 
     #--------------------------------------------------
     if ( ! is.null( pv_vars )){
-        datalist <- bifie_data_pv_vars_create_datlist( pvpre=pvpre, pv_vars=pv_vars,
+        datalist <- BIFIE_data_pv_vars_create_datlist( pvpre=pvpre, pv_vars=pv_vars,
                             jktype=jktype, data=data )
     }  # end pv_vars
     #--------------------------------------------------
@@ -160,4 +159,3 @@ BIFIE.data.jack <- function( data, wgt=NULL, jktype="JK_TIMSS", pv_vars=NULL,
     bifiedat$CALL <- cl
     return(bifiedat)
 }
-###############################################################################
diff --git a/R/BIFIE.hist.R b/R/BIFIE.hist.R
@@ -1,5 +1,5 @@
 ## File Name: BIFIE.hist.R
-## File Version: 0.283
+## File Version: 0.287
 
 
 #--- Histogram
@@ -62,25 +62,21 @@ BIFIE.hist <- function( BIFIEobj, vars, breaks=NULL,
     res00$group -> group
     #@@@@***
 
-    #**************************************************************************#
-    # Rcpp call
-    res <- bifie_hist(  datalistM, wgt_, wgtrep,
-                vars_index - 1,    fayfac,
-                Nimp, group_index - 1, group_values, breaks )
+    #--- Rcpp call
+    res <- bifie_hist( datalist=datalistM, wgt1=wgt_, wgtrep=wgtrep,
+                vars_index=vars_index-1, fayfac=fayfac, NI=Nimp,
+                group_index1=group_index-1, group_values=group_values, breaks=breaks )
 
     # create histogram objects
     GG <- length(group_values)
     histobj <- list(1:GG)
     BB <- res$BB
 
     for (gg in 1:GG){
-        h1 <- list( "breaks"=res$breaks,
-                "counts"=res$sumwgt[ ( gg-1)*BB + 1:BB ],
-                "density"=res$density_vec[ ( gg-1)*BB + 1:BB ],
-                "mids"=res$mids
-                        )
+        h1 <- list( breaks=res$breaks, counts=res$sumwgt[ ( gg-1)*BB + 1:BB ],
+                    density=res$density_vec[ ( gg-1)*BB + 1:BB ], mids=res$mids )
         h1$xname <- paste0( vars, "_", group, group_values[gg] )
-        if ( stats::sd ( diff(res$mids) ) < .000001 ){ h1$equidist <- TRUE } else { h1$equidist <- FALSE }
+        if ( stats::sd( diff(res$mids) ) < .000001 ){ h1$equidist <- TRUE } else { h1$equidist <- FALSE }
         class(h1) <- "histogram"
         histobj[[gg]] <- h1
     }
@@ -109,7 +105,7 @@ plot.BIFIE.hist <- function( x, ask=TRUE, ... )
     res <- x
     GG <- res$GG
     for (gg in 1:GG){
-        graphics::plot( res$histobj[[gg]], ... )
+        graphics::plot(res$histobj[[gg]], ... )
         graphics::par(ask=ask)
     }
 }

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.624
+## File Version: 0.641
 
 
 BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
@@ -15,6 +15,7 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
     #* handle design
     is_survey_design <- FALSE
     NMI <- FALSE
+    Nimp_NMI <- NULL
     variables <- NULL
     if ( class(svyrepdes)=="svyrep.design" ){
         svyrepdes0 <- svyrepdes
@@ -56,7 +57,10 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
 
     #- fit initial lavaan model
     lav_fun <- BIFIE_lavaan_survey_define_lavaan_function(lavaan_fun=lavaan_fun)
-    lavfit <- lav_fun(lavmodel, data=data0, ...)
+    lavmodel__ <- lavmodel
+    args <- list(x="lavmodel__", value=lavmodel, pos=1)
+    res <- do.call(what="assign", args=args)
+    lavfit <- lav_fun(lavmodel__, data=data0, ...)
     class_lav <- class(lavfit)
     lavfit_coef <- BIFIE_lavaan_coef(object=lavfit)
     npar <- length(lavfit_coef)
@@ -89,14 +93,14 @@ BIFIE.lavaan.survey <- function(lavmodel, svyrepdes, lavaan_fun="sem",
         variances <- bifie_extend_list_length2(x=variances)
 
         # combine fit statistics
-        fitstat <- bifie_lavaan_survey_combine_fit_measures(fitstat=fitstat, Nimp=Nimp)
+        fitstat <- BIFIE_lavaan_survey_combine_fit_measures(fitstat=fitstat, Nimp=Nimp)
 
         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,
+            inf_res <- BIFIE_lavaan_survey_NMIcombine(results=results,
                             variances=variances, Nimp_NMI=Nimp_NMI)
         }
 

diff --git a/R/BIFIE.logistreg.R b/R/BIFIE.logistreg.R
@@ -1,5 +1,5 @@
 ## File Name: BIFIE.logistreg.R
-## File Version: 0.432
+## File Version: 0.434
 
 
 #-- logistic regression
@@ -99,8 +99,8 @@ BIFIE.logistreg <- function( BIFIEobj, dep=NULL, pre=NULL,
     dfr <- data.frame( "parameter"=rep(p1,GG) )
     dfr$var <- rep(p2,GG)
     if (! nogroup){
-       dfr$groupvar <- group
-       dfr$groupval <- rep( group_values, each=ZZ )
+        dfr$groupvar <- group
+        dfr$groupval <- rep( group_values, each=ZZ )
     }
     dfr$Ncases <- rep( rowMeans( res$ncasesM ), each=ZZ )
     dfr$Nweight <- rep( rowMeans( res$sumwgtM ), each=ZZ )
@@ -129,9 +129,8 @@ BIFIE.logistreg <- function( BIFIEobj, dep=NULL, pre=NULL,
     class(res1) <- "BIFIE.logistreg"
     return(res1)
 }
-###################################################################################
 
-####################################################################################
+
 # summary for BIFIE.linreg function
 summary.BIFIE.logistreg <- function( object, digits=4, ... )
 {

diff --git a/R/BIFIE.survey.R b/R/BIFIE.survey.R
@@ -1,11 +1,12 @@
 ## File Name: BIFIE.survey.R
-## File Version: 0.224
+## File Version: 0.226
 
 BIFIE.survey <- function(svyrepdes, survey.function, ...)
 {
     CALL <- match.call()
     s1 <- Sys.time()
     NMI <- FALSE
+    Nimp_NMI <- NULL
     svrepdes <- svyrepdes
     if ( class(svyrepdes)=="BIFIEdata"){
         data0 <- svyrepdes$dat1
@@ -63,7 +64,7 @@ BIFIE.survey <- function(svyrepdes, survey.function, ...)
         stat <- BIFIE_mitools_MIcombine(results=results)
     } else {
         #*** nested multiply imputed dataset
-        stat <- bifie_NMIcombine_results(results=results, Nimp_NMI=Nimp_NMI, package="stats")
+        stat <- BIFIE_NMIcombine_results(results=results, Nimp_NMI=Nimp_NMI, package="stats")
     }
 
     #-- output