Combine multiple gt tables to single one plot - r

With code below (edited basing on code from here) I generates two example tables with gt package:
library(tidyverse)
library(patchwork)
library(gt)
p1 <- mtcars %>%
head(5) %>%
gt()
p2 <- mtcars %>%
tail(5) %>%
gt()
# using wrap elements because this seems to be the answer to non-ggplot grobs e.g. #164
wrap_elements(full = p1 | p2)
grid.arrange(p1, p2, ncol=2, top="Main Title")
Out:
Error in p1 | p2 :
operations are possible only for numeric, logical or complex types
I hope to combine them into one as for ggplot objects: p <- (p1 | p2) using patchwork package, but I didn't find an effective answer yet.
I also try to convert it to ggplot using as_ggplot() function:
library(bstfun)
mtcars %>%
head(5) %>%
gt() %>%
as_ggplot()
But it raises an error:
Error: '.assert_package' is not an exported object from 'namespace:broom.helpers'
Is it possible to do so? Thanks for your help at advance.
Reference:
R - combine two gt objects in a single page output

I can offer to you this solution:
1. We take your data:
p1 <- mtcars %>%
head(5) %>%
gt()
p2 <- mtcars %>%
tail(5) %>%
gt()
2. Let's save your tables into .png's:
p1 %>%
gtsave("p11.png", path = "Your_working_dir")
p2 %>%
gtsave("p12.png", path = "Your_working_dir")
3. Let's combine your tables:
library(cowplot)
p111 <- ggdraw() + draw_image("p11.png", scale = 0.8)
p112 <- ggdraw() + draw_image("p12.png", scale = 0.8)
plot_grid(p111, p112)
Our result:

Related

Extract ggplot from a nested dataframe

I have created a set of ggplots using a grouped dataframe and the map function and I would like to extract the plots to be able to manipulate them individually.
library(tidyverse)
plot <- function(df, title){
df %>% ggplot(aes(class)) +
geom_bar() +
labs(title = title)
}
plots <- mpg %>% group_by(manufacturer) %>% nest() %>%
mutate(plots= map(.x=data, ~plot(.x, manufacturer)))
nissan <- plots %>% filter(manufacturer == "nissan") %>% pull(plots)
nissan
nissan + labs(title = "Nissan")
In this case, "nissan" is a list object and I am not able to manipulate it. How do I extract the ggplot?
In terms of data structures, I think retaining a tibble (or data.frame) is suboptimal with respect to the illustrated usage. If you have one plot per manufacturer, and you plan to access them by manufacturer, then I would recommend to transmute and then deframe out to a list object.
That is, I would find it more conceptually clear here to do something like:
library(tidyverse)
plot <- function(df, title){
df %>% ggplot(aes(class)) +
geom_bar() +
labs(title = title)
}
plots <- mpg %>%
group_by(manufacturer) %>% nest() %>%
transmute(plot=map(.x=data, ~plot(.x, manufacturer))) %>%
deframe()
plots[['nissan']]
plots[['nissan']] + labs(title = "Nissan")
Otherwise, if you want to keep the tibble, another option similar to what has been suggested in the comments is to use a first() after the pull.

Increasing the size of plot in grid.arrange

I would like to plot a bar chart and a table below it using ggplot2 and knitting to word via Rmd. However, I need my plot to be a bit bigger and my respective table to be a bit smaller. The current code produces a very small bar plot. Below is a working example.
library(tidyverse)
library(grid)
library(gridExtra)
#plot
g <- ggplot(mpg, aes(class))
g<-g + geom_bar()
#table
dat<-mpg %>% count(class) %>%
t() %>%
as.data.frame() %>%
row_to_names(row_number = 1)
table <- tableGrob(dat)
#table and plot
plot2_fin<-grid.arrange(arrangeGrob(nullGrob(), g ,
widths=c(3,8)),
arrangeGrob(arrangeGrob(nullGrob(),table, widths=c(3,18,1)),
heights=c(1,1)))
plot2_fin
You might consider moving from grid to cowplot
library(tidyverse)
library(grid)
library(gridExtra)
#plot
g <- ggplot(mpg, aes(class))
g<-g + geom_bar()
#table
dat<-mpg %>% count(class) %>%
t() %>%
as.data.frame() %>%
row_to_names(row_number = 1)
table <- tableGrob(dat)
#table and plot
library(cowplot)
plot_grid(g, table,
ncol = 1,
rel_heights = c(4, 1))

two-panel scatter plot in ggplot2

For my data.frame full below, I'm wondering how to create a two-panel geom_point such that on the first panel, we have ols.(Intercept) (x-axis) plotted against hlm.(Intercept), AND on the second panel, we have ols.ses (x-axis) plotted against hlm.ses?
library(lme4)
library(tidyverse)
hsb <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/hsb.csv')
fit <- lmer(math~ses+(ses|sch.id), data= hsb)
ch <- unique(hsb$sch.id)
ols <- map_dfr(ch,~coef(lm(math~ses, data=hsb,subset=sch.id==.)))
mlm <- coef(fit)$sch
full <- cbind(ols=ols, hlm=mlm, sch.id=ch)
head(full, n = 1)
ols.(Intercept) ols.ses hlm.(Intercept) hlm.ses sch.id
1224 10.80513 2.508582 11.06002 2.504083 1224
One approach to achieve this is by making two separate plots and glue them together using e.g. patchwork:
library(lme4)
library(tidyverse)
library(patchwork)
hsb <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/hsb.csv')
fit <- lmer(math~ses+(ses|sch.id), data= hsb)
ch <- unique(hsb$sch.id)
ols <- map_dfr(ch,~coef(lm(math~ses, data=hsb,subset=sch.id==.)))
mlm <- coef(fit)$sch
full <- cbind(ols=ols, mlm=mlm, sch.id=ch)
p1 <- ggplot(full, aes(`ols.(Intercept)`, `mlm.(Intercept)`)) +
geom_point()
p2 <- ggplot(full, aes(ols.ses, mlm.ses)) +
geom_point()
p1 + p2
And as a second approach with some data wrangling one can achieve a similar plot using facet_wrap:
library(lme4)
#> Loading required package: Matrix
library(tidyverse)
hsb <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/hsb.csv')
fit <- lmer(math~ses+(ses|sch.id), data= hsb)
ch <- unique(hsb$sch.id)
ols <- map_dfr(ch,~coef(lm(math~ses, data=hsb,subset=sch.id==.)))
mlm <- coef(fit)$sch
full <- cbind(ols=ols, mlm=mlm, sch.id=ch)
full %>%
pivot_longer(- sch.id, names_to = "var", values_to = "value") %>%
separate(var, into = c("var1", "category"), sep = "\\.") %>%
pivot_wider(names_from = var1, values_from = value) %>%
ggplot(aes(ols, mlm)) +
geom_point() +
facet_wrap(~ category)
An option with facets. The solution from #stefan was really nice and quick. You could set an entire data pipeline by smartly separating your strings and then after reshaping you can have the desired variables in a format to be plotted using facet_wrap(). Here the code:
library(tidyverse)
#Plot
full %>% select(-sch.id) %>% pivot_longer(everything()) %>%
separate(name,c('V1','V2'),sep='\\.') %>%
arrange(V2,V1) %>%
group_by(V2,V1) %>% mutate(id=row_number()) %>%
pivot_wider(names_from = V1,values_from=value) %>% ungroup() %>%
select(-id) %>%
ggplot(aes(x=ols,y=mlm))+
geom_point()+
facet_wrap(.~V2,nrow = 1,scales = 'free')
Output:
Similar to the answer using patchwork, you can plot them as two separate ggplot() graphs and then put them side-by-side with the plot_grid() function from the cowplot package.
https://cran.r-project.org/web/packages/cowplot/vignettes/introduction.html

Using Purrr package to produce plots with correct xlab

I am trying to use the map function from Purrr package to produce a bunch of plots at one time. I met issues with the xlab title.
library(dplyr)
library(purrr)
df <- mtcars
df %>% keep(is.numeric) %>%
map(~qplot(.), geom = 'density')
The xlab of each resulting plot turns to be .. I have tried to include xlab = . into the function, but it does not work. How can I add the correct xlab (e.g., the column name) to each plot? Thanks!
map only iterates the columns, not the names of the columns. You can also iterate the names with imap. For example
df %>% keep(is.numeric) %>%
imap(~qplot(.x, xlab=.y, geom = 'density'))
We can use imap instead of map and use the .y in xlab
library(tidyverse)
library(ggplot2)
df %>%
keep(is.numeric) %>%
imap(~qplot(.x) +
geom_density() +
xlab(.y))
-output (last plot)

applying a function to the output of dplyr's group_by

I would like to subset a large dataframe and create a ggplot of each grouping. Sounds like a perfect candidate for dplyr but I'm running into issues calling functions on the group_by results. Any hints would be greatly appreciated.
# what I want to do using base functions: "groupby" the elements in a column
# and create/save a plot for each group
for (i in levels(iris$Species)){
df = iris[iris$Species == i,]
p <- ggplot(df, aes(x=Sepal.Length, y=Sepal.Width) + geom_point())
ggsave(p, filename=paste(i,".pdf",sep=""))
}
# I'm trying to get something like this using dplyr
library(dplyr)
iris %>%
group_by(Species) %>%
do({
p <- ggplot(., aes(x=Sepal.Length, y=Sepal.Width) + geom_point())
ggsave(p, filename=paste(quote(Species),".pdf",sep=""))
})
Well, you have a parenthesis problem and a file naming problem so maybe it's one of those that you are referring to. I'm assuming
iris %>%
group_by(Species) %>%
do({
p <- ggplot(., aes(x=Sepal.Length, y=Sepal.Width)) + geom_point()
ggsave(p, filename=paste0(unique(.$Species),".pdf"))
})
would fix your problem.

Resources