Есть ли способ динамически встроить изображение ggplot по строкам (например, спарклайну) с помощью пакета gt?

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)

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