Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

like image 775
Shawn Minnig Avatar asked May 11 '20 23:05

Shawn Minnig


2 Answers

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
like image 194
Edgar Zamora Avatar answered Nov 14 '22 20:11

Edgar Zamora


This seems to attain what you need and is more concise than the accepted answer.

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)) 
like image 24
Jakub.Novotny Avatar answered Nov 14 '22 20:11

Jakub.Novotny