How do I get subscript in ggplot2 facet grid labels when I have two faceting variables? - ggplot2

I am trying to change one of the labels in my facet grid to contain some subscript text. I have been looking on stack overflow but none of the solutions work/I cannot understand how others are functioning so cannot apply them to my own scenario
This is my current ggplot function:
FacetGridTest <- tss_profiles %>% group_by(pulldown, Condition, replicate, category) %>%
group_by(pulldown,Condition,category,region_bin, region) %>%
mutate(meannone = mean(none)) %>%
ungroup() %>%
mutate(cond_cat=factor(cond_cat, levels=c("IG Target","IG Non-Target","MH Target","PH Target","MH Non-Target","PH Non-Target"))) %>%
mutate(category=factor(category, levels=c("Target","Non-Target"))) %>%
ggplot() + aes(x=Bin, y=meannone, col=Condition, group=paste(pulldown, Condition, replicate, category)) +
geom_line() +
facet_grid(pulldown~category, scale="free_x") +
theme_bw(base_size = 10) +
theme(legend.text.align = 0) +
labs(y=expression(paste("Read Counts")),
x=expression(paste("Bin"))) +
scale_colour_discrete(name = "Condition", labels = c("A","B","C")) +
geom_vline(xintercept=6000, linetype="dotted") +
annotate("text", x = 1000, y = 8800, label = "TSS", size=3) +
annotate("text", x = 11000, y = 8800, label = "TTS", size=3)
I want to change the "Non-Target" label to "J2L2 Non-Target20+"
Based on what I have seen on stack overflow I have tried doing:
vnames <- list('Target' = 'Target',
'Non-Target' = expression(paste("J" ["2"], "L" ["2"], " Non-Target" ["20"], "+")))
bnames <- list('A' = 'A','B' = 'B')
plot_labeller <- function(variable,value){
if (variable=='category') {
return(vnames[value])
} else if (variable=='pulldown') {
return(bnames[value])
} else {
return(as.character(value))
}
}
tss_profiles %>% group_by(pulldown, Condition, replicate, category) %>%
group_by(pulldown,Condition,category,region_bin, region) %>%
mutate(meannone = mean(none)) %>%
ungroup() %>%
mutate(cond_cat=factor(cond_cat, levels=c("IG Target","IG Non-Target","MH Target","PH Target","MH Non-Target","PH Non-Target"))) %>%
mutate(category=factor(category, levels=c("Target","Non-Target"))) %>%
ggplot() + aes(x=Bin, y=meannone, col=Condition, group=paste(pulldown, Condition, replicate, category)) +
geom_line() +
facet_grid(pulldown~category, scale="free_x", plot_labeller) +
theme_bw(base_size = 10) +
theme(legend.text.align = 0) +
labs(y=expression(paste("Read Counts")),
x=expression(paste("Bin"))) +
scale_colour_discrete(name = "Condition", labels = c("A","B","C")) +
geom_vline(xintercept=6000, linetype="dotted") +
annotate("text", x = 1000, y = 8800, label = "TSS", size=3) +
annotate("text", x = 11000, y = 8800, label = "TTS", size=3)
But this has not worked. I am probably misunderstanding how labellers work. Any help would be much appreciated.

I tried to run both codes but got error that object 'tss_profiles' not found.
Therefore I can just hypothesise that you should remove quotes from the subscript text ([20] instead of what you have - ["20"]).

Related

Expand margins of ggplot

Apologies for the simplistic question, but I'm having trouble adjusting the size (width) of this plot to include all the data so that it doesn't look so squished. I've tried adjusting the margins and the width in png(), but nothing seems to work.
png("file_name.png", units = "in", width = 10, height = 5, res = 300)
ggplot(pred, aes(x = Longitude, y = Latitude)) +
geom_raster(aes(fill = Fitted)) +
facet_wrap(~ CYR) +
scale_fill_viridis(option = 'plasma',
na.value = 'transparent') +
coord_quickmap() +
theme(legend.position = 'top')
# theme(plot.margin=grid::unit(c(0,20,0,20), "mm"))
dev.off()
Do you need to use coord_quickmap() for some reason? Removing it 'fixes' the plot dimensions, e.g. using the palmerpenguins dataset:
library(ggplot2)
library(palmerpenguins)
p1 <- ggplot(penguins, aes(x = sex,
y = bill_length_mm,
fill = bill_depth_mm)) +
geom_raster() +
scale_fill_viridis_c(option = 'plasma',
na.value = 'transparent') +
facet_wrap(~interaction(island, species, year)) +
theme(legend.position = 'top') +
coord_quickmap()
p1
#> Warning: Raster pixels are placed at uneven horizontal intervals and will be shifted
#> ℹ Consider using `geom_tile()` instead.
#> Warning: Removed 2 rows containing missing values (`geom_raster()`).
p2 <- ggplot(penguins, aes(x = sex,
y = bill_length_mm,
fill = bill_depth_mm)) +
geom_raster() +
scale_fill_viridis_c(option = 'plasma',
na.value = 'transparent') +
facet_wrap(~interaction(island, species, year)) +
theme(legend.position = 'top') #+
# coord_quickmap()
p2
#> Warning: Raster pixels are placed at uneven horizontal intervals and will be shifted
#> ℹ Consider using `geom_tile()` instead.
#> Removed 2 rows containing missing values (`geom_raster()`).
Created on 2023-02-13 with reprex v2.0.2

Arrange the plots nicely on R markdown pdf

I am a newbie at R markdown and am trying to create a pdf with multiple plots.
This should hopefully be an easy fix for a more experienced user.
I am trying to create a nice pdf with multiple plots over 2/3 pages of a pdf.
I have been stuck on this a while and have looked at various older questions/answer on this site. I am trying to use the patchwork package using the example here:
When I render this to a pdf using R markdown, it only seems to plot on half the page like so:
I have tried playing around with fig.height, out.height="100%", and classoption in the yaml:
---
title: "QC Metrics Report.v1"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
pdf_document: default
html_document:
df_print: paged
geometry: margin=1.5cm
classoption: a4paper, bottom=15mm
---
(my code)
```{r, echo=FALSE, message=FALSE, eval=TRUE}
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p4 <- ggplot(mtcars) +
geom_bar(aes(gear)) +
facet_wrap(~cyl) +
ggtitle('Plot 4')
p1 + p2 + p3 + p4
```
If I try with the plot_layout function e.g.
p1 + p2 + p3 + p4
plot_layout(ncol = 2)
half the page is a printout of text (which I don't want)
Please help!
If the case you are running into is overlapping text when you are arranging the plots then plot_spacer and tweaks to some theme options might do the trick.
---
title: "My Report"
subtitle: "Report.v1"
author: "John Doe"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
pdf_document: default
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE, fig.align =
"center")
library(tidyverse)
library(patchwork)
library(gapminder)
library(scales)
library(gridExtra)
my_countries <- c("Zambia", "Malawi", "Mozambique", "Tanzania", "Kenya")
east_africa <- gapminder %>%
filter(country %in% my_countries) %>%
mutate(country = fct_reorder2(country, year, lifeExp)) # reorder for plotting
bar <- east_africa %>%
filter(year == max(year)) %>% # most recent year only
ggplot(aes(x = country, y = lifeExp, fill = country)) +
geom_col(width = 0.75, alpha = 0.9) +
geom_text(
aes(label = number(lifeExp, 0.1)),
position = position_stack(vjust = 0.5),
color = "white",
fontface = "bold",
size = 5
) +
scale_fill_brewer(palette = "Dark2") +
scale_y_continuous(expand = expand_scale(0.01, 0.05)) + # remove extra space between bars and x-axis labels
labs(y = "Life Expectancy (years)") +
theme_minimal(base_size = 16) +
theme(
legend.position = "none",
axis.title.x = element_blank(),
axis.title.y = element_text(size = 10),
axis.text.x = element_text(size = 7, angle = 45),
axis.title.y.left = element_text(margin = margin(r = 10)),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank()
)
#> Warning: `expand_scale()` is deprecated; use `expansion()` instead.
line <- east_africa %>%
ggplot(aes(x = year, y = lifeExp, color = country)) +
geom_line(lwd = 1.25, key_glyph = "timeseries") + # for those cute glyphs in the legend
scale_color_brewer(palette = "Dark2") +
labs(y = "Life Expectancy (years)") +
theme_minimal(base_size = 16) +
theme(
legend.position = "bottom",
legend.title = element_blank(),
axis.title.x = element_blank(),
axis.text.x = element_text(size = 7),
axis.title.y = element_text(size = 10),
axis.title.y.left = element_text(margin = margin(r = 10)),
panel.grid.minor = element_blank(),
plot.margin = margin(t = 30)
)
tab <- east_africa %>%
filter(year == max(year)) %>%
transmute(
Country = country,
Population = comma(pop),
`GDP per capita` = dollar(gdpPercap, 1),
`Life Expectancy` = number(lifeExp, 0.1),
) %>%
arrange(Country) %>%
tableGrob(theme = ttheme_minimal(base_size = 10), rows = NULL)
layout <- bar + plot_spacer() + tab + plot_spacer() + line + plot_spacer()
layout +
plot_annotation(
title = "Life Expectancy of Selected Countries\n in East Africa",
caption = "Source: gapminder: Data from Gapminder
github.com/jennybc/gapminder
gapminder.org/data/",
theme = theme(plot.title = element_text(size = 16, hjust = 0.5, face = "bold"))
)
Created on 2022-10-30 with reprex v2.0.2
updated
If the case you are running into is that you have lots of code stuff in your actual pdf then use results = 'hide'
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
ggtitle('Plot 1')
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
ggtitle('Plot 2')
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p4 <- ggplot(mtcars) +
geom_bar(aes(gear)) +
facet_wrap(~cyl) +
ggtitle('Plot 4')
p1 + p2 + p3 + p4

In ggplot2/stat_summary, how to add the `median` value as label to plot (as geom_text())

In ggplot2/stat_summary, how to add the median value as label to plot ? Thanks!
library(ggplot2)
d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point()
d + stat_summary(fun = "median", colour = "red", size = 2, geom = "point")
One potential option is to use after_stat() to get the labels, i.e.
library(ggplot2)
d <- ggplot(mtcars, aes(cyl, mpg)) +
geom_point()
d + stat_summary(fun = "median", colour = "red", size = 4,
geom = "text", aes(label = after_stat(y)),
position = position_nudge(x = 0.25))
Created on 2022-05-16 by the reprex package (v2.0.1)

How to include a legend to a ggplot2?

Given this data here:
p <- ggplot(mpg, aes(displ, cty)) + geom_point() + facet_grid(drv ~ cyl)
g <- ggplot_gtable(ggplot_build(p))
strip_both <- which(grepl('strip-', g$layout$name))
fills <- c("red","green","blue","yellow","red","green","blue","yellow")
k <- 1
for (i in strip_both) {
j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
k <- k+1
}
grid.draw(g)
I want to add a legend for the colors of the facets:
as shown here
One option to achieve your desired result would be with an auxiliary geom_point layer which draws nothing but is only used to map a variable with your desired four categories on the fill aes. Doing so will automatically add a fill legend for which we could set your desired colors using scale_fill_manual. Additionally I switched the key_glyph for the point layer to draw_key_rectto mimic your desired style for the legend keys and added na.rm to silent the warning about removed NAs:
library(ggplot2)
library(grid)
p <- ggplot(mpg, aes(displ, cty)) + geom_point() + facet_grid(drv ~ cyl) +
geom_point(data = data.frame(x = NA_real_, y = NA_real_, fill = c("AB", "D", "FF", "v")),
aes(x = x, y = y, fill = fill), na.rm = TRUE, key_glyph = "rect") +
scale_fill_manual(values = c("AB" = "red", D = "yellow", FF = "blue", v = "green"), name = NULL) +
theme(legend.position = "bottom")
g <- ggplot_gtable(ggplot_build(p))
strip_both <- which(grepl('strip-', g$layout$name))
fills <- c("red","green","blue","yellow","red","green","blue","yellow")
k <- 1
for (i in strip_both) {
j <- which(grepl('rect', g$grobs[[i]]$grobs[[1]]$childrenOrder))
g$grobs[[i]]$grobs[[1]]$children[[j]]$gp$fill <- fills[k]
k <- k+1
}
grid.draw(g)

Background Color of grid.arrange in gridExtra

So I am trying to draw a few ggplots and their legend using gridExtra. The legend appears in the last cell on a white background - I would like to change the background color there, so that white background disappears. How can I do that?
Here's my code:
library(reshape)
library(ggplot2)
library(plyr)
library(wq)
library(gridExtra)
library(lattice)
library(grid)
testVisualization <- function()
{
set.seed(123)
xx <- sample(seq(from = 20, to = 50, by = 5), size = 50, replace = TRUE)
yy <- sample(seq(from = 1, to = 50), size = 50, replace = TRUE)
zz <- sample(seq(from = 1, to = 10, by = 1), size = 50, replace = TRUE)
dd <- data.frame(xx,yy,zz)
colRainbow <- rainbow(n, s = 1, v = 1, start = 0, end = max(1, n - 1)/n, alpha = 1)
gg <- ggplot() + geom_point(data=dd, aes(x=xx, y=yy, colour=zz))+
theme_custom()
lay2 <- rbind(c(1,1,1,1,1),
c(2,2,3,3,4))
legg1 <- g_legend(gg)
grid.arrange(
gg+guides(fill=FALSE, colour=FALSE, size=FALSE),
gg+guides(fill=FALSE, colour=FALSE, size=FALSE),
gg+guides(fill=FALSE, colour=FALSE, size=FALSE),
legg1,
layout_matrix=lay2)
}
theme_custom <- function()
{
theme(
plot.background = element_rect(fill = "#002B36", colour = "#002B36"),
panel.background = element_rect(fill = "#002B36"),
panel.background = element_rect(fill = "#002B36"),
legend.background = element_rect(fill="#002B36", colour = "#002B36"),
legend.margin = unit(c(-4, -4), "cm"),
legend.key = element_rect(fill="#002B36", colour ="#002B36"),
legend.text =element_text(colour = "#DCD427"),
legend.title=element_text(colour = "#DCD427")
)
}
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
#+ legend.margin = unit(-0.5, "cm")
legend
}
Try this,
g_legend<-function(gg){
tmp <- ggplot_gtable(ggplot_build(gg))
id <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
leg <- tmp$grobs[[id]]
bkg <- leg[["grobs"]][[1]][["grobs"]][leg[["grobs"]][[1]][["layout"]][,"name"]=="background"][[1]][["gp"]][["fill"]]
leg <- gtable_add_grob(leg, grobs = rectGrob(gp=gpar(fill=bkg, col="red", lty=2)),
t=1, l=1, b=nrow(leg), r=ncol(leg), z=-1)
# no idea why, but the legend seems to have weird negative sizes
# that make the background overlap with neighbouring elements
# workaround: set those unidentified sizes to 1null
leg$widths[c(1,2,4,5)] <- unit(rep(1,4),"null")
leg$heights[c(1,2,4,5)] <- unit(rep(1,4),"null")
leg
}