bart models

Function Works
tidypredict_fit(), tidypredict_sql(), parse_model() ✔
tidypredict_to_column() ✔
tidypredict_test() ✔
tidypredict_interval(), tidypredict_sql_interval() ✗
parsnip ✔

dbarts::bart() fits a Bayesian additive regression trees (BART) model. Each draw of the posterior sampler holds a full ensemble of trees, and the fitted value is the average, over every draw, of the summed leaf values of that draw’s trees. tidypredict_fit() returns one nested case_when() per tree per draw, so the size of the returned expression grows with both the number of trees and the number of posterior samples that were kept. Small values of ntree and ndpost keep the formula manageable.

Two things are needed for the model to be parsed:

tidypredict_ functions

set.seed(100)
model <- dbarts::bart(
  mtcars[c("wt", "cyl", "disp")],
  mtcars$mpg,
  ntree = 5,
  ndpost = 5,
  keeptrees = TRUE,
  verbose = FALSE
)

parsnip

Models fit with parsnip::bart() and the "dbarts" engine are supported as well. Note that predict() on a parsnip bart() model draws from the posterior predictive distribution, which adds residual noise, so its results are only equal to the ones of tidypredict_fit() in expectation.

library(parsnip)

set.seed(100)
model <- bart(mode = "regression", trees = 5) %>%
  set_engine("dbarts", ndpost = 5, verbose = FALSE) %>%
  fit(mpg ~ wt + cyl + disp, data = mtcars)

tidypredict_fit(model)
#> (case_when(disp <= 468.030693069307 ~ 0.0388237369617747, .default = -0.23775684832047) + 
#>     case_when(cyl <= 6.73267326732673 ~ case_when(cyl <= 5.94059405940594 ~ 
#>         0.0566109358696731, .default = -0.0104096098780387), 
#>         .default = -0.151028877096314) + case_when(wt <= 1.90022772277228 ~ 
#>     0.0638218492136239, .default = -0.017588928858414) + case_when(wt <= 
#>     1.66789108910891 ~ 0.0220891384775674, .default = case_when(wt <= 
#>     2.28745544554455 ~ 0.102347409914292, .default = -0.240170731594466)) + 
#>     case_when(disp <= 206.056435643564 ~ 0.170519142067219, .default = case_when(wt <= 
#>         5.26910891089109 ~ 0.109851140353609, .default = 0.0703308840296108)) + 
#>     case_when(wt <= 4.26231683168317 ~ 0.0209084766145231, .default = -0.127255636100085) + 
#>     case_when(cyl <= 6.73267326732673 ~ case_when(cyl <= 5.94059405940594 ~ 
#>         0.0873223332263582, .default = 0.0231118535912802), .default = -0.134454972160386) + 
#>     case_when(wt <= 1.90022772277228 ~ 0.016862907475708, .default = -0.0344720436862331) + 
#>     case_when(wt <= 1.66789108910891 ~ 0.100724361869511, .default = case_when(wt <= 
#>         2.28745544554455 ~ 0.0288614155532399, .default = -0.271551184814163)) + 
#>     case_when(disp <= 206.056435643564 ~ 0.154066146195713, .default = 0.143388261109583) + 
#>     case_when(wt <= 4.26231683168317 ~ 0.0312269499895216, .default = -0.1020496658973) + 
#>     case_when(cyl <= 6.73267326732673 ~ case_when(cyl <= 5.94059405940594 ~ 
#>         0.131214189976264, .default = 0.026900399876003), .default = -0.169167717280167) + 
#>     case_when(wt <= 1.90022772277228 ~ -0.0384834759479691, .default = -0.0109836500983765) + 
#>     case_when(wt <= 1.66789108910891 ~ 0.134820173276589, .default = case_when(wt <= 
#>         2.28745544554455 ~ -0.00377015174503958, .default = -0.264801417154789)) + 
#>     case_when(disp <= 206.056435643564 ~ 0.156417402284849, .default = 0.0983617263389227) + 
#>     case_when(wt <= 4.26231683168317 ~ 0.0454050194494695, .default = -0.0576085063856489) + 
#>     case_when(cyl <= 6.73267326732673 ~ case_when(cyl <= 5.94059405940594 ~ 
#>         0.0838485525920719, .default = -0.0251188327464235), 
#>         .default = -0.130066986185129) + case_when(wt <= 1.90022772277228 ~ 
#>     0.0857154093842333, .default = 0.0160148949007423) + case_when(wt <= 
#>     1.66789108910891 ~ 0.0299985697865338, .default = case_when(wt <= 
#>     2.28745544554455 ~ 0.052570578033697, .default = -0.306118475801609)) + 
#>     case_when(disp <= 206.056435643564 ~ 0.15333254364241, .default = 0.109243084268014) + 
#>     case_when(wt <= 4.26231683168317 ~ 0.0696646411370064, .default = -0.133900392130145) + 
#>     case_when(cyl <= 6.73267326732673 ~ case_when(cyl <= 5.94059405940594 ~ 
#>         0.0651369620580564, .default = -0.00298440166446755), 
#>         .default = -0.149791417046493) + case_when(wt <= 1.90022772277228 ~ 
#>     0.0800207591246697, .default = -0.0110037437390988) + case_when(wt <= 
#>     1.66789108910891 ~ 0.00340975857993737, .default = case_when(wt <= 
#>     2.28745544554455 ~ -0.0170822487624542, .default = -0.290317244542404)) + 
#>     case_when(disp <= 206.056435643564 ~ 0.152868952126194, .default = 0.152581935068089))/5 * 
#>     23.5 + 22.15

Factor predictors

Factor and character predictors are expanded into indicator columns before the model is fit. tidypredict_fit() maps those columns back onto the original columns, so the returned formula can be used with the same data that the model was fit on.

set.seed(100)
model <- dbarts::bart(
  data.frame(wt = mtcars$wt, cyl = factor(mtcars$cyl)),
  mtcars$mpg,
  ntree = 2,
  ndpost = 2,
  keeptrees = TRUE,
  verbose = FALSE
)

tidypredict_fit(model)
#> (case_when(cyl != "8" ~ 0.0209929673364752, .default = -0.23137072210149) + 
#>     case_when(wt <= 4.06870297029703 ~ case_when(wt <= 2.24873267326733 ~ 
#>         0.2729255967499, .default = -0.0575567928789224), .default = -0.155546894767129) + 
#>     case_when(cyl != "8" ~ 0.0239618128499715, .default = -0.207627487534535) + 
#>     case_when(wt <= 4.06870297029703 ~ case_when(wt <= 2.28745544554455 ~ 
#>         0.311929961318821, .default = -0.0549142789129821), .default = -0.169591479476645))/2 * 
#>     23.5 + 22.15