英文:
cell colour by value and text transformations in gt
问题
我想利用 {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))datdatflag url value1 value21 safe https://www.google.com 1 1.12 out https://www.yahoo.com NA NA3 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}"))
这样，您可以创建一个具有活动链接的表格。
但是，如果有多列链接与相应的值列匹配，例如以下数据：
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_1的值与value_1合并，并对 _2 执行相同操作？我知道可以使用 pivot_* 来获取正确的链接，但据我所知，这些列会变成字符串，然后我无法在 data_color 中使用它们。
有什么想法如何合并这两种功能？
英文:
I want to make use of {gt}'s nice new-ish data_color revamp but I would like to also make use of text_transformation and to add links and custom text to the table. So for example given this data:
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))datdatflag url value1 value21 safe https://www.google.com 1 1.12 out https://www.yahoo.com NA NA3 tie https://www.bing.com 3 8.0
and then create a table:
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}"))
So I can make a table that has active urls:
But what if I have multiple columns of urls that matches a corresponding vlaue column. So for example this 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
How can I add the values from url_1 to value_1 and the same for _2? I know I can pivot_* to get the right links but then AKAIK the columns become strings and then I can't use them in data_color.
Any ideas how I might merge these two abilities?
答案1
得分: 1
也许有一种更优雅的方法，但简单的方法是使用两个 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"))
EDIT 另一种替代 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 = .)
英文:
Maybe there is a more elegant approach but a simple one would be to use two text_transform, one for each pair of url_ and value_ columns:
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"))
EDIT And as an alternative approach to a for you could use purrr::reduce like so:
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 = .)
答案2
得分: 1
@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
这是翻译好的代码部分。
英文:
@stefan: This was too long to add as a comment but taking your approach and generalizing it, this could work here:
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
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论