1.5-2

alexanderrobitzsch · Dec 14, 2020 · ade2a4f · ade2a4f
1 parent 07bdc20
commit ade2a4f
Show file tree

Hide file tree

Showing 17 changed files with 42 additions and 35 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: mdmb
 Type: Package
 Title: Model Based Treatment of Missing Data
-Version: 1.5-1
-Date: 2020-05-12 21:28:18
+Version: 1.5-2
+Date: 2020-12-14 21:34:05
 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.005001
+## File Version: 1.005002
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 

diff --git a/R/frm_define_model_R_function.R b/R/frm_define_model_R_function.R
@@ -1,5 +1,5 @@
 ## File Name: frm_define_model_R_function.R
-## File Version: 0.684
+## File Version: 0.686
 
 frm_define_model_R_function <- function(model, use_grad=2, use_gibbs=FALSE,
     R_args=NULL, sampling_level=NULL, variable_level=NULL, maxiter=8, dat0=NULL )
@@ -16,8 +16,10 @@ frm_define_model_R_function <- function(model, use_grad=2, use_gibbs=FALSE,
     }
     if (is.null(R_args) ){
         R_args <- list()
+    }    
+    if (! ( model$model %in% c("yjtreg") ) ){
+        R_args$probit <- FALSE
     }
-    R_args$probit <- FALSE
     #--- linear regression normal distribution
     if (model$model=="linreg"){
         R_fct <- stats::lm
@@ -63,7 +65,7 @@ frm_define_model_R_function <- function(model, use_grad=2, use_gibbs=FALSE,
         R_args <- frm_define_model_R_function_include_maxiter(R_args=R_args, maxiter=maxiter)
         if (is.null(R_args$probit)){
             R_args$probit <- FALSE
-        }
+        }    
     }
     if (model$model %in% c("yjtreg", "bctreg") ){
         if (is.null(R_args$est_df)){

diff --git a/R/frm_em.R b/R/frm_em.R
@@ -1,5 +1,5 @@
 ## File Name: frm_em.R
-## File Version: 0.941
+## File Version: 0.942
 
 
 frm_em <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
@@ -102,7 +102,7 @@ frm_em <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
 
     #--- computation asymptotic covariance matrix
     res0 <- frm_em_avcov(res=res, dat=dat, ind0=ind0, NM=NM, h=h)
-
+    
     if (verbose){
         cat("\n")
         utils::flush.console()

diff --git a/R/frm_em_avcov.R b/R/frm_em_avcov.R
@@ -1,5 +1,5 @@
 ## File Name: frm_em_avcov.R
-## File Version: 0.947
+## File Version: 0.961
 
 frm_em_avcov <- function(res, dat, ind0, NM, h=h)
 {
@@ -62,7 +62,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
         # loglike <- matrix(NA, nrow=N2, ncol=NM+1)
         loglike <- loglike0
         post <- 1 + 0*dat$weights
-        eps <- 1E-30
+        eps <- 1e-30
         post0a <- post0
 
         for (mm in update ){
@@ -117,7 +117,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
     score_f1 <- function(par){
         NP <- length(par)
         abs_par <- abs(par)
-        hvec <- h * ifelse(abs_par > 1, abs_par, 1)
+#        hvec <- h * ifelse(abs_par > 1, abs_par, 1)
         x <- par
         y <- par
         #*** function Q( x, y )
@@ -164,6 +164,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
         for (ii in 1:NP){
             par1 <- par
             par1[ii] <- par[ii] + hvec[ii]
+
             loglike <- f0a$loglike
             post <- 1 + 0*dat$weights
             post0a <- f0a$post0a
@@ -181,7 +182,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
                 } else {
                     update_model <- FALSE
                 }
-
+                # update_model <- TRUE                
                 if ( update_model ){
                     dmod <- frm_em_score_function_prepare_model(mm=mm,
                                 model_results=model_results, x=x, index_coefs_vec=index_coefs_vec,
@@ -199,6 +200,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
                     #    post0a[,mm] <- dmod$post
                 }
             }
+
             for (mm in seq(1,NM+1)){
                 post <- post * post0a[,mm]
             }
@@ -217,6 +219,7 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
     infomat <- matrix(NA,nrow=NP,ncol=NP)
     m1 <- paste0( rep("*",NP), collapse="")
     cat( paste0("\n|",m1,"|","\n|") )
+
     for (ii in 1:NP){
         cat("-")
         utils::flush.console()
@@ -226,7 +229,6 @@ frm_em_avcov <- function(res, dat, ind0, NM, h=h)
         infomat[ii,] <- (sc2 - score_fct1) / hvec[ii]
     }
     cat("|\n")
-
     #-- modify parameter labels
     dfr <- frm_modify_parameter_labels( dfr=dfr, ind0=ind0, NM=NM )
 

diff --git a/R/frm_fb.R b/R/frm_fb.R
@@ -1,5 +1,5 @@
 ## File Name: frm_fb.R
-## File Version: 0.801
+## File Version: 0.807
 
 ### Factored regression model
 ### Fully Bayesian estimation
@@ -63,7 +63,7 @@ frm_fb <- function(dat, dep, ind, weights=NULL, verbose=TRUE,
         weights0 <- rep(1,N)
     }
     dat0 <- dat
-
+    
     #*** prepare data
     res2 <- frm_prepare_data_fb(dat=dat, dep=dep, ind=ind, weights0=weights0,
                     dat0=dat0, data_init=data_init )
@@ -135,7 +135,7 @@ zz0 <- Sys.time()
                     aggregation=aggregation )
         imputations_mcmc <- res$imputations_mcmc
         dat <- res$dat
-
+        
         #*** refreshing proposal SD for parameters and imputed values
         if ( ( iter %% refresh==0 ) & ( iter <=burnin ) ){
             ind0 <- frm_fb_mh_refresh_parameters( ind0=ind0, acc_bounds=acc_bounds )

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.574
+## File Version: 0.577
 
 
 frm_fb_sample_imputed_values_proposal <- function( var_vv, index_vv,

diff --git a/R/frm_prepare_models.R b/R/frm_prepare_models.R
@@ -1,5 +1,5 @@
 ## File Name: frm_prepare_models.R
-## File Version: 0.524
+## File Version: 0.529
 
 frm_prepare_models <- function(dep, ind, dat0, nodes_control, nodes_weights=TRUE, use_grad=2,
     use_gibbs=FALSE, weights=NULL )

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.5-1 (2020-05-12)
+#### GitHub version `mdmb` 1.5-2 (2020-12-14)
 
-[![](https://img.shields.io/badge/github%20version-1.5--1-orange.svg)](https://github.com/alexanderrobitzsch/mdmb)&#160;&#160;
+[![](https://img.shields.io/badge/github%20version-1.5--2-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: 2020-05-12T19:36Z
+last_built: 2020-12-14T20:41Z
 
diff --git a/docs/reference/data.mb.html b/docs/reference/data.mb.html
diff --git a/docs/reference/frm.html b/docs/reference/frm.html
diff --git a/inst/NEWS b/inst/NEWS
@@ -29,10 +29,13 @@ CHANGELOG mdmb
 
 
 ---------------------------------------------------------------------
-VERSIONS mdmb 1.5  |  2020-05-12  |  Last: mdmb 1.5-1
+VERSIONS mdmb 1.5  |  2020-12-14  |  Last: mdmb 1.5-2
 ---------------------------------------------------------------------
 
-xxxx  *
+FIXED * fixed a bug in sampling imputed values in frm_fb() for 
+        model "yjtreg" with argument 'probit=TRUE'
+        (thanks to Simon Grund)
+
 
 DATA  * included/modified datasets: ---
 EXAMP * included/modified examples: ---

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