Search code examples
regressionlme4sjplot

Custom Transform Coefficients sjPlot::tab_model - Expressing log transformed coefficients as percent change

I fit a log-transformed linear mixed effect model and want to express the coefficients as percent change instead of linear change on the log scale in my summary table with sjPlot

Fake Data:

library(lme4)
library(lmerTest)
library(dplyr)


set.seed(1234)
dat_short <- data.frame(
  dv = c(
    # Add in t1 ctrl 
      rnorm(mean=0.8, sd=0.1, n=6), #Long Healthy
      rnorm(mean=0.7, sd=0.1, n=6), #Lat Healthy
      rnorm(mean=0.6, sd=0.1, n=4),  #Long Damaged
      rnorm(mean=0.5, sd=0.1, n=4),  #Lat Damaged
    # Add in t2 ctrl
    rnorm(mean=0.7, sd=0.1, n=6), #Long Healthy
    rnorm(mean=0.6, sd=0.1, n=6), #Lat Healthy
    rnorm(mean=0.5, sd=0.1, n=4),  #Long Damaged
    rnorm(mean=0.4, sd=0.1, n=4),  #Lat Damaged
    # Add in t1 trt
    rnorm(mean=0.8, sd=0.1, n=6), #Long Healthy
    rnorm(mean=0.7, sd=0.1, n=6), #Lat Healthy
    rnorm(mean=0.6, sd=0.15, n=4), #Long Damaged
    rnorm(mean=0.5, sd=0.15, n=4), #Lat Damaged
    # Add in t2 trt
    rnorm(mean=0.7, sd=0.1, n=6), #Long Healthy
    rnorm(mean=0.6, sd=0.1, n=6), #Lat Healthy
    rnorm(mean=0.65, sd=0.15, n=4),#Long Damaged
    rnorm(mean=0.55, sd=0.15, n=4) #Lat Damaged
  ),
  id=c(rep(c("subj_1", "subj_2"), times=c(40, 40))),
  intervention=c(rep(c("ctrl", "trt"), times=c(40, 40))), 
  timepoint=c(rep(rep(c("t1", "t2"), times=c(20, 20)),2)), 
  direction=c(rep(rep(c("long", "lat", "long", "lat"), times=c(6, 6, 4, 4)),4)),
  region=c(rep(rep(c("healthy", "damaged"), times=c(12, 8)),4))
)  |>
  mutate(dv = case_when(
         id == "subj_1" ~ dv + runif(1, min = 0.01, max = 0.2),
         id == "subj_2" ~ dv))


speed_measures <-data.frame(
  n_speed = c(
    # Add in t1 ctrl 
      round(runif(8, min = 3, max =10),0)
  ),
  id=c(rep(c("subj_1", "subj_2"), times=c(4, 4))),
  timepoint=c(rep(rep(c("t1", "t2"), times=c(2, 2)),2)), 
  direction=c(rep(rep(c("long", "lat"), times=c(1, 1)))
))  

dat_short_combined <- speed_measures |> left_join(dat_short) |> slice_sample(n = 70)

Fit the regression

lmm_1_short <- lmer(dv ~ intervention*timepoint*region + direction + (1|id), data=dat_short)

Summarize it nicely with sjPlot::tab_model, but this is linear change on the log scale, not as intuitive to understand

sjPlot::tab_model(lmm_1_short,
                  show.intercept = FALSE,
                  show.reflvl = TRUE,
                  show.obs = TRUE,
                  df.method = "satterthwaite")

enter image description here

So we can transform the coefficients to percent change:

# Transform regression coefficients to % change
lmm_1_short_perc_summary <- coef(lmm_1_short)$id |>
  summarise(across(.fns = ~100*( exp(.x)-1) ) ) |>
  summarise(across(.fns = ~mean(.x))) |>
  select(-"(Intercept)") |>
  tidyr::pivot_longer(cols = everything(), names_to="Coefficient", values_to = "% Change") |>
  # Add p-values etc. from regression summary
  cbind(coef(summary(lmm_1_short))[-1,-1]) |>
# Compute confidence intervals and transform those to % change as well
  cbind(data.frame(confint(lmm_1_short))[4:11,]) |>
  transmute(Coefficient, across(where(is.numeric), .fns = ~round(.x,3))) |>
    rename("2.5% CI" = `X2.5..`, "97.5% CI" = `X97.5..`) 

row.names(lmm_1_short_perc_summary) <- 1:nrow(lmm_1_short_perc_summary)
lmm_1_short_perc_summary

Which gives this nice summary:

enter image description here

So the goal is, make a pretty sjPlot style regression summary with my log -> % change transformation.

I tried to use the transform function in tab_model, to no avail. I assumed that sjPlot dragged in get_model_data early but really I have no idea.

function_test <- function(arg_1) {
  sjPlot::get_model_data(arg_1, "est") |>
    mutate(estimate = 100*( exp(estimate)-1) )
}

sjPlot::tab_model(lmm_1_short,
                  show.intercept = FALSE,
                  transform = "function_test",
                  show.reflvl = TRUE,
                  show.obs = TRUE,
                  df.method = "satterthwaite")

Error in if (fam.info$is_linear) transform <- NULL else transform <- "exp" : 
  argument is of length zero

Ref: https://cscu.cornell.edu/wp-content/uploads/83_logv.pdf

Solution

  • Transform in sjPlot is a single input function, this works:

    function_test <- function(arg_1) {
    100*( exp(arg_1)-1) 
}

sjPlot::tab_model(lmm_1_short,
                  show.intercept = FALSE,
                  transform = "function_test",
                  show.reflvl = TRUE,
                  show.obs = TRUE,
                  df.method = "satterthwaite")

    enter image description here