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

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)

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

ggplot show the value rounded to one decimal place above the bar chart

I want to round the values above the bar chart to one decimal place. For example 14 should be 1.5 and not 1.52977.
This is how the bar chart looks right now
This is my code:
CPUE1 <- CPUE
CPUE1$Strecke <- factor (CPUE1$Strecke, levels = c('30/31', '14', '12', '10','1c','1bc', '1b'))
ggplot(CPUE1, aes(x= Strecke, y= CPUE, fill = Strecke ))+
geom_bar(stat='identity', position = 'dodge')+
theme_minimal()+
geom_text (aes (label = CPUE), position=position_dodge(width=0.9), vjust=-0.25)+
scale_fill_manual (values =
c("12" = "green", "10"= "green",
"1c" = "green", "14"= "red",
"1b"= "red","1bc"= "red","30/31" = "red"))
Add round to your geom_text:
library(tidyverse)
tribble(
~Strecke, ~CPUE,
"1b", 1.333,
"1c", 1.222,
"1b", 2.666,
"1c", 2.777
) |>
mutate(Strecke = factor(Strecke)) |>
ggplot(aes(Strecke, CPUE, fill = Strecke)) +
geom_bar(stat = "identity", position = "dodge") +
theme_minimal() +
geom_text(aes(label = round(CPUE, 1)), position = position_dodge(width = 0.9), vjust = -0.25) +
scale_fill_manual(values = c("1b" = "red", "1c" = "blue"))
Created on 2022-07-07 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)

Colors strips settings in faced-wrap ggplot

To a 3 year old post
ggplot2: facet_wrap strip color based on variable in data set
Baptiste has given the following solution:
d <- data.frame(fruit = rep(c("apple", "orange", "plum", "banana", "pear", "grape")),
farm = rep(c(0,1,3,6,9,12), each=6),
weight = rnorm(36, 10000, 2500),
size=rep(c("small", "large")))
p1 = ggplot(data = d, aes(x = farm, y = weight)) +
geom_jitter(position = position_jitter(width = 0.3),
aes(color = factor(farm)), size = 2.5, alpha = 1) +
facet_wrap(~fruit)
dummy <- ggplot(data = d, aes(x = farm, y = weight))+ facet_wrap(~fruit) +
geom_rect(aes(fill=size), xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
theme_minimal()
library(gtable)
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(dummy)
gtable_select <- function (x, ...)
{
matches <- c(...)
x$layout <- x$layout[matches, , drop = FALSE]
x$grobs <- x$grobs[matches]
x
}
panels <- grepl(pattern="panel", g2$layout$name)
strips <- grepl(pattern="strip-t", g2$layout$name)
g2$layout$t[panels] <- g2$layout$t[panels] - 1
g2$layout$b[panels] <- g2$layout$b[panels] - 1
new_strips <- gtable_select(g2, panels | strips)
library(grid)
grid.newpage()
grid.draw(new_strips)
gtable_stack <- function(g1, g2){
g1$grobs <- c(g1$grobs, g2$grobs)
g1$layout <- transform(g1$layout, z= z-max(z), name="g2")
g1$layout <- rbind(g1$layout, g2$layout)
g1
}
## ideally you'd remove the old strips, for now they're just covered
new_plot <- gtable_stack(g1, new_strips)
grid.newpage()
grid.draw(new_plot)
(I have just updated the "strip-t" pattern and opened the grid library as it was suggested in the old post)
I repost this because it's an old brillant stuff and I want to use it myself for a presentation.
I'm a beginner in ggplot and this could also help me for various scripts.
Here are my questions :
- How is it possible to choose the color and not to give the same blue and red please? In my script, I have 3 colors to set, and I hope it can be less agressive. Is it possible to do it ?
- Another question, is it possible to integrate this in the legend, i.e to know what are this colors refering ?
Many thanks
you can change the strip colours with the fill scale in the dummy plot. Combining the legends is a bit tricky, but here's a starting point.
library(ggplot2)
library(gtable)
library(gridExtra)
library(grid)
gtable_stack <- function(g1, g2){
g1$grobs <- c(g1$grobs, g2$grobs)
g1$layout <- transform(g1$layout, z= z-max(z), name="g2")
g1$layout <- rbind(g1$layout, g2$layout)
g1
}
gtable_select <- function (x, ...)
{
matches <- c(...)
x$layout <- x$layout[matches, , drop = FALSE]
x$grobs <- x$grobs[matches]
x
}
d <- data.frame(fruit = rep(c("apple", "orange", "plum", "banana", "pear", "grape")),
farm = rep(c(0,1,3,6,9,12), each=6),
weight = rnorm(36, 10000, 2500),
size=rep(c("small", "large")))
p1 = ggplot(data = d, aes(x = farm, y = weight)) +
geom_jitter(position = position_jitter(width = 0.3),
aes(color = factor(farm)), size = 2.5, alpha = 1) +
facet_wrap(~fruit)
dummy <- ggplot(data = d, aes(x = farm, y = weight))+ facet_wrap(~fruit) +
geom_rect(aes(fill=size), xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
theme_minimal() + scale_fill_brewer(palette = "Pastel2")
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(dummy)
# extract legends
leg <- g1$grobs[[grep("guide-box", g1$layout$name)]]
dummy_leg <- g2$grobs[[grep("guide-box", g2$layout$name)]]
combined_leg <- rbind.gtable(leg, dummy_leg)
g1$grobs[[grep("guide-box", g1$layout$name)]] <- combined_leg
# move dummy panels one cell up
panels <- grepl(pattern="panel", g2$layout$name)
strips <- grepl(pattern="strip-t", g2$layout$name)
g2$layout$t[panels] <- g2$layout$t[panels] - 1
g2$layout$b[panels] <- g2$layout$b[panels] - 1
new_strips <- gtable_select(g2, panels | strips)
# stack new strips on top of gtable
# ideally you'd remove the old strips, for now they're just covered
new_plot <- gtable_stack(g1, new_strips)
grid.newpage()
grid.draw(new_plot)