1.6-4

alexanderrobitzsch · Aug 25, 2021 · dd07598 · dd07598
1 parent 6150d32
commit dd07598
Show file tree

Hide file tree

Showing 22 changed files with 69 additions and 48 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: mdmb
 Type: Package
 Title: Model Based Treatment of Missing Data
-Version: 1.6-2
-Date: 2021-01-21 14:01:02
+Version: 1.6-4
+Date: 2021-08-25 13:07:50
 Author: 
     Alexander Robitzsch [aut, cre], Oliver Luedtke [aut]
 Maintainer: 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,5 +1,5 @@
 ## File Name: RcppExports.R
-## File Version: 1.006002
+## File Version: 1.006004
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

diff --git a/R/frm_em.R b/R/frm_em.R
@@ -1,5 +1,5 @@
 ## File Name: frm_em.R
-## File Version: 0.943
+## File Version: 0.949
 
 
 frm_em <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
@@ -65,6 +65,7 @@ frm_em <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
         beta_new <- res$coefs[[NM+1]]
         ll_new <- res$ll
         iter <- iter + 1
+
         #**** changes in parameters
         ll_change0 <- ( ll_new - ll_old ) / abs( ll_new)
         ll_change <- abs(ll_change0)

diff --git a/R/frm_fb.R b/R/frm_fb.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb.R
-## File Version: 0.813
+## File Version: 0.821
 
 ### Factored regression model
 ### Fully Bayesian estimation
@@ -9,7 +9,7 @@ frm_fb <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
             print_iter=10, use_gibbs=TRUE, aggregation=TRUE )
 {
     CALL <- match.call()
-    s1 <- Sys.time()
+    s1 <- zz0 <- Sys.time()
 
     #*****************----------------
     # adaptation of function for including new model classes
@@ -128,6 +128,7 @@ zz0 <- Sys.time()
         ind0 <- res$ind0
         model_results <- res$model_results
         parms_mcmc <- res$parms_mcmc
+        #    cat("\n -- i200") ; zz1 <- Sys.time(); print(zz1-zz0) ; zz0 <- zz1
 
         #*** imputation of missing values
         res <- frm_fb_sample_imputed_values( imputations_mcmc=imputations_mcmc,

diff --git a/R/frm_fb_init_imputations.R b/R/frm_fb_init_imputations.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_init_imputations.R
-## File Version: 0.485
+## File Version: 0.490
 
 frm_fb_init_imputations <- function( Nimp, model_results, burnin, iter, impute_vars,
         impute_vars_index, ind_miss, ind0, dv_vars,    variablesMatrix, dat=NULL )
@@ -71,7 +71,8 @@ frm_fb_init_imputations <- function( Nimp, model_results, burnin, iter, impute_v
             cluster_index_vv <- match( idcluster_vv, unique(idcluster_vv) )
             cluster_index[[vv]] <- cluster_index_vv
         }
-    }
+
+    }  # end vv
     iter_save_temp <- imp_save[1]
     saved_index <- 1
 

diff --git a/R/frm_fb_initial_parameters.R b/R/frm_fb_initial_parameters.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_initial_parameters.R
-## File Version: 0.467
+## File Version: 0.475
 
 frm_fb_initial_parameters <- function(dat, ind0, data_init, ind_miss=NULL )
 {
@@ -15,6 +15,7 @@ frm_fb_initial_parameters <- function(dat, ind0, data_init, ind_miss=NULL )
     parms00 <- list( NA, NA )
 
     for (mm in 1:NM1){
+
         ind_mm <- ind0[[mm]]
         var_mm <- ind_mm$dv_vars
         ind_miss_mm <- ind_miss[[ var_mm ]]
@@ -60,7 +61,6 @@ frm_fb_initial_parameters <- function(dat, ind0, data_init, ind_miss=NULL )
         if (model_mm %in% c("linreg","oprobit")){
             R_args$probit <- NULL
         }
-
         if (model_mm %in% c("mlreg")){
             R_args$inits_lme4 <- FALSE
         }
@@ -117,6 +117,7 @@ frm_fb_initial_parameters <- function(dat, ind0, data_init, ind_miss=NULL )
         }
         parms[[mm]] <- parms0
         ind0[[mm]] <- ind_mm
+
     }  # end mm
 
     #--- indices for parameters to be saved
@@ -133,7 +134,10 @@ frm_fb_initial_parameters <- function(dat, ind0, data_init, ind_miss=NULL )
                 parms_index[[mm]][[vv]] <- vec0
             }
         }
+
     }
+
+
     #--- output
     res <- list(ind0=ind0, parms=parms, parms_index=parms_index,
                 npars=N0, model_results=model_results, dat=dat )

diff --git a/R/frm_fb_sample_imputed_values.R b/R/frm_fb_sample_imputed_values.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_sample_imputed_values.R
-## File Version: 0.759
+## File Version: 0.769
 
 
 frm_fb_sample_imputed_values <- function( imputations_mcmc, model_results,
@@ -34,7 +34,6 @@ frm_fb_sample_imputed_values <- function( imputations_mcmc, model_results,
                     model_results=model_results[[ index_vv ]], ind_miss_vv=ind_miss_vv )
         dat1_vv[, var_vv ] <- imp1 <- res$imp1
         changed1 <- res$changed1
-
         do_mh <- res$do_mh
         NG <- res$NG
         gibbs_values <- res$gibbs_values
@@ -100,7 +99,6 @@ frm_fb_sample_imputed_values <- function( imputations_mcmc, model_results,
             }  # end mm
 
         }
-
         #**** evaluation proposal in Metropolis-Hastings sampling
         if (do_mh){
             args_mhratio <- list( like=like, like1=like1, use_sampling_level_vv=use_sampling_level_vv,
@@ -125,8 +123,8 @@ frm_fb_sample_imputed_values <- function( imputations_mcmc, model_results,
         if ( save_values ){
             imputations_mcmc$values[[var_vv]][, ind_save ] <- dat_vv[, var_vv ]
         }
-
     }  # end vv
+
     #--------------------------------
     #--- output
     res <- list( imputations_mcmc=imputations_mcmc, dat=dat)

diff --git a/R/frm_fb_sample_imputed_values_eval_likelihood.R b/R/frm_fb_sample_imputed_values_eval_likelihood.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_sample_imputed_values_eval_likelihood.R
-## File Version: 0.42
+## File Version: 0.448
 
 
 frm_fb_sample_imputed_values_eval_likelihood <- function(mm, model_results, ind0,
@@ -19,13 +19,18 @@ frm_fb_sample_imputed_values_eval_likelihood <- function(mm, model_results, ind0
     } else {
         dat_sel <- dat_vv
     }
+
+    # dat_sel <- dat_sel[ ind_mm$id_variable_level_unique, ]
     y <- dat_sel[, ind_mm$dv_vars ]
     case <- dat_sel$case
     design_matrix <- dat_sel
     args <- list(model=model, y=y, case=case, design_matrix=design_matrix )
     if (ind_mm$R_density_fct=="frm_linreg_density"){
         args$use_in_frm_fb <- TRUE
     }
+    if (ind_mm$R_density_fct=="frm_mlreg_density"){
+        args$id_variable_level_unique <- ind_mm$id_variable_level_unique
+    }
     dmod <- do.call( what=ind_mm$R_density_fct, args=args )
     like <- dmod$like
     #- adjust likelihood for cluster-level variables

diff --git a/R/frm_fb_sample_imputed_values_proposal.R b/R/frm_fb_sample_imputed_values_proposal.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_sample_imputed_values_proposal.R
-## File Version: 0.577
+## File Version: 0.582
 
 
 frm_fb_sample_imputed_values_proposal <- function( var_vv, index_vv,
@@ -47,11 +47,16 @@ frm_fb_sample_imputed_values_proposal <- function( var_vv, index_vv,
         }
         do_mh <- TRUE
     }
+
     #*** sample new values for linear regression
     if ( model_vv %in% c( "mlreg" ) ){
         outcome <- ind0_vv$R_args$outcome
         if (outcome=="probit"){
-            imp <- model_results$y[ ind_miss_vv,1]
+            y1 <- model_results$y
+            if (! is.null(ind0_vv$variable_level) ){
+                y1 <- y1[ ind0_vv$id_variable_level,,drop=FALSE]
+            }
+            imp <- y1[ ind_miss_vv,1]
         }
         imp1 <- stats::rnorm( N_vv, mean=imp, sd=mh_vv$sd_proposal )
         if (outcome=="probit"){

diff --git a/R/frm_fb_sample_parameters.R b/R/frm_fb_sample_parameters.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb_sample_parameters.R
-## File Version: 0.541
+## File Version: 0.543
 
 
 frm_fb_sample_parameters <- function( dat, ind0, NM, eps=1E-30, iter=NULL,
@@ -11,6 +11,7 @@ frm_fb_sample_parameters <- function( dat, ind0, NM, eps=1E-30, iter=NULL,
     NM1 <- NM + 1
     for (mm in 1:NM1 ){
         ind_mm <- ind0[[mm]]
+
     # cat("\n---------------------- mm=", mm, " --------\n")
         #--- likelihood evaluated at old parameter
         mod <- model_results[[mm]]
@@ -81,7 +82,9 @@ frm_fb_sample_parameters <- function( dat, ind0, NM, eps=1E-30, iter=NULL,
         ind_mm$sigma <- sigma0
         model_results[[mm]] <- mod
         ind0[[mm]] <- ind_mm
-    }
+    } # end mm
+
+
     #------------
     # save sampled parameters
     iter_save_temp <- parms_mcmc$iter_save_temp

diff --git a/R/frm_linreg_density.R b/R/frm_linreg_density.R
@@ -1,5 +1,5 @@
 ## File Name: frm_linreg_density.R
-## File Version: 0.971
+## File Version: 0.973
 
 frm_linreg_density <- function(model, y, design_matrix=NULL, case=NULL,
         X=NULL, offset=NULL, use_in_frm_fb=FALSE )

diff --git a/R/frm_mlreg_create_design_matrices.R b/R/frm_mlreg_create_design_matrices.R
@@ -1,5 +1,5 @@
 ## File Name: frm_mlreg_create_design_matrices.R
-## File Version: 0.05
+## File Version: 0.07
 
 
 frm_mlreg_create_design_matrices <- function(data, formula_terms )

diff --git a/R/frm_mlreg_density.R b/R/frm_mlreg_density.R
@@ -1,12 +1,15 @@
 ## File Name: frm_mlreg_density.R
-## File Version: 0.15
+## File Version: 0.167
 
 
-frm_mlreg_density <- function( model, y, case, design_matrix)
+frm_mlreg_density <- function( model, y, case, design_matrix, id_variable_level_unique=NULL)
 {
     outcome <- model$outcome
     data <- design_matrix
     formula_terms <- model$formula_terms
+    if ( ! is.null(id_variable_level_unique) ){
+        data <- data[ id_variable_level_unique, ]
+    }
     res <- frm_mlreg_create_design_matrices(data=data, formula_terms=formula_terms )
     y <- res$y
     X <- res$X
@@ -20,7 +23,6 @@ frm_mlreg_density <- function( model, y, case, design_matrix)
     idcluster_list <- model$idcluster_list
     outcome <- model$outcome
     K <- model$K
-
     #- evaluate densities
     ypred <- miceadds::miceadds_rcpp_ml_mcmc_predict_fixed_random( X=X, beta=beta, Z_list=Z_list,
                         u_list=u_list, idcluster_list=idcluster_list, NR=NR )

diff --git a/README.md b/README.md
@@ -22,9 +22,9 @@ The CRAN version can be installed from within R using:
 utils::install.packages("mdmb")
 ```
 
-#### GitHub version `mdmb` 1.6-2 (2021-01-21)
+#### GitHub version `mdmb` 1.6-4 (2021-08-25)
 
-[![](https://img.shields.io/badge/github%20version-1.6--2-orange.svg)](https://github.com/alexanderrobitzsch/mdmb)&#160;&#160;
+[![](https://img.shields.io/badge/github%20version-1.6--4-orange.svg)](https://github.com/alexanderrobitzsch/mdmb)&#160;&#160;
 
 The version hosted [here](https://github.com/alexanderrobitzsch/mdmb) is the development version of `mdmb`. 
 The GitHub version can be installed using `devtools` as:

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -2,5 +2,5 @@ pandoc: 1.13.1
 pkgdown: 1.5.1
 pkgdown_sha: ~
 articles: []
-last_built: 2021-01-21T13:07Z
+last_built: 2021-08-25T11:14Z
 
diff --git a/docs/reference/frm.html b/docs/reference/frm.html
diff --git a/inst/NEWS b/inst/NEWS
@@ -30,10 +30,11 @@ CHANGELOG mdmb
 
 
 ---------------------------------------------------------------------
-VERSIONS mdmb 1.6  |  2021-01-21  |  Last: mdmb 1.6-2
+VERSIONS mdmb 1.6  |  2021-08-25  |  Last: mdmb 1.6-4
 ---------------------------------------------------------------------
 
-xxxx  *
+FIXED * fixed a bug in frm_fb() for sampling of variables at 
+        higher levels with probit model (thanks to Simon Grund)
 
 
 DATA  * included/modified datasets: ---

diff --git a/man/frm.Rd b/man/frm.Rd
@@ -1,5 +1,5 @@
 %% File Name: frm.Rd
-%% File Version: 0.833
+%% File Version: 0.834
 
 \name{frm}
 \alias{frm}
@@ -264,14 +264,14 @@ with mixed measurement scales using a sequence of generalised linear models.
 \emph{Computational Statistics & Data Analysis, 95}(24), 24-38.
 \doi{10.1016/j.csda.2015.08.004}
 
-Luedtke, O., Robitzsch, A., & West, S. (2020a). Analysis of interactions and nonlinear 
-effects with missing data: A factored regression modeling approach using maximum 
-likelihood estimation. \emph{Multivariate Behavioral Research, 55}(3), 361-381. 
+Luedtke, O., Robitzsch, A., & West, S. (2020a). Analysis of interactions and nonlinear
+effects with missing data: A factored regression modeling approach using maximum
+likelihood estimation. \emph{Multivariate Behavioral Research, 55}(3), 361-381.
 \doi{10.1080/00273171.2019.1640104}
 
-Luedtke, O., Robitzsch, A., & West, S. (2020b). Regression models involving nonlinear 
-effects with missing data: A sequential modeling approach using Bayesian estimation. 
-\emph{Psychological Methods, 25}(2), 157-181. 
+Luedtke, O., Robitzsch, A., & West, S. (2020b). Regression models involving nonlinear
+effects with missing data: A sequential modeling approach using Bayesian estimation.
+\emph{Psychological Methods, 25}(2), 157-181.
 \doi{10.1037/met0000233}
 
 Zhang, Q., & Wang, L. (2017). Moderation analysis with missing data in the predictors.

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -1,5 +1,5 @@
 //// File Name: RcppExports.cpp
-//// File Version: 1.006002
+//// File Version: 1.006004
 // Generated by using Rcpp::compileAttributes() -> do not edit by hand
 // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393