adding `ggplot` graphs in every row of a table

[CerebralMastication]

I can't quite get gt to render ggplot objects where each row in the table gets a different graph (like a spark line).

I can make a tibble where each row contains one cell that is the ggplot object, but I can't get text_transform and ggplot_image to convert that into an image:

library(tidyverse)
#> Warning: package 'tibble' was built under R version 3.5.2
library(gt)

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

# tibble plot contains 2 columns: 
#   mfr & plot where plot is a ggplot object

# can't figure out how to plot those ggplot objects though
tibble_plot %>%
  gt() %>%
  text_transform(
    locations = cells_data(vars(plot)),
    fn = function(x) {
      ggplot_image(x, height = px(200))
    }
  )
#> Error in UseMethod("grid.draw"): no applicable method for 'grid.draw' applied to an object of class "list"

it seems like maybe this should work... but it doesn't:

tibble_plot %>%
  gt() %>%
  text_transform(
    locations = cells_data(vars(plot)),
    fn = function(x) {
      ggplot_image(x$plot)
    }
  )

Thanks for taking a look at this!

[jdbarillas]

It seems that there needs to be empty column within tibble_plot where you will insert the ggplot objects. The following worked for me

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_data(columns = 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))
    }
  )

[schloerke]

Great solution @jdbarillas! Can also clean up the temp column by adding a cols_hide after the transformation.

tibble_plot %>%
  gt() %>%
  text_transform(
    locations = cells_data(columns = 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))
    }
  ) %>%
  cols_hide(vars(plot))

[rich-iannone]

There is now a PR for this (#155) and the limitation there is that it only addresses HTML output (for now).

[dgkf]

Thanks for adding fmt_ggplot, @rich-iannone - this looks like a really awesome addition to the package.

In my field, a common type of plot is a forest plot (examples) - effectively a table with an overlayed plot across multiple rows. From how I've seen this done before, these plots are typically plot objects with text arranged in a faux-table (e.g. the forestplot package).

I wanted to raise this as a potential use case for that might not be entirely addressed via the one-plot-per-row mechanism introduced by fmt_ggplot. I tried to tackle something like this with fmt_ggplot (my attempt below), but ran into a couple issues:

1. Maintaining consistent axis limits across all plots requires deriving axis limits across the full dataset and then using ggplot2::scale_x_* to force each row's plot axis to be consistent.
2. I haven't found a clean way to display the axis scales along a group margin (similar to a summary row)

For this type of plot, it would be nice if a single plot could be defined across all rows. Perhaps it could implicitly take the gt(<rowname_col>) as the ggplot2::aes(<y>) when the y aesthetic is unspecified or as ggplot2::facet_grid(<y> ~ ...) when the y aesthetic is provided.

I'm sure there are plenty of challenges with properly formatting such a plot so that the y axis ticks or facets align with the table rows, but it would certainly go a long way towards improving the way these types of plots are currently built and shared.

---

Forest Plot Attempt

library(dplyr)
library(tidyr)
library(purrr)
library(ggplot2)
library(gt)

iris %>%
  group_by(Species) %>%
  nest() %>%
  # calculate a column of global min and max - needed for setting plot limits
  mutate(
    Sepal.Length.Min = min(unlist(map(data, ~.$Sepal.Length))),
    Sepal.Length.Max = max(unlist(map(data, ~.$Sepal.Length))),
    Sepal.Length.Mean = mean(unlist(map(data, ~.$Sepal.Length)))
  ) %>%
  # build row plots
  mutate(`min - mean - max` = pmap(
    list(data, Sepal.Length.Min, Sepal.Length.Max, Sepal.Length.Mean), 
    ~ggplot(..1) + 
      geom_vline(
        xintercept = ..4, 
        size = 10,
        color = "blue") + 
      geom_errorbarh(
        mapping = aes(
          xmin = min(..1$Sepal.Length), 
          xmax = max(..1$Sepal.Length),
          y = 0),
        size = 10) + 
      geom_point(
        mapping = aes(
          x = mean(..1$Sepal.Length),
          y = 0),
        size = 50) + 
      scale_x_continuous(limits = c(..2, ..3)) + 
      theme_void() + 
      theme(
        plot.background = element_blank(),
        panel.background = element_blank())
  )) %>%
  select(Species, `min - mean - max`) %>%
  gt() %>%
  # make plots elongated - getting errors when trying really high aspect ratios
  # Error: Dimensions exceed 50 inches (height and width are specified in
  #    'in' not pixels). If you're sure you want a plot that big, use
  #    `limitsize = FALSE`.
  fmt_ggplot(
    columns = vars(`min - mean - max`),
    aspect_ratio = 5,
    height = 20) %>%
  tab_spanner(
    label = "Sepal.Length",
    columns = vars("min - mean - max")) %>%
  # make all rows have a white background so plots with white background don't
  # stand out
  tab_style(
    style = cells_styles(bkgd_color = rgb(1, 1, 1)),
    locations = cells_data(rows = TRUE))

[shawnminnig]

I stumbled here trying to replicate @jdbarillas solution from above for a report of my own in RMarkdown, but when I try to run the code I’m getting an error that looks like this...

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

Is this the most effiecient method for inserting row-wise ggplot graphics into a table, and if so would someone be willing to help me figure out what I’m doing wrong with the code?

Thanks a million!

[filius23]

I'm getting the same error - have you found an alternative solution?