Search code examples
rggplot2tidyversegt

Is there a way to embed a ggplot image dynamically by row (like a sparkline) using the gt package?


I'm trying to replicate this process and get the gt package to render ggplot objects where each row in the table gets a different graph (like a spark line).

There appears to be a solution on the linked page, but when I try to replicate it, I get the following error

Error in body[[col]][loc$rows] <- fn(body[[col]][loc$rows]) : replacement has length zero

Could someone please help me debug this? I'm banging my head against the wall here.

Example code:

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


Solution

  • I think I may have found a solution by changing some of the code.

    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