I am trying to use superscript in geom_text. But I am unable to do that. I am using the following code
library(caret)
library(tidyverse)
summ <- iris %>%
group_by(Species) %>%
summarise(R = cor(Sepal.Length, Petal.Length, use="pairwise.complete.obs"),
RMSE = RMSE(Sepal.Length, Petal.Length)) %>%
mutate_if(is.numeric, round, digits=2)
p <- ggplot(data=iris, aes(x = Sepal.Length, y = Petal.Length)) +
geom_point(color="blue",alpha = 1/3) +
facet_wrap(Species ~ ., scales="free") +
geom_smooth(method=lm, fill="black", formula = y ~ x) +
xlab("Sepal Length") +
ylab("Petal Length") + theme_bw() +
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())
# Here we create our annotations data frame.
df.annotations <- data.frame()
# R
df.annotations <- rbind(df.annotations,
cbind(as.character(summ$Species),
paste("R", summ$R,
sep = " = ")))
# RMSE
df.annotations <- rbind(df.annotations,
cbind(as.character(summ$Species),
paste("RMSE", summ$RMSE,
sep = " = ")))
# This here is important, especially naming the first column
# Species
colnames(df.annotations) <- c("Species", "label")
vertical_adjustment = ifelse(grepl("\\bR\\b",df.annotations$label), 1.5, 3)
p + geom_text(data = df.annotations, aes(x=-Inf, y=+Inf, label=label),
hjust = -0.1, vjust = vertical_adjustment, size=3.5)
My expected output is
How can I add the unit for RMSE after the value and superscript 2 after R i.e. R^2? You can also see that there is a slight shift in the alignment of RMSE with respect to R. How can I make them into the same line?
This could be achieved like so:
Set parse=TRUE in geom_text
Make use of ?plotmath to add superscripts to your labels
# Here we create our annotations data frame.
df.annotations <- data.frame(
Species = rep(summ$Species, 2),
label = c(
paste0("~R^{2} == ", summ$R),
paste0("~RMSE == ", summ$RMSE, "~m^{3} ~m^{-3}")
)
)
vertical_adjustment = ifelse(grepl("\\bR\\b", df.annotations$label), 1.5, 3)
p + geom_text(data = df.annotations, aes(x=-Inf, y=+Inf, label=label),
hjust = 0, vjust = vertical_adjustment, size=3.5, parse = TRUE)
Another approach is to use the ggtext package, which enables markdown formatting in ggplot text objects. I find this syntax much easier to use than R's plotmath, especially for things like italics and color:
df.annotations <- data.frame(
Species = rep(summ$Species, 2),
label = c(
paste0("R<sup>2</sup> = ", summ$R),
paste0("RMSE = ", summ$RMSE, "m<sup>3</sup> m<sup>-3</sup>")
)
)
vertical_adjustment = ifelse(grepl("\\bR\\b", df.annotations$label), 1.5, 2.5)
p + geom_richtext(data = df.annotations, aes(x=-Inf, y=+Inf, label=label),
hjust = 0, vjust = vertical_adjustment, size=3.5, label.size = 0)
I want to annotate some text on last facet of the plot with the following code:
library(ggplot2)
p <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
p <- p + facet_grid(. ~ cyl)
p <- p + annotate("text", label = "Test", size = 4, x = 15, y = 5)
print(p)
But this code annotates the text on every facet. How can I get the annotated text on only one facet?
Function annotate() adds the same label to all panels in a plot with facets. If the intention is to add different annotations to each panel, or annotations to only some panels, a geometry has to be used instead of annotate(). To use a geometry, such as geom_text() we need to assemble a data frame containing the text of the labels in one column and columns for the variables to be mapped to other aesthetics, as well as the variable(s) used for faceting.
Typically you'd do something like this:
ann_text <- data.frame(mpg = 15,wt = 5,lab = "Text",
cyl = factor(8,levels = c("4","6","8")))
p + geom_text(data = ann_text,label = "Text")
It should work without specifying the factor variable completely, but will probably throw some warnings:
Function annotate() adds the same label to all panels in a plot with facets. If the intention is to add different annotations to each panel, or annotations to only some panels, a geometry has to be used instead of annotate(). To use a geometry, such as geom_text() we need to assemble a data frame containing the text of the labels in one column and columns for the variables to be mapped to other aesthetics, as well as the variable(s) used for faceting. This answer exemplifies this for both facet_wrap() and facet_grid().
Here's the plot without text annotations:
library(ggplot2)
p <- ggplot(mtcars, aes(mpg, wt)) +
geom_point() +
facet_grid(. ~ cyl) +
theme(panel.spacing = unit(1, "lines"))
p
Let's create an additional data frame to hold the text annotations:
dat_text <- data.frame(
label = c("4 cylinders", "6 cylinders", "8 cylinders"),
cyl = c(4, 6, 8)
)
p + geom_text(
data = dat_text,
mapping = aes(x = -Inf, y = -Inf, label = label),
hjust = -0.1,
vjust = -1
)
Alternatively, we can manually specify the position of each label:
dat_text <- data.frame(
label = c("4 cylinders", "6 cylinders", "8 cylinders"),
cyl = c(4, 6, 8),
x = c(20, 27.5, 25),
y = c(4, 4, 4.5)
)
p + geom_text(
data = dat_text,
mapping = aes(x = x, y = y, label = label)
)
We can also label plots across two facets:
dat_text <- data.frame(
cyl = c(4, 6, 8, 4, 6, 8),
am = c(0, 0, 0, 1, 1, 1)
)
dat_text$label <- sprintf(
"%s, %s cylinders",
ifelse(dat_text$am == 0, "automatic", "manual"),
dat_text$cyl
)
p +
facet_grid(am ~ cyl) +
geom_text(
size = 5,
data = dat_text,
mapping = aes(x = Inf, y = Inf, label = label),
hjust = 1.05,
vjust = 1.5
)
Notes:
You can use -Inf and Inf to position text at the edges of a panel.
You can use hjust and vjust to adjust the text justification.
The text label data frame dat_text should have a column that works with your facet_grid() or facet_wrap().
If anyone is looking for an easy way to label facets for reports or publications, the egg (CRAN) package has pretty nifty tag_facet() & tag_facet_outside() functions.
library(ggplot2)
p <- ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_grid(. ~ am) +
theme_bw(base_size = 12)
# install.packages('egg', dependencies = TRUE)
library(egg)
Tag inside
Default
tag_facet(p)
Note: if you want to keep the strip text and background, try adding strip.text and strip.background back in theme or remove theme(strip.text = element_blank(), strip.background = element_blank()) from the original tag_facet() function.
tag_facet <- function(p, open = "(", close = ")", tag_pool = letters, x = -Inf, y = Inf,
hjust = -0.5, vjust = 1.5, fontface = 2, family = "", ...) {
gb <- ggplot_build(p)
lay <- gb$layout$layout
tags <- cbind(lay, label = paste0(open, tag_pool[lay$PANEL], close), x = x, y = y)
p + geom_text(data = tags, aes_string(x = "x", y = "y", label = "label"), ..., hjust = hjust,
vjust = vjust, fontface = fontface, family = family, inherit.aes = FALSE)
}
Align top right & use Roman numerals
tag_facet(p, x = Inf, y = Inf,
hjust = 1.5,
tag_pool = as.roman(1:nlevels(factor(mtcars$am))))
Align bottom left & use capital letters
tag_facet(p,
x = -Inf, y = -Inf,
vjust = -1,
open = "", close = ")",
tag_pool = LETTERS)
Define your own tags
my_tag <- c("i) 4 cylinders", "ii) 6 cyls")
tag_facet(p,
x = -Inf, y = -Inf,
vjust = -1, hjust = -0.25,
open = "", close = "",
fontface = 4,
size = 5,
family = "serif",
tag_pool = my_tag)
Tag outside
p2 <- ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_grid(cyl ~ am, switch = 'y') +
theme_bw(base_size = 12) +
theme(strip.placement = 'outside')
tag_facet_outside(p2)
Edit: adding another alternative using the stickylabeller package
- `.n` numbers the facets numerically: `"1"`, `"2"`, `"3"`...
- `.l` numbers the facets using lowercase letters: `"a"`, `"b"`, `"c"`...
- `.L` numbers the facets using uppercase letters: `"A"`, `"B"`, `"C"`...
- `.r` numbers the facets using lowercase Roman numerals: `"i"`, `"ii"`, `"iii"`...
- `.R` numbers the facets using uppercase Roman numerals: `"I"`, `"II"`, `"III"`...
# devtools::install_github("rensa/stickylabeller")
library(stickylabeller)
ggplot(mtcars, aes(qsec, mpg)) +
geom_point() +
facet_wrap(. ~ am,
labeller = label_glue('({.l}) am = {am}')) +
theme_bw(base_size = 12)
Created by the reprex package (v0.2.1)
I think for the answer above lab="Text" is useless, the code below is also ok.
ann_text <- data.frame(mpg = 15,wt = 5,
cyl = factor(8,levels = c("4","6","8")))
p + geom_text(data = ann_text,label = "Text" )
However if you want to label differently in different sub-graphs, it will be ok in this way:
ann_text <- data.frame(mpg = c(14,15),wt = c(4,5),lab=c("text1","text2"),
cyl = factor(c(6,8),levels = c("4","6","8")))
p + geom_text(data = ann_text,aes(label =lab) )
Expanding slightly on joran's excellent answer, to clarify how the label dataframe works.
You can think of "mpg" and "wt" as the x and y coordinates, respectively (I find it easier to keep track of the original variable names than renaming them, as in Kamil's also-excellent answer). You need one row per label, and the "cyl" column shows which facet each row is associated with.
ann_text<-data.frame(mpg=c(25,15),wt=c(3,5),cyl=c(6,8),label=c("Label 1","Label 2"))
ann_text
> mpg wt cyl label
> 25 3 6 Label 1
> 15 5 8 Label 2
p <- ggplot(mtcars, aes(mpg, wt)) + geom_point()
p <- p + facet_grid(. ~ factor(cyl))
p + geom_text(data = ann_text,label=ann_text$label)
I did not know about the egg package,
so here is a plain ggplot2 package solution
library(tidyverse)
library(magrittr)
Data1=data.frame(A=runif(20, min = 0, max = 100), B=runif(20, min = 0, max = 250), C=runif(20, min = 0, max = 300))
Data2=data.frame(A=runif(20, min = -10, max = 50), B=runif(20, min = -5, max = 150), C=runif(20, min = 5, max = 200))
bind_cols(
Data1 %>% gather("Vars","Data_1"),
Data2 %>% gather("Vars","Data_2")
) %>% select(-Vars1) -> Data_combined
Data_combined %>%
group_by(Vars) %>%
summarise(r=cor(Data_1,Data_2),
r2=r^2,
p=(pt(abs(r),nrow(.)-2)-pt(-abs(r),nrow(.)-2))) %>%
mutate(rlabel=paste("r:",format(r,digits=3)),
plabel=paste("p:",format(p,digits=3))) ->
label_df
label_df %<>% mutate(x=60,y=190)
Data_combined %>%
ggplot(aes(x=Data_1,y=Data_2,color=Vars)) +
geom_point() +
geom_smooth(method="lm",se=FALSE) +
geom_text(data=label_df,aes(x=x,y=y,label=rlabel),inherit.aes = FALSE) +
geom_text(data=label_df,aes(x=x,y=y-10,label=plabel),inherit.aes = FALSE) +
facet_wrap(~ Vars)
Is there a way to flip the facet label using small_multiple from the dotwhisker package to have the facet labels on the left-handside and coefficient estimate on the right-hand side? I've seen the solutions to this when using ggplot and facet_wrap or facet_grid, but those aren't working with small_multiple since it does the faceting without those arguments. For simplicity, I'll be using the Dot-and-Whisker Plot Vignette that uses small_multiple as the example.
code used to generate plot:
# Generate a tidy data frame of regression results from six models
m <- list()
ordered_vars <- c("wt", "cyl", "disp", "hp", "gear", "am")
m[[1]] <- lm(mpg ~ wt, data = mtcars)
m123456_df <- m[[1]] %>%
tidy() %>%
by_2sd(mtcars) %>%
mutate(model = "Model 1")
for (i in 2:6) {
m[[i]] <- update(m[[i-1]], paste(". ~ . +", ordered_vars[i]))
m123456_df <- rbind(m123456_df, m[[i]] %>%
tidy() %>%
by_2sd(mtcars) %>%
mutate(model = paste("Model", i)))
}
# Relabel predictors (they will appear as facet labels)
m123456_df <- m123456_df %>%
relabel_predictors(c("(Intercept)" = "Intercept",
wt = "Weight",
cyl = "Cylinders",
disp = "Displacement",
hp = "Horsepower",
gear = "Gears",
am = "Manual"))
# Generate a 'small multiple' plot
small_multiple(m123456_df) +
theme_bw() + ylab("Coefficient Estimate") +
geom_hline(yintercept = 0, colour = "grey60", linetype = 2) +
ggtitle("Predicting Mileage") +
theme(plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1))
Ideally, I would have the flipped version of this plot with labels on the left and estimates on the right.
This could be achieved by overwriting facet_grid and the scale_y as you would do in a normal ggplot like so:
facet_grid(term~., switch = "y", scales="free_y")
scale_y_continuous(position = "right")
library(dotwhisker)
library(dplyr)
library(broom)
# Generate a 'small multiple' plot
small_multiple(m123456_df) +
theme_bw() + ylab("Coefficient Estimate") +
geom_hline(yintercept = 0, colour = "grey60", linetype = 2) +
facet_grid(term~., switch = "y", scales="free_y") +
scale_y_continuous(position = "right") +
ggtitle("Predicting Mileage") +
theme(plot.title = element_text(face = "bold"),
legend.position = "none",
axis.text.x = element_text(angle = 60, hjust = 1))
I need to do plot a lot of variables against each other. In each of these plots I would like to automatically place information from a linear regression model in the upper left corner of the graph.
Taking the mtcars dataset for an example, I would like a piece of code I could use that would give me the the R2 and p-value from a linear regression model in the top left corner of the graph no matter what variables I plotted against each other. I have made a solution, where I plot R2 and P in the title, but since I need another title it's not optimal.
ggplotRegression <- function (fit) {
require(ggplot2)
ggplot(fit$model, aes_string(x = names(fit$model)[2], y = names(fit$model)[1])) +
geom_point() +
stat_smooth(method = "lm", col = "red") +
labs(title = paste("Adj R2 = ",signif(summary(fit)$adj.r.squared, 1),
" P =",signif(summary(fit)$coef[2,4], 1)))
}
disp_vs_wt_cyl4 <- mtcars %>%
filter(cyl=="4")
ggplotRegression(lm(disp ~ wt, data = disp_vs_wt_cyl4)) +
geom_point(size = 3.74, colour = "#0c4c8a") +
theme_bw()
You could use annotation_custom in your plot, which would allow you to have a separate title. In this example, we allow a title to be passed to your function:
ggplotRegression <- function (fit, title) {
require(ggplot2)
lab <- grid::textGrob(label = paste0(
as.character(as.expression(fit$call$formula)), "\n",
"Adj R\u00b2 = ",
signif(summary(fit)$adj.r.squared, 1),
", p = ", signif(summary(fit)$coef[2,4], 1)),
x = unit(0.05, "npc"),
y = unit(0.9, "npc"), just = "left",
gp = grid::gpar(size = 14, fontface = "bold"))
ggplot(fit$model, aes_string(x = names(fit$model)[2],
y = names(fit$model)[1])) +
ggtitle(title) +
geom_point() +
stat_smooth(method = "lm", col = "red") +
annotation_custom(lab)
}
So we can do:
disp_vs_wt_cyl4 <- mtcars %>% filter(cyl=="4")
ggplotRegression(lm(disp ~ wt, data = disp_vs_wt_cyl4), "My Title") +
geom_point(size = 3.74, colour = "#0c4c8a") +
theme_bw()
I am trying to use facet_wrap to plot indvidual plots.
library(lme4)
library(dplyr)
library(tibble)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
ggplot(df_sleep) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))
What I want to do is to only visualise selected Subject using facet_wrap? At the moment,
it is plotting plots of all the Subject. How do I plot only for say subject 308`` and352`?
Thanks
You just want to filter your data before plotting
library(lme4)
library(dplyr)
library(tibble)
library(ggplot2)
# Convert to tibble for better printing. Convert factors to strings
sleepstudy <- sleepstudy %>%
as_tibble() %>%
mutate(Subject = as.character(Subject))
xlab <- "Days of sleep deprivation"
ylab <- "Average reaction time (ms)"
sleepstudy %>%
filter(Subject %in% c("308", "352")) %>%
ggplot(.) +
aes(x = Days, y = Reaction) +
stat_smooth(method = "lm", se = FALSE) +
# Put the points on top of lines
geom_point() +
facet_wrap("Subject") +
labs(x = xlab, y = ylab) +
theme(axis.text=element_text(size=0.02),
axis.title=element_text(size=0.02,face="bold"),
plot.title = element_text(size=0.02)) +
theme(strip.text.x = element_text(size = 8),
strip.background = element_rect(fill="lightblue", colour="black",size=0.2)) +
theme(strip.text.x = element_text(margin = margin(0.02, 0, 0.02, 0, "cm")))