Shorthand functions for multiple geoms in ggplot2 - r

I would like to create shorthand notations or functions that combines multiple geoms for ggplot.
For example, instead of
mtcars %>%
ggplot(aes(x = cyl, y = mpg)) +
geom_point() +
geom_smooth(method = "lm") +
ggpubr::stat_cor()
I would like to be able to create a function to combine the geoms like so
lm_and_cor <- function() {
geom_smooth(method = "lm", se = FALSE) +
stat_cor()
}
mtcars %>%
ggplot(aes(x = cyl, y = mpg)) +
geom_point() +
lm_and_cor()
I am aware that I can create functions that does all of the plotting, basically
plot_data <- function(x) {
x %>%
ggplot(aes(x = cyl, y = mpg)) +
geom_point() +
geom_smooth(method = "lm") +
ggpubr::stat_cor()
}
which to be fair does what I want, to some degree. However, I would instead like to combine multiple geoms in a single function, as the underlying geom (e.g. point, lines, etc.) will not always be the same. Is this doable, and is it feasible?

With ggplot2 you can use list of elements:
lm_and_cor <- function()
list(geom_smooth(method = "lm", se = FALSE),
ggpubr::stat_cor()
)
mtcars %>%
ggplot(aes(x = cyl, y = mpg)) +
geom_point() +
lm_and_cor()
Output:

Do you mean something like this?
You can store multiple geom in a list object.
Edit: I misunderstand the question. This should meet the expectation.
data(iris)
library(ggplot2)
x <- list(geom_point(), geom_line())
ggplot(iris, aes(Sepal.Length, Sepal.Width)) + x
Or if you want to make a function to plot by column use this {{variable}}.
library(dplyr)
plotting <- function(data, x, y){
data %>%
ggplot(aes({{x}}, {{y}})) +
geom_point() +
geom_smooth(method = "lm")}
plotting(iris, Sepal.Length, Sepal.Width)

Related

lapply function to create many plots in Ggplot

I'm trying to plot the line graph for X=date Y=column which is XS1-XS10.
I use the lapply with a next function
plot_data_column = function (column) {
ggplot(data= excess_return, aes(y=column,x=date)) +
geom_line()+
geom_hline(yintercept = mean(excess_return$column), color="red")+
ggtitle(column)+
theme_minimal()
}
and then use lapply to plug in the columns of the dataset into the ggplot.
ggplots = lapply(excess_return[,1:10], plot_data_column)
My problem occurs with geom_hline which doesn't recognize the column and ggtitle(column).
P.s I have tried also like this
ggplots = lapply(colnames(excess_return[,1:10]), plot_data_column)
I wonder why R doesn't accept the XS1 as it were written manually by me?
because this code perfectly works.
ggplot(data= excess_return, aes(y=XS1,x=date)) +
geom_line()+
geom_hline(yintercept = mean(excess_return$XS1), color="red")+
theme_minimal()
The only thing what i want to is to iterate the XS1 to XS10.
Thank you for support
you can adapt this to your data strucutre:
plot_data_column = function (.data, .column) {
ggplot2::ggplot(data= .data, ggplot2::aes(y=!!dplyr::sym(.column),x = Petal.Width)) +
ggplot2::geom_line() +
ggplot2::geom_hline(yintercept = .data %>%
dplyr::pull(!!dplyr::sym(.column)) %>%
mean(),
color="red")+
ggplot2::ggtitle(.column) +
ggplot2::theme_minimal()
}
plots <- names(iris)[1:3] %>%
purrr::map(~plot_data_column(.data = iris, .column = .x))
You need to change the names(iris)[1:3] to your names names(excess_return)[1:10] and x = Petal.Width to x = date.
Another option:
library(tidyverse)
custom_ggplot_function <- function(var, var_name) {
ggplot(mtcars, aes(x = disp, y = var)) +
geom_line() +
geom_hline(yintercept = mean(var), color = "red") +
labs(y = var_name) +
ggtitle(var_name) +
theme_minimal()
}
mtcars %>%
select(mpg, cyl, disp) %>%
map2(.y = names(.), ~ custom_ggplot_function(.x, .y))

changing the facet_wrap labels using labeller in ggplot2

In my ggplot below, I'm trying to change the 10 facet labels of facet_wrap using labeller(sch.id=paste0("sch.id:", unique(ten$sch.id))).
However, the plot shows NA instead of the correct facet labels, I wonder what the fix is?
library(ggplot2)
hsb <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/hsb.csv')
ten <- subset(hsb, sch.id %in% unique(sch.id)[1:10])
p <- ten %>% ggplot() + aes(ses, math) + geom_point() +
facet_wrap(~sch.id) + geom_smooth(method = "lm", se = FALSE)
p + facet_wrap(~sch.id, labeller = labeller(sch.id=paste0("sch.id:", unique(ten$sch.id)))) ## HERE ##
The problem seems to be that you are passing a variable to the labeller function but facet_wrap already passes its own faceting variable. A conflict occurs and the result are NA's.
The solution is to create a labeller function as a function of a variable x (or any other name as long as it's not the faceting variables' names) and then coerce to labeller with as_labeller.
Note that there is no need for unique, just like there is no need for it in the facet_wrap formula.
p <- ten %>% ggplot() + aes(ses, math) + geom_point() +
geom_smooth(method = "lm", formula = y ~ x, se = FALSE)
cust_labeller <- function(x) paste0("sch.id:", x)
p + facet_wrap(~ sch.id,
labeller = as_labeller(cust_labeller)) ## HERE ##
I think the easiest way would be to change sch.id before plotting.
library(ggplot2)
ten$sch.id <- paste0("sch.id:", ten$sch.id)
ggplot(ten) + aes(ses, math) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
facet_wrap(~sch.id)
If you don't want to modify your data and want to use the labeller argument you can create a named vector and use it in labeller.
cust_label <- setNames(paste0("sch.id:", unique(ten$sch.id)), unique(ten$sch.id))
ggplot(ten) + aes(ses, math) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
facet_wrap(~sch.id, labeller = as_labeller(cust_label))

Add titles to ggplots created with map()

What's the easiest way to add titles to each ggplot that I've created below using the map function? I want the titles to reflect the name of each data frame - i.e. 4, 6, 8 (cylinders).
Thanks :)
mtcars_split <-
mtcars %>%
split(mtcars$cyl)
plots <-
mtcars_split %>%
map(~ ggplot(data=.,mapping = aes(y=mpg,x=wt)) +
geom_jitter()
# + ggtitle(....))
plots
Use map2 with names.
plots <- map2(
mtcars_split,
names(mtcars_split),
~ggplot(data = .x, mapping = aes(y = mpg, x = wt)) +
geom_jitter() +
ggtitle(.y)
)
Edit: alistaire pointed out this is the same as imap
plots <- imap(
mtcars_split,
~ggplot(data = .x, mapping = aes(y = mpg, x = wt)) +
geom_jitter() +
ggtitle(.y)
)
Perhaps you'd be interested in using facet_wrap instead
ggplot(mtcars, aes(y=mpg, x=wt)) + geom_jitter() + facet_wrap(~cyl)
You can use purrr::map2():
mtcars_split <- mtcars %>% split(mtcars$cyl)
plots <- map2(mtcars_split, titles,
~ ggplot(data=.x, aes(mpg,wt)) + geom_jitter() + ggtitle(.y)
)
EDIT
Sorry duplicated with Paul's answer.

ggplot using purrr map() to plot same x with multiple y's

I want to create multiple plots that have the same x but different y's using purrr package methodology. That is, I would like to use the map() or walk() functions to perform this.
Using mtcars dataset for simplicity.
ggplot(data = mtcars, aes(x = hp, y = mpg)) + geom_point()
ggplot(data = mtcars, aes(x = hp, y = cyl)) + geom_point()
ggplot(data = mtcars, aes(x = hp, y = disp)) + geom_point()
edit
So far I have tried
y <- list("mpg", "cyl", "disp")
mtcars %>% map(y, ggplot(., aes(hp, y)) + geom_point()
This is one possibility
ys <- c("mpg","cyl","disp")
ys %>% map(function(y)
ggplot(mtcars, aes(hp)) + geom_point(aes_string(y=y)))
It's just like any other map function, you just need to configure your aesthetics properly in the function.
I've made a bit more general function for this, because it's part of EDA protocol (Zuur et al., 2010). This article from Ariel Muldoon helped me.
plotlist <- function(data, resp, efflist) {
require(ggplot2)
require(purrr)
y <- enquo(resp)
map(efflist, function(x)
ggplot(data, aes(!!sym(x), !!y)) +
geom_point(alpha = 0.25, color = "darkgreen") +
ylab(NULL)
)
}
where:
data is your dataframe
resp is response variable
efflist is a char of effects (independent variables)
Of course, you may change the geom and/or aesthetics as it needs. The function returns a list of plots which you can pass to e.g. cowplot or gridExtra as in example:
library(gridExtra)
library(dplyr) # just for pipes
plotlist(mtcars, hp, c("mpg","cyl","disp")) %>%
grid.arrange(grobs = ., left = "HP")

More compact use of ggplot : grid spaghetti plot

The following code plot the predicted probability of several models against time. Having, all the plots on one graph was not readable so I divided the result in a grid.
I was wondering if it was possible to have only one ggplot with all the models then somehow specify which goes where with grid.arrange
Current :
p2.dat1 <- select(ppf, EXPOSURE, predp.glm.gen,predp.glm1, predp.glm2,predp.glm3,predp.glm4 )
mdf1 <- melt(p2.dat1 , id.vars="EXPOSURE")
plm.plot.all1 <- ggplot(data = mdf1,
aes(x = EXPOSURE, y = value, colour = variable)) +
geom_line()
p2.dat2 <- select(ppf, EXPOSURE, predp.glm.gen, predp.glm5,predp.glm.step )
mdf2 <- melt(p2.dat2 , id.vars="EXPOSURE")
plm.plot.all2 <- ggplot(data = mdf2,
aes(x = EXPOSURE, y = value, colour = variable)) +
geom_line()
grid.arrange(plm.plot.all1, plm.plot.all2, nrow=2)
Expected:
p2.dat <- select(ppf, EXPOSURE, predp.glm.gen,predp.glm1, predp.glm2,predp.glm3,predp.glm4,predp.glm5,predp.glm.step)
mdf <- melt(p2.dat , id.vars="EXPOSURE")
plm.plot.all <- ggplot(data = mdf1,
aes(x = EXPOSURE, y = value, colour = variable)) +
geom_line()
grid.arrange(plm.plot.all[some_selection_somehow], plm.plot.all[same], nrow=2)
Thanks,
You can do this with grid.arrange by writing some helper functions. It can be done more succinctly, but I prefer small focused functions that can be used with pipes.
library(tidyverse)
library(gridExtra)
# Helper Functions ----
plot_function <- function(x) {
ggplot(x, aes(x = EXPOSURE, y = value, colour = variable)) +
geom_line() +
labs(title = unique(x$variable)) +
theme(legend.position = "none")
}
grid_plot <- function(x, selection) {
order <- c(names(x)[grepl(selection,names(x))], names(x)[!grepl(selection,names(x))])
grid.arrange(grobs = x[order], nrow = 2)
}
# Actually make the plot ----
ppf %>%
select(EXPOSURE, predp.glm.gen,predp.glm1, predp.glm2,predp.glm3,predp.glm4,predp.glm5,predp.glm.step) %>%
gather(variable, value, -EXPOSURE) %>%
split(.$variable) %>%
map(plot_function) %>%
grid_plot("predp.glm3")
or you could do this with ggplot, a facet_wrap and factoring the variable column to the proper order. This has the benefits of shared axes across the plots, which facilitates easy comparison. You can alter the helper functions in the first approach to set the axes explicitly to achieve the same effect, but its just easier keeping it in ggplot.
library(tidyverse)
selection <- "predp.glm3"
plot_data <- ppf %>%
select(EXPOSURE, predp.glm.gen,predp.glm1, predp.glm2,predp.glm3,predp.glm4,predp.glm5,predp.glm.step) %>%
gather(variable, value, -EXPOSURE) %>%
mutate(variable = fct_relevel(variable, c(selection, levels(variable)[-grepl(selection, levels(variable))])))
ggplot(plot_data, aes(x = EXPOSURE, y = value, colour = variable)) +
geom_line() +
facet_wrap( ~variable, nrow = 2) +
theme(legend.position = "none")

Resources