diff --git a/DESCRIPTION b/DESCRIPTION index 9eefacc..4bec91d 100644 --- 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 @@ -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 index 07d76e5..d46a3ce 100644 --- 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 index ebcc0a8..8167f31 100644 --- a/R/BIFIE.BIFIEcdata2BIFIEdata.R +++ b/R/BIFIE.BIFIEcdata2BIFIEdata.R @@ -1,23 +1,23 @@ ## 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 @@ -25,4 +25,3 @@ BIFIE.BIFIEcdata2BIFIEdata <- function( bifieobj, varnames=NULL, impdata.index=N bifieobj$wgtrep <- as.matrix(bifieobj$wgtrep) return(bifieobj) } -############################################################## diff --git a/R/BIFIE.BIFIEdata2datalist.R b/R/BIFIE.BIFIEdata2datalist.R index 4e2627f..34f7110 100644 --- 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 index e159d80..ea55c12 100644 --- 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 index 38734d2..951fb59 100644 --- 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 index 1bf752b..16c0be4 100644 --- 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 index 828a298..b33f355 100644 --- 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" ) diff --git a/R/BIFIE.survey.R b/R/BIFIE.survey.R index cbd1a56..f66acbd 100644 --- a/R/BIFIE.survey.R +++ b/R/BIFIE.survey.R @@ -1,5 +1,5 @@ ## File Name: BIFIE.survey.R -## File Version: 0.204 +## File Version: 0.224 BIFIE.survey <- function(svyrepdes, survey.function, ...) { @@ -13,10 +13,11 @@ BIFIE.survey <- function(svyrepdes, survey.function, ...) Nimp <- svyrepdes$Nimp fayfac <- svyrepdes$fayfac NMI <- svyrepdes$NMI + Nimp_NMI <- svyrepdes$Nimp_NMI + svyrepdes$NMI <- FALSE RR <- svyrepdes$RR wgt <- svyrepdes$wgt wgtrep <- svyrepdes$wgtrep - bifie_nmi_error_message(fun="BIFIE.survey", NMI=NMI) variables <- NULL args <- list(...) for (vv in c("formula", "x")){ @@ -43,9 +44,8 @@ BIFIE.survey <- function(svyrepdes, survey.function, ...) svyrep_ii <- NULL for (ii in 1:Nimp){ if ( class(svyrepdes)=="BIFIEdata"){ - svyrep_ii <- BIFIE_lavaan_survey_extract_dataset( - svyrepdes=svyrepdes, ii=ii, variables=NULL, - svyrepdes0=svyrep_ii, datalist=datalist) + svyrep_ii <- BIFIE_lavaan_survey_extract_dataset( svyrepdes=svyrepdes, + ii=ii, variables=NULL, svyrepdes0=svyrep_ii, datalist=datalist) } if ( class(svyrepdes)=="svyimputationList"){ svyrep_ii <- svrepdes$designs[[ii]] @@ -55,16 +55,22 @@ BIFIE.survey <- function(svyrepdes, survey.function, ...) res[[ii]] <- do.call( what=survey.function, args=args) } results <- res + results <- bifie_extend_list_length2(x=results) + } + + if (! NMI){ + #*** statistical inference using mitools package + stat <- BIFIE_mitools_MIcombine(results=results) + } else { + #*** nested multiply imputed dataset + stat <- bifie_NMIcombine_results(results=results, Nimp_NMI=Nimp_NMI, package="stats") } - #*** statistical inference using mitools package - stat <- mitools::MIcombine(results=results) #-- output s2 <- Sys.time() time <- c(s1, s2) - res1 <- list(stat=stat, CALL=CALL, time=time, - NMI=NMI, fayfac=fayfac, N=N, Nimp=Nimp, RR=RR, - results=results) + res1 <- list(stat=stat, CALL=CALL, time=time, NMI=NMI, fayfac=fayfac, N=N, + Nimp=Nimp, RR=RR, results=results, Nimp_NMI=Nimp_NMI) class(res1) <- "BIFIE.survey" return(res1) } diff --git a/R/BIFIE.twolevelreg.R b/R/BIFIE.twolevelreg.R index c617199..fd038a3 100644 --- a/R/BIFIE.twolevelreg.R +++ b/R/BIFIE.twolevelreg.R @@ -1,15 +1,12 @@ ## File Name: BIFIE.twolevelreg.R -## File Version: 0.56 +## File Version: 0.581 -############################################################# -# BIFIE.twolevelreg +#--- BIFIE.twolevelreg BIFIE.twolevelreg <- function( BIFIEobj, dep, formula.fixed, formula.random, idcluster, wgtlevel2=NULL, wgtlevel1=NULL, group=NULL, group_values=NULL, recov_constraint=NULL, se=TRUE, globconv=1E-6, maxiter=1000) { - - #**** s1 <- Sys.time() cl <- match.call() @@ -225,7 +222,7 @@ BIFIE.twolevelreg <- function( BIFIEobj, dep, formula.fixed, formula.random, pars.list <- list( pars.list[[1]], pars.list[[1]] ) vcov.list <- list( vcov.list[[1]], vcov.list[[1]] ) } - micombs <- mitools::MIcombine( results=pars.list, variances=vcov.list ) + micombs <- BIFIE_mitools_MIcombine( results=pars.list, variances=vcov.list ) if ( ! se ){ dfr$SE <- dfr$fmi <- dfr$VarRep <- NA v1 <- diag( micombs$variance ) @@ -256,10 +253,8 @@ BIFIE.twolevelreg <- function( BIFIEobj, dep, formula.fixed, formula.random, class(res1) <- "BIFIE.twolevelreg" return(res1) } -############################################################# -#################################################################################### # summary for BIFIE.linreg function summary.BIFIE.twolevelreg <- function( object, digits=4, ... ) { diff --git a/R/BIFIE_lavaan_coef.R b/R/BIFIE_lavaan_coef.R index 13b2e15..cf095a4 100644 --- a/R/BIFIE_lavaan_coef.R +++ b/R/BIFIE_lavaan_coef.R @@ -1,10 +1,12 @@ ## File Name: BIFIE_lavaan_coef.R -## File Version: 0.08 +## File Version: 0.12 -BIFIE_lavaan_coef <- function(object) +BIFIE_lavaan_coef <- function(object, ...) { requireNamespace("lavaan") lavaan_coef <- methods::getMethod("coef", "lavaan") - est <- lavaan_coef(object) + est <- lavaan_coef(object, ...) return(est) } + + diff --git a/R/BIFIE_lavaan_survey_combine_partable.R b/R/BIFIE_lavaan_survey_combine_partable.R index d6144e9..ef9ecc8 100644 --- a/R/BIFIE_lavaan_survey_combine_partable.R +++ b/R/BIFIE_lavaan_survey_combine_partable.R @@ -1,12 +1,14 @@ ## File Name: BIFIE_lavaan_survey_combine_partable.R -## File Version: 0.06 +## File Version: 0.07 BIFIE_lavaan_survey_combine_partable <- function(partable, Nimp, inf_res) { partable0 <- partable[[1]] - for (ii in 2L:Nimp){ - partable_ii <- partable[[ii]] - partable0$est <- partable0$est + partable_ii$est + if (Nimp>1){ + for (ii in 2L:Nimp){ + partable_ii <- partable[[ii]] + partable0$est <- partable0$est + partable_ii$est + } } partable0$est <- partable0$est / Nimp partable <- partable0 diff --git a/R/BIFIE_lavaan_vcov.R b/R/BIFIE_lavaan_vcov.R index bf01b6b..575a740 100644 --- a/R/BIFIE_lavaan_vcov.R +++ b/R/BIFIE_lavaan_vcov.R @@ -1,9 +1,13 @@ ## File Name: BIFIE_lavaan_vcov.R -## File Version: 0.04 +## File Version: 0.05 -BIFIE_lavaan_vcov <- function(object) + +BIFIE_lavaan_vcov <- function(object, ...) { - res <- BIFIE_lavaan_lavInspect(object=object, what="vcov") - res <- as.matrix(res) - return(res) + requireNamespace("lavaan") + # res <- BIFIE_lavaan_lavInspect(object=object, what="vcov") + # res <- as.matrix(res) + lavaan_vcov <- methods::getMethod("vcov", "lavaan") + vcov1 <- lavaan_vcov(object, ...) + return(vcov1) } diff --git a/R/BIFIE_mitools_MIcombine.R b/R/BIFIE_mitools_MIcombine.R new file mode 100644 index 0000000..749af0d --- /dev/null +++ b/R/BIFIE_mitools_MIcombine.R @@ -0,0 +1,9 @@ +## File Name: BIFIE_mitools_MIcombine.R +## File Version: 0.02 + +BIFIE_mitools_MIcombine <- function(...) +{ + requireNamespace("mitools") + res <- mitools::MIcombine(...) + return(res) +} diff --git a/R/BIFIEdata.select.R b/R/BIFIEdata.select.R index 90984a7..92059b6 100644 --- a/R/BIFIEdata.select.R +++ b/R/BIFIEdata.select.R @@ -1,22 +1,23 @@ ## File Name: BIFIEdata.select.R -## File Version: 1.08 +## File Version: 1.09 + -#.............................................................. # wrapper function for subfunctions BIFIE.data.select and # BIFIE.cdata.select -BIFIEdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ){ +BIFIEdata.select <- function( bifieobj, varnames=NULL, impdata.index=NULL ) +{ cdata <- bifieobj$cdata if ( cdata ){ - bifieobj <- BIFIE.cdata.select( bifieobj=bifieobj, + bifieobj <- BIFIE.cdata.select( bifieobj=bifieobj, varnames=varnames, impdata.index=impdata.index ) - } + } if ( ! cdata ){ - bifieobj <- BIFIE.data.select( bifieobj=bifieobj, + bifieobj <- BIFIE.data.select( bifieobj=bifieobj, varnames=varnames, impdata.index=impdata.index ) - } + } return(bifieobj) - } -#.............................................................. +} + diff --git a/R/BIFIEdata2svrepdesign.R b/R/BIFIEdata2svrepdesign.R index bbb2010..10779e2 100644 --- a/R/BIFIEdata2svrepdesign.R +++ b/R/BIFIEdata2svrepdesign.R @@ -1,9 +1,10 @@ ## File Name: BIFIEdata2svrepdesign.R -## File Version: 0.28 +## File Version: 0.30 BIFIEdata2svrepdesign <- function(bifieobj, varnames=NULL, impdata.index=NULL ) { + requireNamespace("mitools") requireNamespace("survey") CALL <- match.call() Nimp <- bifieobj$Nimp diff --git a/R/RcppExports.R b/R/RcppExports.R index 2ae1ccb..2717b42 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,5 +1,5 @@ ## File Name: RcppExports.R -## File Version: 3.002017 +## File Version: 3.003001 # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 diff --git a/R/bifie_NMIcombine_results.R b/R/bifie_NMIcombine_results.R new file mode 100644 index 0000000..a96e357 --- /dev/null +++ b/R/bifie_NMIcombine_results.R @@ -0,0 +1,25 @@ +## File Name: bifie_NMIcombine_results.R +## File Version: 0.07 + +bifie_NMIcombine_results <- function(results, Nimp_NMI, package="stats") +{ + if (package=="stats"){ + fun_coef <- coef + fun_vcov <- vcov + } + if (package=="lavaan"){ + fun_coef <- BIFIE_lavaan_coef + fun_vcov <- BIFIE_lavaan_vcov + } + #- estimates + qhat <- bifie_NMIcombine_results_extract_parameters(results=results, + fun=fun_coef, Nimp_NMI=Nimp_NMI) + + #- variance matrices + u <- bifie_NMIcombine_results_extract_parameters(results=results, + fun=fun_vcov, Nimp_NMI=Nimp_NMI) + + #- inference + stat <- miceadds::NMIcombine(qhat=qhat, u=u) + return(stat) +} diff --git a/R/bifie_NMIcombine_results_extract_parameters.R b/R/bifie_NMIcombine_results_extract_parameters.R new file mode 100644 index 0000000..6932ba3 --- /dev/null +++ b/R/bifie_NMIcombine_results_extract_parameters.R @@ -0,0 +1,12 @@ +## File Name: bifie_NMIcombine_results_extract_parameters.R +## File Version: 0.02 + + +bifie_NMIcombine_results_extract_parameters <- function(results, fun, Nimp_NMI, + loop_within=TRUE) +{ + u <- lapply(results, FUN=function(res){ fun(res) } ) + res <- miceadds::List2nestedList(List=u, N_between=Nimp_NMI[1], + N_within=Nimp_NMI[2], loop_within=loop_within) + return(res) +} diff --git a/R/bifie_extend_list_length2.R b/R/bifie_extend_list_length2.R new file mode 100644 index 0000000..8139ff4 --- /dev/null +++ b/R/bifie_extend_list_length2.R @@ -0,0 +1,11 @@ +## File Name: bifie_extend_list_length2.R +## File Version: 0.03 + +bifie_extend_list_length2 <- function(x) +{ + N <- length(x) + if (N==1){ + x <- list( x[[1]], x[[1]] ) + } + return(x) +} diff --git a/R/bifie_lavaan_survey_NMIcombine.R b/R/bifie_lavaan_survey_NMIcombine.R new file mode 100644 index 0000000..1ac5e30 --- /dev/null +++ b/R/bifie_lavaan_survey_NMIcombine.R @@ -0,0 +1,15 @@ +## File Name: bifie_lavaan_survey_NMIcombine.R +## File Version: 0.02 + +bifie_lavaan_survey_NMIcombine <- function(results, variances, Nimp_NMI) +{ + qhat <- miceadds::List2nestedList(List=results, N_between=Nimp_NMI[1], + N_within=Nimp_NMI[2], loop_within=TRUE) + u <- miceadds::List2nestedList(List=variances, N_between=Nimp_NMI[1], + N_within=Nimp_NMI[2], loop_within=TRUE) + #- inference + inf_res <- miceadds::NMIcombine(qhat=qhat, u=u) + inf_res$coefficients <- inf_res$qbar + inf_res$variance <- inf_res$Tm + return(inf_res) +} diff --git a/R/coef.BIFIE.lavaan.survey.R b/R/coef.BIFIE.lavaan.survey.R index d95d714..0cf7d3d 100644 --- a/R/coef.BIFIE.lavaan.survey.R +++ b/R/coef.BIFIE.lavaan.survey.R @@ -1,5 +1,5 @@ ## File Name: coef.BIFIE.lavaan.survey.R -## File Version: 0.03 +## File Version: 0.05 coef.BIFIE.lavaan.survey <- function(object, ...) @@ -10,5 +10,5 @@ coef.BIFIE.lavaan.survey <- function(object, ...) vcov.BIFIE.lavaan.survey <- function(object, ...) { - vcov(object$lavfit, ...) + BIFIE_lavaan_vcov(object$lavfit, ...) } diff --git a/README.md b/README.md index 9f1d1f8..5524531 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ If you use `BIFIEsurvey` and have suggestions for improvement or have found bugs, please email me at robitzsch@ipn.uni-kiel.de. -#### CRAN version `BIFIEsurvey` 3.1-33 (2019-03-20) +#### CRAN version `BIFIEsurvey` 3.2-25 (2019-04-16) [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version-last-release/BIFIEsurvey)](https://cran.r-project.org/package=BIFIEsurvey) @@ -18,9 +18,9 @@ The CRAN version can be installed from within R using: utils::install.packages("BIFIEsurvey") ``` -#### GitHub version `BIFIEsurvey` 3.2-17 (2019-03-29) +#### GitHub version `BIFIEsurvey` 3.3-1 (2019-04-16) -[![](https://img.shields.io/badge/github%20version-3.2--17-orange.svg)](https://github.com/alexanderrobitzsch/BIFIEsurvey)   +[![](https://img.shields.io/badge/github%20version-3.3--1-orange.svg)](https://github.com/alexanderrobitzsch/BIFIEsurvey)   The version hosted [here](https://github.com/alexanderrobitzsch/BIFIEsurvey) is the development version of `BIFIEsurvey`. The GitHub version can be installed using `devtools` as: diff --git a/inst/NEWS b/inst/NEWS index 31320fa..68b1644 100644 --- a/inst/NEWS +++ b/inst/NEWS @@ -49,9 +49,19 @@ CHANGELOG BIFIEsurvey +-------------------------------------------------------------------------- +VERSIONS BIFIEsurvey 3.3 | 2019-04-16 | Last: BIFIEsurvey 3.3-1 +-------------------------------------------------------------------------- + +xxx * --- + +DATA * --- +EXAMP * --- + + -------------------------------------------------------------------------- -VERSIONS BIFIEsurvey 3.2 | 2019-03-29 | Last: BIFIEsurvey 3.2-17 +VERSIONS BIFIEsurvey 3.2 | 2019-04-16 | Last: BIFIEsurvey 3.2-25 -------------------------------------------------------------------------- FIXED * fixed a bug in BIFIE.lavaan.survey() @@ -59,14 +69,12 @@ NOTE * leading zeros in formulas in BIFIE.data.transform() or BIFIE.derivedParameters() (e.g., ~ 0 + as.factor(books)) are no longer needed ADDED * included pseudo-R^2 of McKelvey and Zavoina in BIFIE.logistreg() - +ADDED * extended BIFIE.lavaan.survey() and BIFIE.survey() to nested + multiply imputed datasets DATA * --- -EXAMP * BIFIE.derivedParameters (1), BIFIE.data.transform (1) - - - - +EXAMP * BIFIE.derivedParameters (1), BIFIE.data.transform (1), + BIFIE.lavaan.survey (3) -------------------------------------------------------------------------- VERSIONS BIFIEsurvey 3.1 | 2019-03-20 | Last: BIFIEsurvey 3.1-33 diff --git a/man/BIFIE.lavaan.survey.Rd b/man/BIFIE.lavaan.survey.Rd index 9559277..9a93709 100644 --- a/man/BIFIE.lavaan.survey.Rd +++ b/man/BIFIE.lavaan.survey.Rd @@ -1,5 +1,5 @@ %% File Name: BIFIE.lavaan.survey.Rd -%% File Version: 0.206 +%% File Version: 0.210 \name{BIFIE.lavaan.survey} \alias{BIFIE.lavaan.survey} @@ -160,11 +160,41 @@ print(sdat) #- fit models in survey mod1 <- BIFIEsurvey::BIFIE.linreg(bdat, formula=ASMMAT~ASSSCI) -mod2 <- BIFIEsurvey::BIFIE.survey( sdat, survey.function=survey::svyglm, formula=ASMMAT~ASSSCI) -mod3 <- BIFIEsurvey::BIFIE.survey( bdat, survey.function=survey::svyglm, formula=ASMMAT~ASSSCI) +mod2 <- BIFIEsurvey::BIFIE.survey( sdat, survey.function=survey::svyglm, + formula=ASMMAT~ASSSCI) +mod3 <- BIFIEsurvey::BIFIE.survey( bdat, survey.function=survey::svyglm, + formula=ASMMAT~ASSSCI) summary(mod1) summary(mod2) summary(mod3) + +############################################################################# +# EXAMPLE 3: Nested multiply imputed datasets | linear regression +############################################################################# + +library(lavaan) +data(data.timss4) +data(data.timssrep) + +# nested imputed dataset +bdat <- BIFIEsurvey::BIFIE.data( data.list=data.timss4, + wgt=data.timss4[[1]][[1]]$TOTWGT, wgtrep=data.timssrep[, -1 ], NMI=TRUE ) +summary(bdat) + +#*** BIFIEsurvey::BIFIE.linreg +mod1 <- BIFIEsurvey::BIFIE.linreg(bdat, formula=ASMMAT ~ migrant ) + +#*** survey::svyglm +mod2 <- BIFIEsurvey::BIFIE.survey(bdat, survey.function=survey::svyglm, + formula=ASMMAT~migrant) + +#*** lavaan.survey::lavaan.survey +lavmodel <- "ASMMAT ~ 1 + ASMMAT ~ migrant" +mod3 <- BIFIEsurvey::BIFIE.lavaan.survey(lavmodel, svyrepdes=bdat) + +coef(mod1); coef(mod2); coef(mod3) +se(mod1); BIFIEsurvey::se(mod2), BIFIEsurvey::se(mod3) } } % Add one or more standard keywords, see file 'KEYWORDS' in the diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index ac1c106..740f5da 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -1,5 +1,5 @@ //// File Name: RcppExports.cpp -//// File Version: 3.002017 +//// File Version: 3.003001 // Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 diff --git a/src/bifiesurvey_rcpp_logistreg.cpp b/src/bifiesurvey_rcpp_logistreg.cpp index f818166..d1a5a3a 100644 --- a/src/bifiesurvey_rcpp_logistreg.cpp +++ b/src/bifiesurvey_rcpp_logistreg.cpp @@ -1,5 +1,5 @@ //// File Name: bifiesurvey_rcpp_logistreg.cpp -//// File Version: 0.22 +//// File Version: 0.23 #include @@ -21,7 +21,7 @@ using namespace arma; //********************************************************** //**** logistic regression -Rcpp::List bifiesurvey_rcpp_logistreg_compute( Rcpp::NumericVector y, Rcpp::NumericMatrix X, +Rcpp::List bifiesurvey_rcpp_logistreg_compute( Rcpp::NumericVector y, Rcpp::NumericMatrix X, Rcpp::NumericVector wgt, Rcpp::NumericVector beta0, double eps, int maxiter ) { int N=X.nrow(); @@ -109,7 +109,7 @@ Rcpp::List bifiesurvey_rcpp_logistreg_compute( Rcpp::NumericVector y, Rcpp::Nume parm[pp] = beta_new(pp,0); } parm[P] = R2; - + //----- OUTPUT return Rcpp::List::create( Rcpp::Named("pardiff") = pardiff, @@ -125,7 +125,7 @@ Rcpp::List bifiesurvey_rcpp_logistreg_compute( Rcpp::NumericVector y, Rcpp::Nume // bifiesurvey_rcpp_logistreg // [[Rcpp::export]] Rcpp::List bifiesurvey_rcpp_logistreg( Rcpp::NumericMatrix datalist, Rcpp::NumericMatrix wgt1, - Rcpp::NumericMatrix wgtrep, Rcpp::NumericVector dep_index, Rcpp::NumericVector pre_index, + Rcpp::NumericMatrix wgtrep, Rcpp::NumericVector dep_index, Rcpp::NumericVector pre_index, Rcpp::NumericVector fayfac, Rcpp::NumericVector NI, Rcpp::NumericVector group_index1, Rcpp::NumericVector group_values, double eps, int maxiter ) { @@ -198,9 +198,9 @@ Rcpp::List bifiesurvey_rcpp_logistreg( Rcpp::NumericMatrix datalist, Rcpp::Numer Xt(tt,vv)=dat1( tempvec[tt], pre_index[vv] ); } } // end cases tt - + // logistic regression original dataset - Rcpp::List res1 = bifiesurvey_rcpp_logistreg_compute( yt, Xt, wgtt, + Rcpp::List res1 = bifiesurvey_rcpp_logistreg_compute( yt, Xt, wgtt, beta0, eps, maxiter ); Rcpp::NumericVector tempcoef = res1["beta"]; Rcpp::NumericVector tempparm = res1["parm"]; @@ -214,7 +214,7 @@ Rcpp::List bifiesurvey_rcpp_logistreg( Rcpp::NumericMatrix datalist, Rcpp::Numer for (int tt=0;tt