R语言 按值和文本转换单元格颜色

w46czmvw  于 2023-06-19  发布在  其他
关注(0)|答案(2)|浏览(100)

我想利用{gt}的漂亮的新的data_color改造,但我也想利用text_transformation,并添加链接和自定义文本的表。例如,给定这个数据:

library(dplyr)
library(gt)

dat <- data.frame(
  flag = c("safe", "out", "tie"),
  url = c("https://www.google.com", "https://www.yahoo.com", "https://www.bing.com"),
  value1 = c(1, NA, 3),
  value2 = c(1.1, NA, 8)
)

dat

    dat
  flag                    url value1 value2
1 safe https://www.google.com      1    1.1
2  out  https://www.yahoo.com     NA     NA
3  tie   https://www.bing.com      3    8.0

然后创建一个表:

gt(dat) %>%
  cols_hide(columns = c("flag", "url")) %>%
  data_color(
    direction = "row",
    palette = "viridis"
  ) %>%
  text_transform(fn = function(x) glue("<a href=\"{dat$url}\" target=\"_blank\">{x}</a> {dat$flag}"))

因此,我可以创建一个包含活动URL的表:

但是如果我有多个URL列与相应的vlaue列相匹配呢?例如,这个data.frame:

dat <- data.frame(
  flag = c("safe", "out", "tie"),
  url1 = c("https://www.google.com", "https://www.yahoo.com", "https://www.bing.com"),
  url2 = c("https://www.one.com", "https://www.two.com", "https://www.three.com"),
  value1 = c(1, NA, 3),
  value2 = c(1.1, NA, 8)
)

dat

如何将url_1value_1的值相加,并将_2的值相加?我知道我可以pivot_*得到正确的链接,但然后AKAIK列变成字符串,然后我不能在data_color中使用它们。
有没有什么想法我可以把这两种能力结合起来?

knsnq2tg

knsnq2tg1#

也许有一个更优雅的方法,但一个简单的方法是使用两个text_transform,每对url_value_列一个:

library(dplyr)
library(gt)
library(glue)

gt(dat) %>%
  cols_hide(columns = c("flag", "url1", "url2")) %>%
  data_color(
    direction = "row",
    palette = "viridis"
  ) %>%
  text_transform(
    fn = function(x) glue("<a href=\"{dat$url1}\" target=\"_blank\">{x}</a> {dat$flag}"),
    ocation = cells_body("value1")
  ) |>
  text_transform(
    fn = function(x) glue("<a href=\"{dat$url2}\" target=\"_blank\">{x}</a> {dat$flag}"),
    location = cells_body("value2")
  )

编辑作为for的替代方法,您可以使用purrr::reduce如下:

cols <- grep("value*", names(dat), value = TRUE)

gt(dat) %>%
  cols_hide(columns = c("flag", "url1", "url2")) %>%
  data_color(
    direction = "row",
    palette = "viridis"
  ) %>%
  purrr::reduce(cols, \(x, col) {
    url_col <- gsub("value", "url", col)
    text_transform(x,
      fn = function(x) glue("<a href=\"{dat[[url_col]]}\" target=\"_blank\">{x}</a> {dat$flag}"),
      location = cells_body(col)
    )
  }, .init = .)
rggaifut

rggaifut2#

@stefan:这太长了,不能作为评论添加,但采取你的方法并概括它,这可以在这里工作:

dat <- tibble(
  flag = c("safe", "out", "tie"),
  url1 = c("https://www.google.com", "https://www.yahoo.com", "https://www.bing.com"),
  url2 = c("https://www.one.com", "https://www.two.com", "https://www.three.com"),
  value1 = c(1, NA, 3),
  value2 = c(1.1, NA, 8)
)

gt_table <- gt(dat) %>%
  cols_hide(columns = c("flag", "url1", "url2")) %>%
  data_color(
    direction = "row",
    palette = "viridis"
  )

cols <- grep("value*", names(dat), value = TRUE)

for (i in seq_along(cols)) {
  url_col <- gsub("value", "url", cols[i])
  gt_table <- gt_table %>%
    text_transform(
      fn = function(x) glue("<a href=\"{dat[,url_col, drop = TRUE]}\" target=\"_blank\">{x}</a>"),
      location = cells_body(cols[i])
    )
}

gt_table

相关问题