简体   繁体   中英

Huxtable package for R: Color coding differences between two lists of models in regression table with huxreg()

I am looking for a way to quickly spot differences between two lists of regression models (list_models & list_models_adjusted) which I output with huxtable::huxreg() . In a regression table made with huxreg() for a list of models, is it possible to colorize table elements conditionally on the model? I am thinking of sth. like:

huxreg(list_models_adjusted) %>% 
  set_background_color(where(list_models_adjusted[[ANY MODEL]][["p.value"]] < list_models[[ANY MODEL]][["p.value"]]), 'orange')

Minimal (not fully) Working Example

    library("tidyverse")
    library("lmerTest")
    library("multcomp")
    library("huxtable")

    states <- as.data.frame(state.x77)
    df_wide <- states[, c("Frost", "Area")]
    colnames(df_wide) <- c("cat1_level1", "cat1_level2")
    df_wide$subject <- c(paste0("S", 1:(nrow(df_wide)))) # add column with "SubjectIDs":
    df_long <- df_wide %>% 
        gather(cat1, likertscore, -subject)

    # Define models
    # ------------------------------------------------------------------
    # base model: fixed effect: cat1
    model_lm0   <- lm(likertscore ~ cat1, data = df_long)  
    # + random effect: subject => (1 | subject)
    model_lm    <- lmer(likertscore ~ cat1 + (1 | subject), data = df_long)  

    # 1) unadjusted models
    # ------------------------------------------------------------------
    list_models <- list()
    list_models[["model_lm0"]] <- model_lm0
    list_models[["model_lm"]] <- model_lm

    # 2) adjusted models
    # ------------------------------------------------------------------
    # Function to adjust p-values
    adjMC <- function( model ) {
        model_glht <- glht(model)
        model_mc_adj <- summary(model_glht, test = adjusted('holm')) # Bonferroni-Holm 
      return(model_mc_adj)
    }
    # Apply function to (list of) models
    list_models_adj <- list()
    list_models_adj <- lapply(list_models, adjMC)
    # tidy adjusted models and make column names conform with huxtable
    list_models_adj_tidy <- lapply(list_models_adj,  broom.mixed::tidy)
    colnames(list_models_adj_tidy$model_lm0) <- c("term", "rhs", "estimate", "std.error", "statistic", "p.value" )
    colnames(list_models_adj_tidy$model_lm) <- c("term", "rhs", "estimate", "std.error", "statistic", "p.value" )

    # 3) output regression table for both
    # ------------------------------------------------------------------
    huxreg(list_models)           # regression table with unadjusted p-values
    huxreg(list_models_adj_tidy)  # regression table with adjusted p-values

    # regression table with colored differences
    # i.e. table for adjusted p-values with differences to table with unadjusted p-values colored
    huxreg(list_models_adj_tidy) %>% 
      set_background_color(where(list_models_adj_tidy[[ANY MODEL]][["p.value"]] < list_models[[ANY MODEL]][["p.value"]]), 'orange')

This is an unusual enough use case that you are gonna have to do it manually.

I'll set up a simple version:


hux1 <- as_hux(cbind(1:3, 1:3))
hux2 <- as_hux(cbind(1:3, 1:3))
hux2[[2, 2]] <- 4
hux1
#>        1         1  
#>        2         2  
#>        3         3 
hux2
#>        1         1  
#>        2         4  
#>        3         3  

Now:

diffs <- hux != hux2     # a logical matrix
background_color(hux2)[diffs] <- "red" # works due to the magic of R indexing
hux2
#>        1         1  
#>        2         4  # trust me, this one is red 
#>        3         3  

To compare values will be a little more complex than this - you'll need to get two vectors of p-values, compare them, and figure out how to map that into the matrix of huxreg rows and columns.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM