r - 有没有办法使用 gt 包按行（如迷你图）动态嵌入 ggplot 图像？

Question

我正在尝试复制此过程并获取 gt 包来呈现 ggplot 对象，其中表中的每一行都有不同的图形（如火花线）。

链接页面上似乎有解决方案，但是当我尝试复制它时，出现以下错误

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))
    }
  )

Answer 1

我想我可能已经通过更改一些代码找到了解决方案。

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

Answer 2

这似乎可以满足您的需求，并且比公认的答案更简洁。

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))