Draws of named and derived parameters in blavaan

Interfaces Other
1

Say I specify a blavaan model with named and derived parameters, such as with the simple mediation model below.

model_str <- 'mpg ~ 1 + b11*cyl + b12*hp
            hp ~ 1 + b21*cyl
            mpg ~~ mpg
            hp ~~ hp
               
            direct := b11
            indirect := b21 * b12
            total := b11 + b21 * b12'

mod <- blavaan(model_str, data = mtcars)

I can’t figure out how (if it is possible) to extract the draws of the named and derived parameters. I can summarize them with summary(mod). I can get the draws of the underlying model parameters with blavInspect(mod, "mcmc"). And I can get their point estimates through other means by way of coef(mod, type = "user"). But I can’t quite figure out this last bit. Looking at the underlying Stan code, it looks like these derivations are done after-the-fact. So unfortunately it doesn’t seem possible to pull them directly from the model results.

Any help? (tagging @edm; appreciate your input)

2

You are right that derived parameters are not in the blavaan model, because that model is pre-compiled. The estimates you see from summary() and others are based on the delta method. This post shows how to extract the posterior samples and do things with them yourself: https://groups.google.com/g/blavaan/c/69ukdYLpHXI/m/Ed6oQn94AAAJ

1 Like
3

Thanks Ed. That gives me what I need.

Edit: And easier than I was expecting! In case it’s helpful to others, I’ve put a first pass at a function that is working well in my case. Can’t guarantee it’s generalizable or tested, but hopefully it’s helpful. Thanks again, Ed.

get_model_draws <- function(m){
  blavInspect(m, 'mcmc') %>%
    map2_df(1:length(.), function(d, chn){
      d %>%
        as.data.frame() %>%
        mutate(chain = chn,
               iter = 1:n()) %>%
        relocate(chain, iter)
    })
}

select_params <- function(draws, old_names, new_names){
  for(i in 1:length(old_names)){
    colnames(draws)[colnames(draws) == old_names[i]] <- new_names[i]
  }
  
  draws %>%
    select_at(vars(new_names))
}

get_model_parameters <- function(m){
  parTable(m) %>%
    as.data.frame() %>%
    select(lhs, op, rhs, label, pxnames)
}

get_derived_draws <- function(m){
  model_params <- get_model_parameters(m)
  model_draws <- get_model_draws(m)
  
  chain_iter_df <- model_draws %>%
    select(chain, iter)
  
  renamed_params <- model_params %>%
    filter(label != '' & !is.na(pxnames)) %>%
    (function(rp){
      model_draws %>%
        select_params(rp$pxnames, rp$label)
    })
  
  derived_params <- model_params %>%
    filter(op == ':=') %>%
    mutate(mutate_code = str_c(label, ' = ', rhs)) %>%
    (function(dp){
      mc <- str_c('mutate(', str_c(dp$mutate_code, collapse = ', '), ')')
      sc <- str_c('select(', str_c(dp$label, collapse = ','), ')')
      
      fc <- str_c('renamed_params %>%',
                  mc, '%>%',
                  sc)
      
      eval(parse(text = fc))
    })
  
  as_tibble(bind_cols(chain_iter_df, renamed_params, derived_params))
}

model_str <- 'mpg ~ 1 + b11*cyl + b12*hp
            hp ~ 1 + b21*cyl
            mpg ~~ mpg
            hp ~~ hp
               
            direct := b11
            indirect := b21 * b12
            total := b11 + b21 * b12'

mod <- blavaan(model_str, data = mtcars)

get_derived_draws(mod)
1 Like