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))
}
)
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
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))
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With