有没有办法使用 gt 包按行动态嵌入 ggplot 图像(如迷你图)?
Is there a way to embed a ggplot image dynamically by row (like a sparkline) using the gt package?
我正在尝试复制 this process 并获取 gt 包来渲染 ggplot 对象,其中 table 中的每一行都有不同的图形(如迷你图)。
链接页面上似乎有一个解决方案,但是当我尝试复制它时,出现以下错误
Error in body[[col]][loc$rows] <- fn(body[[col]][loc$rows]) : replacement has length zero
有人可以帮我调试一下吗?我在这里用头撞墙
示例代码:
library(tidyverse)
#> Warning: package 'tibble' was built under R version 3.5.2
library(gt)
library(purrr)
# make a function for creating a plot
# of a group
plot_group <- function(name, df) {
plot_object <-
ggplot(data = df,
aes(x = hp, y = trq,
size = msrp)) +
geom_point(color = "blue") +
theme(legend.position = "none")
return(plot_object)
}
# make a plot of each mfr
gtcars %>%
group_by(mfr) %>%
nest() %>%
mutate(plot = map2(mfr, data, plot_group)) %>%
select(-data) %>%
# Create empty column (a placeholder for the images)
mutate(ggplot = NA) ->
tibble_plot
# Minor changes to this code
tibble_plot %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)), # use empty cell as location
fn = function(x) {
# Insert each image into each empty cell in `ggplot`
map(.$plot, ggplot_image, height = px(200))
}
)
我想我可能已经通过更改一些代码找到了解决方案。
library(ggplot2)
library(gt)
library(tidyr)
# make a plot of each mfr
tibble_plot <- gtcars %>%
group_by(mfr) %>%
nest() %>%
mutate(plot = map(data, ~ggplot(., aes(hp, trq, size = msrp)) + #you could use the function and it should work
geom_point() +
geom_point(color = "blue") +
theme(legend.position = "none"))) %>%
select(-data) %>%
# Create empty column (a placeholder for the images)
mutate(ggplot = NA)
#Creates the length of the tibble
text_names <- gtcars %>%
select(mfr) %>%
unique() %>%
pull()
# Is a bit slow for me
tibble_output <- tibble(
text = text_names,
ggplot = NA,
.rows = length(text_names)) %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)),
fn = function(x) {
map(tibble_plot$plot, ggplot_image, height = px(200))
}
)
tibble_output
这似乎达到了您的需要,并且比公认的答案更简洁。
library(tidyverse)
library(gt)
gtcars %>%
nest_by(mfr) %>%
rowwise() %>%
mutate(
gg = (
ggplot(data = data,
aes(x = hp, y = trq,
size = msrp)) +
geom_point(color = "blue") +
theme(legend.position = "none")
) %>%
ggplot_image(height = px(200)),
data = NULL
) %>%
gt() %>%
fmt_markdown(vars(gg))
我正在尝试复制 this process 并获取 gt 包来渲染 ggplot 对象,其中 table 中的每一行都有不同的图形(如迷你图)。
链接页面上似乎有一个解决方案,但是当我尝试复制它时,出现以下错误
Error in body[[col]][loc$rows] <- fn(body[[col]][loc$rows]) : replacement has length zero
有人可以帮我调试一下吗?我在这里用头撞墙
示例代码:
library(tidyverse)
#> Warning: package 'tibble' was built under R version 3.5.2
library(gt)
library(purrr)
# make a function for creating a plot
# of a group
plot_group <- function(name, df) {
plot_object <-
ggplot(data = df,
aes(x = hp, y = trq,
size = msrp)) +
geom_point(color = "blue") +
theme(legend.position = "none")
return(plot_object)
}
# make a plot of each mfr
gtcars %>%
group_by(mfr) %>%
nest() %>%
mutate(plot = map2(mfr, data, plot_group)) %>%
select(-data) %>%
# Create empty column (a placeholder for the images)
mutate(ggplot = NA) ->
tibble_plot
# Minor changes to this code
tibble_plot %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)), # use empty cell as location
fn = function(x) {
# Insert each image into each empty cell in `ggplot`
map(.$plot, ggplot_image, height = px(200))
}
)
我想我可能已经通过更改一些代码找到了解决方案。
library(ggplot2)
library(gt)
library(tidyr)
# make a plot of each mfr
tibble_plot <- gtcars %>%
group_by(mfr) %>%
nest() %>%
mutate(plot = map(data, ~ggplot(., aes(hp, trq, size = msrp)) + #you could use the function and it should work
geom_point() +
geom_point(color = "blue") +
theme(legend.position = "none"))) %>%
select(-data) %>%
# Create empty column (a placeholder for the images)
mutate(ggplot = NA)
#Creates the length of the tibble
text_names <- gtcars %>%
select(mfr) %>%
unique() %>%
pull()
# Is a bit slow for me
tibble_output <- tibble(
text = text_names,
ggplot = NA,
.rows = length(text_names)) %>%
gt() %>%
text_transform(
locations = cells_body(vars(ggplot)),
fn = function(x) {
map(tibble_plot$plot, ggplot_image, height = px(200))
}
)
tibble_output
这似乎达到了您的需要,并且比公认的答案更简洁。
library(tidyverse)
library(gt)
gtcars %>%
nest_by(mfr) %>%
rowwise() %>%
mutate(
gg = (
ggplot(data = data,
aes(x = hp, y = trq,
size = msrp)) +
geom_point(color = "blue") +
theme(legend.position = "none")
) %>%
ggplot_image(height = px(200)),
data = NULL
) %>%
gt() %>%
fmt_markdown(vars(gg))