适用于R的Huxtable包：使用huxreg（）在回归表中的两个模型列表之间的颜色编码差异

Question

我正在寻找一种方法来快速发现我使用huxtable::huxreg()输出的两个回归模型列表（list_models和list_models_adjusted）之间的差异。 在使用huxreg()用于模型列表的回归表中，是否可以在模型上有条件地着色表元素？ 我在想某事。 喜欢：

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

最少（不完全）的工作示例

    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')

Answer 1

这是一个非常不寻常的用例，您将不得不手动执行。

我将设置一个简单的版本：

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  

现在：

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  

比较值要比这复杂一些-您需要获取两个p值向量，进行比较，并弄清楚如何将其映射到huxreg行和列的矩阵中。