Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

adding ggplot graphs in every row of a table #152

Open
CerebralMastication opened this issue Jan 29, 2019 · 9 comments · May be fixed by #155
Open

adding ggplot graphs in every row of a table #152

CerebralMastication opened this issue Jan 29, 2019 · 9 comments · May be fixed by #155

Comments

@CerebralMastication
Copy link

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
Copy link

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
Copy link
Collaborator

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
Copy link
Member

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

@dgkf
Copy link

dgkf commented Feb 17, 2019

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
Copy link

shawnminnig commented May 12, 2020

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
Copy link

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

@shawnminnig
Copy link

shawnminnig commented Jul 13, 2020

Hi @filius23 - yes, I posted to stackoverflow a while back and my colleague Edgar was able to come up with a solution

Here's the code if you don't feel like loading the page. Hope that helps!

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

@filius23
Copy link

thank you so much!

@loukesio
Copy link

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

the function fmt_ggplot() from which package is coming from. I am trying to replicate the plot but I am taking the following error Error in fmt_ggplot(., columns = vars(min - mean - max), aspect_ratio = 5, :
could not find function "fmt_ggplot"

@rich-iannone rich-iannone added this to the FUTURE milestone Aug 22, 2022
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment