基于R选择的调色板动态命名gt图
基于R选择的调色板动态命名gt图
提问于 2022-01-26 12:23:10
通过下面的示例数据和代码，我能够动态地为数据列表中的每个元素绘制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命名的，但是我希望运行整个代码一次，保存所有两个数字一次。
因此，我的问题是如何修改上面的代码来实现这一点？谢谢你提前帮忙。
也许是一些代码，比如:基于if- based条件的gtsave(plot, file = file.path(glue("./plot_color{i}.png")))，但我不知道如何准确地做到这一点。
回答 1
Stack Overflow用户
回答已采纳
发布于 2022-01-26 12:30:28
一种选择是使用这样一个名为list的调色板，这也使得在不同的调色板之间切换变得更容易：
编辑
- 我修复了一个bug。我在
pals列表中使用了一个pals，而不是=，这是导致错误的原因。
在调色板上循环使用
- ，我在表函数中添加了
pal_choice作为参数。这样，我们就可以使用例如lapply.
在上循环
当您在多个
- Additionally，上循环时，我添加了一个名称参数，并将名称添加到数据帧列表中。实际上，这些表是在同一个文件名下导出的，因此最终得到了一个包含最后一个表的文件。
- I还取消了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"页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/70863363
复制相关文章
相似问题
腾讯云开发者
