From f89bdb2cec87084a05263a2c7329ea37b8088a30 Mon Sep 17 00:00:00 2001 From: helske Date: Sun, 20 Aug 2023 15:15:31 +0300 Subject: [PATCH] fix L_random to J_random, use prior in get_data, run-extended --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ R/getters.R | 1 + R/prepare_stan_input.R | 6 ++---- R/stanblocks_families.R | 20 ++++++++------------ 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f27d134..c06b812 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: dynamite Title: Bayesian Modeling and Causal Inference for Multivariate Longitudinal Data -Version: 1.4.4 +Version: 1.4.5 Authors@R: c( person("Santtu", "Tikka", email = "santtuth@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4039-4342")), diff --git a/NEWS.md b/NEWS.md index ca88ab2..c92de40 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# dynamite 1.4.5 + + * `get_data` method for `dynamitefit` object now correctly uses the previously defined priors instead of the default ones. + * Fixed a bug in indexing of random effect terms. + # dynamite 1.4.4 * Example of the `lfo()` method now uses a single chain and core to avoid a compatibility issue with CRAN. diff --git a/R/getters.R b/R/getters.R index f23dcdd..e3f16e8 100644 --- a/R/getters.R +++ b/R/getters.R @@ -197,6 +197,7 @@ get_data.dynamitefit <- function(x, ...) { group = x$group_var, debug = list(no_compile = TRUE, stan_input = TRUE, model_code = FALSE), verbose = FALSE, + priors = x$priors, ... ) out$stan_input$sampling_vars diff --git a/R/prepare_stan_input.R b/R/prepare_stan_input.R index 1d5c224..dc8385d 100644 --- a/R/prepare_stan_input.R +++ b/R/prepare_stan_input.R @@ -314,8 +314,7 @@ initialize_univariate_channel <- function(dformula, specials, fixed_pars, J = as.array(c(fixed_pars, varying_pars)), J_random = as.array(random_pars), L_fixed = as.array(seq_along(fixed_pars)), - L_varying = as.array(length(fixed_pars) + seq_along(varying_pars)), - L_random = as.array(seq_along(random_pars)) + L_varying = as.array(length(fixed_pars) + seq_along(varying_pars)) ) channel <- c(channel, indices) sampling <- setNames(indices, paste0(names(indices), "_", y_name)) @@ -465,8 +464,7 @@ initialize_multivariate_channel <- function(y, y_cg, y_name, cg_idx, "J", "J_random", "L_fixed", - "L_varying", - "L_random" + "L_varying" ) copy_channel <- setdiff( names(channel_vars[[z]]), diff --git a/R/stanblocks_families.R b/R/stanblocks_families.R index ffb0829..3f4e4b5 100644 --- a/R/stanblocks_families.R +++ b/R/stanblocks_families.R @@ -159,11 +159,11 @@ intercept_lines <- function(y, obs, family, has_varying, has_fixed, has_random, ifelse_( has_random_intercept, paste0( - glue::glue(" + rows_dot_product(X[t][{obs}, L_random_{ydim}], "), + glue::glue(" + rows_dot_product(X[t][{obs}, J_random_{ydim}], "), glue::glue("nu_{y}[{obs}, 2:K_random_{ydim}])") ), paste0( - glue::glue(" + rows_dot_product(X[t][{obs}, L_random_{ydim}], "), + glue::glue(" + rows_dot_product(X[t][{obs}, J_random_{ydim}], "), glue::glue("nu_{y}[{obs}, ])") ) ), @@ -279,7 +279,7 @@ loglik_lines_default <- function(y, idt, obs, family, has_missing, onlyif( has_random, c( - stan_array_arg(backend, "int", "L_random_{y}", 0L, TRUE), + stan_array_arg(backend, "int", "J_random_{y}", 0L, TRUE), "int K_random_{y}" ) ), @@ -616,7 +616,7 @@ loglik_categorical <- function(y, idt, obs, family, has_missing, onlyif( has_random, c( - stan_array_arg(backend, "int", "L_random_{y}", 0L, TRUE), + stan_array_arg(backend, "int", "J_random_{y}", 0L, TRUE), "int K_random_{y}" ) ), @@ -804,7 +804,7 @@ loglik_mvgaussian <- function(idt, cvars, cgvars, backend, onlyif( cvars[[i]]$has_random, c( - stan_array_arg(backend, "int", "L_random_{yi}", 0L, TRUE), + stan_array_arg(backend, "int", "J_random_{yi}", 0L, TRUE), "int K_random_{yi}" ) ), @@ -1117,10 +1117,6 @@ data_lines_default <- function(y, idt, has_random_intercept, K_varying > 0L, stan_array(backend, "int", "L_varying_{y}", "K_varying_{y}") ), - onlyif( - K_random > re_icpt, - stan_array(backend, "int", "L_random_{y}", "K_random_{y}{icpt}") - ), .indent = idt(1) ) } @@ -1999,7 +1995,7 @@ loglik_fun_args <- function(y, has_fixed, has_varying, has_missing, ), "y_{y}", onlyif(has_fixed_intercept || has_varying_intercept, "alpha_{y}"), - onlyif(has_random, c("L_random_{y}", "K_random_{y}")), + onlyif(has_random, c("J_random_{y}", "K_random_{y}")), onlyif(has_random || has_random_intercept, "nu_{y}"), onlyif(has_lfactor, c("lambda_{y}", "psi_{y}")), onlyif(has_fixed, c("{LJ}_fixed_{y}", "beta_{y}")), @@ -2059,7 +2055,7 @@ model_lines_categorical <- function(y, idt, obs, family, priors, "y_{y}", "S_{y}", fun_args, - onlyif(has_random, c("L_random_{y}", "K_random_{y}")), + onlyif(has_random, c("J_random_{y}", "K_random_{y}")), onlyif(has_fixed, "{LJ}_fixed_{y}"), onlyif(has_varying, "{LJ}_varying_{y}"), onlyif(has_fixed || has_varying, c("J_{y}", "K_{y}")), @@ -2169,7 +2165,7 @@ model_lines_mvgaussian <- function(cvars, cgvars, idt, backend, threading, ...) cvars[[i]]$has_fixed_intercept || cvars[[i]]$has_varying_intercept, "alpha_{yi}" ), - onlyif(cvars[[i]]$has_random, c("L_random_{yi}", "K_random_{yi}")), + onlyif(cvars[[i]]$has_random, c("J_random_{yi}", "K_random_{yi}")), onlyif( cvars[[i]]$has_random || cvars[[i]]$has_random_intercept, "nu_{yi}"