r - kableextra 表列中的背景颜色

Question

我有一个导出为 pdf 的简单 RMarkdown 文档，其中包含一个只有 2 列的 kablextra 表(见图)。我试图将两列的背景设置为蓝色阴影，其中高值用较深的颜色表示，低值用较浅的颜色表示。值的顺序不能更改，因为它们代表月度数字。当我尝试寻找解决方案时，我设法让列具有一些背景颜色(见图)。

library(kableExtra)
library(paletteer)
library(tidyverse)

#two vectors

column_1<-c(144, 189, 213, 231, 229, 235, 216, 221, 221, 200, 204, 236)
column_2<-c(83.7, 92.5, 87.6, 88.2, 80.5, 72.6, 66.7, 71.9, 66.7, 58.2, 72.1, 72.7)


#create dataframe
activity<-data.frame (column_1, column_2)

#create kableextra summary table 

kbl(activity, booktabs = T, linesep = "",  col.names = linebreak(c("Column 1", "Column 2")), align = "c", caption = "Summary Table") %>%
  kable_styling(full_width = F) %>%
  kable_styling(font_size = 12, position = "center") %>% 
  kable_styling(latex_options = "hold_position") %>% 
  column_spec(1, color = "black", background = paletteer_d("ggsci::blue_material")) %>%
  column_spec(2, color = "white", background = spec_color(activity$column_1, end = 0.9, option = "viridis", direction = -1)) 
  

左列使用以下代码，正是我想要的颜色，但我无法正确突出显示值(高亮为深色，低亮为浅色 - 如上所述，我无法将低到高，因为它们是时间序列数据):

column_spec(1, color = "black", background = paletteer_d("ggsci::blue_material")) %>%

右栏按照我​​想要的方式突出显示高值和低值，但没有使用我想要的颜色! (工作中的人实际上不喜欢它!)

column_spec(2, color = "white", background = spec_color(activity$column_2, end = 0.9, option = "viridis", direction = -1)) %>%

是否可以在左列的代码中添加一个参数，使其像右列一样用较深的颜色突出显示高值，但不对列中的值进行排序？

感谢您花时间阅读我的帖子

问候

昏暗

Answer 1

您使用的 spec_color 函数没有提供不同调色板的选项，但它非常简单:

> spec_color
function(x, alpha = 1, begin = 0, end = 1,
                       direction = 1, option = "D",
                       na_color = "#BBBBBB", scale_from = NULL) {
  if (is.null(scale_from)) {
    x <- round(rescale(x, c(1, 256)))
  } else {
    x <- round(rescale(x, to = c(1, 256),
                       from = scale_from))
  }

  color_code <- viridisLite::viridis(256, alpha, begin, end, direction, option)[x]
  color_code[is.na(color_code)] <- na_color
  return(color_code)
}
<bytecode: 0x7fb1aae1a0a8>
<environment: namespace:kableExtra>

您可以使用您喜欢的调色板编写自己的替代方案:

spec_color2 <- function(x, alpha = 1, begin = 0, end = 1,
         direction = 1, option = "D",
         na_color = "#BBBBBB", scale_from = NULL,
         palette = viridisLite::viridis(256, alpha, begin, end, direction, option)) {
  n <- length(palette)
  if (is.null(scale_from)) {
    x <- round(scales::rescale(x, c(1, n)))
  } else {
    x <- round(scales::rescale(x, to = c(1, n),
                       from = scale_from))
  }
  
  color_code <- palette[x]
  color_code[is.na(color_code)] <- na_color
  return(color_code)
}

然后您的表格将使用此代码显示:

kbl(activity, booktabs = T, linesep = "",  col.names = linebreak(c("Column 1", "Column 2")), align = "c", caption = "Summary Table") %>%
  kable_styling(full_width = F) %>%
  kable_styling(font_size = 12, position = "center") %>% 
  kable_styling(latex_options = "hold_position") %>% 
  column_spec(1, color = "black", background = spec_color2(activity$column_1, palette = paletteer_d("ggsci::blue_material"))) %>%
  column_spec(2, color = "white", background = spec_color2(activity$column_2, palette = paletteer_d("ggsci::blue_material")))