Quick hack to parse brms priors print-out
At the time of writing, the print() function for a brms prior specification
does some row-filling to make things more verbose and explicit. But these
details are not available as a dataframe for the user to manipulate or wrangle.
Weirdness about the prior dataframe has been reported on GitHub.
This note describes a quick data-cleaning workaround.
Let’s make a small model.
library(brms) fivenum(Orange$circumference) #> [1] 30.0 65.5 115.0 161.5 214.0 fivenum(Orange$age) #> [1] 118 484 1004 1372 1582 f <- bf(circumference ~ s(age, k = 4) + (1 | Tree)) p_user <- c( set_prior("normal(0, 100)", class = "sd"), set_prior("exponential(.1)", class = "sigma") ) prior_user <- validate_prior(p_user, f, data = Orange) prior_default <- get_prior(f, data = Orange)
Note how the default prior print-out includes (flat) in the description:
print(prior_default) #> prior class coef group resp dpar nlpar lb ub #> (flat) b #> (flat) b sage_1 #> student_t(3, 115, 77.1) Intercept #> student_t(3, 0, 77.1) sd 0 #> student_t(3, 0, 77.1) sd Tree 0 #> student_t(3, 0, 77.1) sd Intercept Tree 0 #> student_t(3, 0, 77.1) sds 0 #> student_t(3, 0, 77.1) sds s(age, k = 4) 0 #> student_t(3, 0, 77.1) sigma 0 #> tag source #> default #> (vectorized) #> default #> default #> (vectorized) #> (vectorized) #> default #> (vectorized) #> default
If we try to use this prior object as a data.frame, the prior column has blanks in it instead:
as.data.frame(prior_default) #> prior class coef group resp dpar nlpar lb ub #> 1 b #> 2 b sage_1 #> 3 student_t(3, 115, 77.1) Intercept #> 4 student_t(3, 0, 77.1) sd 0 #> 5 sd Tree #> 6 sd Intercept Tree #> 7 student_t(3, 0, 77.1) sds 0 #> 8 sds s(age, k = 4) #> 9 student_t(3, 0, 77.1) sigma 0 #> tag source #> 1 default #> 2 default #> 3 default #> 4 default #> 5 default #> 6 default #> 7 default #> 8 default #> 9 default
Here are print-outs with a "user" sourced prior:
prior_user #> prior class coef group resp dpar nlpar lb ub #> (flat) b #> (flat) b sage_1 #> student_t(3, 115, 77.1) Intercept #> normal(0, 100) sd 0 #> normal(0, 100) sd Tree 0 #> normal(0, 100) sd Intercept Tree 0 #> student_t(3, 0, 77.1) sds 0 #> student_t(3, 0, 77.1) sds s(age, k = 4) 0 #> exponential(.1) sigma 0 #> tag source #> default #> (vectorized) #> default #> user #> (vectorized) #> (vectorized) #> default #> (vectorized) #> user as.data.frame(prior_user) #> prior class coef group resp dpar nlpar lb ub #> 1 b #> 2 b sage_1 #> 3 student_t(3, 115, 77.1) Intercept #> 4 normal(0, 100) sd 0 #> 5 sd Tree #> 6 sd Intercept Tree #> 7 student_t(3, 0, 77.1) sds 0 #> 8 sds s(age, k = 4) #> 9 exponential(.1) sigma 0 #> tag source #> 1 default #> 2 default #> 3 default #> 4 user #> 5 default #> 6 default #> 7 default #> 8 default #> 9 user
It seems like print() adjusts the prior and source columns so that there
are no blank values, either by using "(flat)" or by inheriting a missing prior
from the generic prior used for a parameter class. Visually, this inheritance
looks like the prior is carried down from a preceding row and the source
column gets the value "(vectorized)".
The as.data.frame() version seems to have the bare minimum information
about the priors, just the non-flat distributions provided to the model.
The Easy Workaround
If we inspect the print() method of the priors, we see a call to
prepare_print_prior():
brms:::print.brmsprior #> function (x, show_df = NULL, ...) #> { #> if (is.null(show_df)) { #> show_df <- nrow(x) > 1L #> } #> show_df <- as_one_logical(show_df) #> y <- prepare_print_prior(x) #> if (show_df) { #> print.data.frame(y, row.names = FALSE, ...) #> } #> else { #> cat(collapse(.print_prior(y), "\n")) #> } #> invisible(x) #> } #> <bytecode: 0x000001ae5b87d468> #> <environment: namespace:brms>
This function does return a dataframe with filled rows that is suitable for wrangling:
library(tidyverse) brms:::prepare_print_prior(prior_user) |> as.data.frame() #> prior class coef group resp dpar nlpar lb ub #> 1 (flat) b #> 2 (flat) b sage_1 #> 3 student_t(3, 115, 77.1) Intercept #> 4 normal(0, 100) sd 0 #> 5 normal(0, 100) sd Tree 0 #> 6 normal(0, 100) sd Intercept Tree 0 #> 7 student_t(3, 0, 77.1) sds 0 #> 8 student_t(3, 0, 77.1) sds s(age, k = 4) 0 #> 9 exponential(.1) sigma 0 #> tag source #> 1 default #> 2 (vectorized) #> 3 default #> 4 user #> 5 (vectorized) #> 6 (vectorized) #> 7 default #> 8 (vectorized) #> 9 user # For example: brms:::prepare_print_prior(prior_user) |> as.data.frame() |> filter(source != "(vectorized)") #> prior class coef group resp dpar nlpar lb ub tag #> 1 (flat) b #> 2 student_t(3, 115, 77.1) Intercept #> 3 normal(0, 100) sd 0 #> 4 student_t(3, 0, 77.1) sds 0 #> 5 exponential(.1) sigma 0 #> source #> 1 default #> 2 default #> 3 user #> 4 default #> 5 user
The Harder Workaround
We do not want to rely on private functions from the brms package. Private
functions belong to the package, so they can break or change. So, let’s try to
get the same sort of dataframe from just the print() results. The trick will be to
treat the print-out as a fixed-width formatted data file. Instead of using a
character to separate columns in a row, a fixed-width format gives each column a
fixed character width. Parsing the columns is then a matter of breaking the row at
different character positions.
If we look at the print output as data, we notice that each column is a chunk of leading space followed by a chunk of characters.
l <- capture.output(print(prior_user, width = 10000)) l[1] #> [1] " prior class coef group resp dpar nlpar lb ub tag source" first_row <- l[1] |> stringr::str_extract_all("\\s+\\w+") |> unlist() first_row |> # show one per line print(width = 10) #> [1] " prior" #> [2] " class" #> [3] " coef" #> [4] " group" #> [5] " resp" #> [6] " dpar" #> [7] " nlpar" #> [8] " lb" #> [9] " ub" #> [10] " tag" #> [11] " source" col_names <- first_row |> stringr::str_trim() widths <- nchar(first_row) names(widths) <- col_names widths #> prior class coef group resp dpar nlpar lb ub tag source #> 24 10 14 6 5 5 6 3 3 4 13
We can tell readr::read_fwf() to parse the print results using these
character counts as widths:
df <- readr::read_fwf( I(l), readr::fwf_widths(widths), skip = 1, show_col_types = FALSE ) df #> # A tibble: 9 × 11 #> X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 #> <chr> <chr> <chr> <chr> <lgl> <lgl> <lgl> <dbl> <lgl> <lgl> <chr> #> 1 (flat) b <NA> <NA> NA NA NA NA NA NA defa… #> 2 (flat) b sage… <NA> NA NA NA NA NA NA (vec… #> 3 student_t(3, 115,… Inte… <NA> <NA> NA NA NA NA NA NA defa… #> 4 normal(0, 100) sd <NA> <NA> NA NA NA 0 NA NA user #> 5 normal(0, 100) sd <NA> Tree NA NA NA 0 NA NA (vec… #> 6 normal(0, 100) sd Inte… Tree NA NA NA 0 NA NA (vec… #> 7 student_t(3, 0, 7… sds <NA> <NA> NA NA NA 0 NA NA defa… #> 8 student_t(3, 0, 7… sds s(ag… <NA> NA NA NA 0 NA NA (vec… #> 9 exponential(.1) sigma <NA> <NA> NA NA NA 0 NA NA user
Two things to note:
-
This approach treats the first row (column names) as data, so we skip that first line.
-
readr inferred column types, so that the blank cells from above were converted to
NAs.
Let’s try this instead:
df <- readr::read_fwf( I(l), readr::fwf_widths(widths), skip = 1, show_col_types = FALSE, col_types = readr::cols(.default = readr::col_character()), na = character() ) colnames(df) <- names(widths) df #> # A tibble: 9 × 11 #> prior class coef group resp dpar nlpar lb ub tag source #> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> #> 1 (flat) b "" "" "" "" "" "" "" "" defau… #> 2 (flat) b "sag… "" "" "" "" "" "" "" (vect… #> 3 student_t(3, 115… Inte… "" "" "" "" "" "" "" "" defau… #> 4 normal(0, 100) sd "" "" "" "" "" "0" "" "" user #> 5 normal(0, 100) sd "" "Tre… "" "" "" "0" "" "" (vect… #> 6 normal(0, 100) sd "Int… "Tre… "" "" "" "0" "" "" (vect… #> 7 student_t(3, 0, … sds "" "" "" "" "" "0" "" "" defau… #> 8 student_t(3, 0, … sds "s(a… "" "" "" "" "0" "" "" (vect… #> 9 exponential(.1) sigma "" "" "" "" "" "0" "" "" user
Putting this together into a single function:
get_formatted_priors <- function(prior) { .prior_spec <- as.character(substitute(prior)) l <- capture.output(print(prior, width = 10000)) first_row <- l[1] |> stringr::str_extract_all("\\s+\\w+") |> unlist() col_names <- stringr::str_trim(first_row) widths <- nchar(first_row) names(widths) <- col_names df <- readr::read_fwf( I(l), readr::fwf_widths(widths), skip = 1, show_col_types = FALSE, col_types = readr::cols(.default = readr::col_character()), na = character() ) colnames(df) <- names(widths) df$.prior_spec <- .prior_spec df[c(".prior_spec", names(widths))] }
Now we can, e.g., bundle up different sets of priors:
bind_rows( prior_default |> get_formatted_priors(), prior_user |> get_formatted_priors() ) |> filter(source != "(vectorized)") |> select(where(function(x) any(x != ""))) #> # A tibble: 10 × 5 #> .prior_spec prior class lb source #> <chr> <chr> <chr> <chr> <chr> #> 1 prior_default (flat) b "" default #> 2 prior_default student_t(3, 115, 77.1) Intercept "" default #> 3 prior_default student_t(3, 0, 77.1) sd "0" default #> 4 prior_default student_t(3, 0, 77.1) sds "0" default #> 5 prior_default student_t(3, 0, 77.1) sigma "0" default #> 6 prior_user (flat) b "" default #> 7 prior_user student_t(3, 115, 77.1) Intercept "" default #> 8 prior_user normal(0, 100) sd "0" user #> 9 prior_user student_t(3, 0, 77.1) sds "0" default #> 10 prior_user exponential(.1) sigma "0" user
This approach, it should be noted, is brittle. If brms ever changes how it
prints out priors—for example, using a tibble() or abbreviating long
column entries—then the above workaround breaks.
Leave a comment