基于使用 R 选择的调色板动态命名 gt 图

Question

使用下面的示例数据和代码，我能够为数据帧列表的每个元素动态绘制 gt() 图，并为 error 列设置颜色：

df <- structure(list(id = c("M0000607", "M0000609", "M0000612"), `2021-08(actual)` = c(12.6, 
19.2, 8.3), `2021-09(actual)` = c(10.3, 17.3, 6.4), `2021-10(actual)` = c(8.9, 
15.7, 5.3), `2021-11(actual)` = c(7.3, 14.8, 3.1), `2021-12(actual)` = c(6.1, 
14.2, 3.5), `2021-08(pred)` = c(11.65443222, 14.31674997, 7.084180415
), `2021-09(pred)` = c(12.29810914, 17.7143733, 6.057927385), 
    `2021-10(pred)` = c(9.619846116, 15.54553601, 6.525992602
    ), `2021-11(pred)` = c(8.352097939, 13.97318204, 3.164682627
    ), `2021-12(pred)` = c(6.113631596, 14.16243166, 3.288372517
    ), `2021-08(error)` = c(2.082307066, 1.146759554, 0.687406723
    ), `2021-09(error)` = c(1.631350383, 2.753457736, 2.952737781
    ), `2021-10(error)` = c(0.945567783, 4.883250027, 1.215819585
    ), `2021-11(error)` = c(1.998109138, 0.414373304, 0.342072615
    ), `2021-12(error)` = c(0.719846116, 0.154463985, 1.225992602
    )), class = "data.frame", row.names = c(NA, -3L))

year_months <- c('2021-12', '2021-11', '2021-10')  
curr <- lubridate::ym(year_months)
prev <- curr - months(2L)
dfs <- mapply(function(x, y) {
  df[c(
    "id", 
    format(seq.Date(y, x, by = "month"), "%Y-%m(actual)"), 
    format(x, "%Y-%m(pred)"), 
    format(x, "%Y-%m(error)")
  )]
}, curr, prev, SIMPLIFY = FALSE)

plotGT <- function(data){
  plot <- data %>% 
    gt() %>% 
    data_color(
      columns = 6, # set color for error column
      colors = scales::col_numeric(
        palette =
          c("blue", "green", "orange", "red"),  # named with color 1
          # c('#feb8cd', '#ffffff', '#69cfd5'), # named with color 2
        domain = c(0, 10)
      )
    )
  print(plot)
  # gtsave(plot, file = file.path(glue("./plot_color1.png")))
  
}

mapply(plotGT, dfs)

颜色 c("blue", "green", "orange", "red") 的结果：

颜色 c('#feb8cd', '#ffffff', '#69cfd5') 的结果：

为了更进一步，我希望根据 if 条件保存输出：如果我选择第一个调色板，我将以 plot_color1.png 命名图，第二个以 plot_color2.png，但我希望运行整个代码一次，一次保存所有两个数字。

所以我的问题是如何修改上面的代码来实现它？提前感谢您的帮助。

也许有些代码像：gtsave(plot, file = file.path(glue("./plot_color{i}.png"))) 基于 if-else 条件，但我不知道该怎么做。

Answer 1

一个选择是像这样使用命名的 list 调色板，这也可以更容易地在不同调色板之间切换：

编辑

我修复了一个错误。我在 pals 列表中使用了 <- 而不是 = ，这就是您收到错误的原因。
为了遍历调色板，我添加了 pal_choice 作为 table 函数的参数。这样做我们可以循环 pals 使用例如lapply.
此外，当您遍历多个 dfs 时，我添加了一个名称参数并将名称添加到您的数据框列表中。由于 tables 是在相同的文件名下导出的，所以实际上你最终得到一个包含最后一个 table.
的文件
我还取消了对 reprex 的 print 的注释。

library(gt)

pal_choice <- "color2"
pals <- list(color1 = c("blue", "green", "orange", "red"), 
             color2 = c('#feb8cd', '#ffffff', '#69cfd5'))


plotGT <- function(data, name, pal_choice){
  plot <- data %>% 
    gt() %>% 
    data_color(
      columns = 6, # set color for error column
      colors = scales::col_numeric(
        palette = pals[[pal_choice]],
        domain = c(0, 10)
      )
    )
  #print(plot)
  gtsave(plot, file = glue::glue("./plot_{name}_{pal_choice}.png"))
}

names(dfs) <- letters[seq_along(dfs)]

lapply(names(pals), function(x) {
  mapply(plotGT, dfs, names(dfs), MoreArgs = list(pal_choice = x))  
})
#> [[1]]
#>                                                                                                                     a 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_a_color1.png" 
#>                                                                                                                     b 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_b_color1.png" 
#>                                                                                                                     c 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_c_color1.png" 
#> 
#> [[2]]
#>                                                                                                                     a 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_a_color2.png" 
#>                                                                                                                     b 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_b_color2.png" 
#>                                                                                                                     c 
#> "/private/var/folders/l7/hltv70p95zqfdq9z09h8m9bw0000gn/T/Rtmp9LLLHO/reprex-2b71746b0fd-petit-dore/plot_c_color2.png"

基于使用 R 选择的调色板动态命名 gt 图

Dynamically named gt plots based on color palettes selected using R

if-statement

r

dplyr

purrr

gt