Related
I try to replicate the fertility graph from gapminder as good as I can in ggplot:
I have:
fertility <- read.csv("https://raw.githubusercontent.com/MarcoKuehne/marcokuehne.github.io/main/data/Gapminder/tfr-by-gapminder-v12-20171212.csv", sep = ";")
# manipulate
library(tidyverse)
fertility <- fertility %>%
select(!c(geo.name, geo, indicator)) %>%
rownames_to_column %>%
gather(var, value, -rowname) %>%
spread(rowname, value) %>%
rename(year = var, fert = `1`) %>%
slice_head(n = 301)
fertility[,1:2] <- sapply(fertility[,1:2],FUN=as.numeric)
fertility1 <- fertility[1:217,]
fertility2 <- fertility[218:301,]
# visualize
ggplot(data = fertility, aes(x=year, y=fert)) +
geom_point(aes(x=year[1], y=fert[1]), size = 4) +
geom_text(aes(x=year[1], y=fert[1], label = year[1]), vjust = 2.5) +
geom_point(aes(x=year[165], y=fert[165]), size = 4) +
geom_text(aes(x=year[165], y=fert[165], label = year[165]), vjust = -3, hjust = -0.5) +
geom_text(aes(x=year[165], y=fert[165], label = "5 births"), vjust = -1.5, hjust = -0.2) +
#geom_point(aes(x=year[217], y=fert[217]), size = 4) +
geom_text(aes(x=year[217], y=fert[217], label = year[217]), vjust = -3) +
geom_text(aes(x=year[217], y=fert[217], label = "2.5 births"), vjust = -1.5) +
geom_line(data = fertility1, size=1.3, arrow=arrow(length=unit(0.30,"cm"), ends="last", type = "closed")) +
geom_line(data = fertility2, size=1.3,linetype="dashed") +
labs(title = "Average Number Of Babies Per Woman From 1800 to Today",
caption = "Source: Gapminder based on UN-Pop", y="", x="") +
theme_minimal() +
theme(panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank())
I have some troubles with the linewidth of geom_line(). And I am looking for a compromise between geom_line() and geom_smooth() to make the line plot just a little bit more smooth.
But my major concern at the moment is the broken y-axis. When y-axis does not start at zero, I'd like to hightlight this as in the gapminder graph.
Following the suggestion by #Roland you could smooth your lines using a loess curve. However, instead of trying with geom_smooth I would suggest to do the calculation outside of ggplot as we need the smoothed values also for the points and the labels and we also need the same values for "both" lines.
For your axis break a simple approach would be to use two annotate, one to place the segments, one to add the filled "gap" for which I use a ribbon. This requires some fiddling to get the right positions, to fix the limits and to set clip="off". Also note that I added the axis lines via geom_h/vline so that the annotate layers could be placed on top of the axes.
Finally, I slightly adjusted your data wrangling code, use a dataset to place the labels and points and instead of using vjust I shift the labels directly via the y position.
EDIT For the final touch I added some additional styling.
# manipulate
library(tidyverse)
library(showtext)
library(hrbrthemes)
font_add_google("lato", "Lato", regular.wt = 900)
fertility <- fertility %>%
select(!c(geo.name, geo, indicator)) %>%
mutate(
across(-indicator.name, as.character),
across(-indicator.name, ~ readr::parse_number(.x, locale = locale(decimal_mark = ",")))
) %>%
pivot_longer(-indicator.name, names_to = "year", values_to = "fert", names_prefix = "X") %>%
mutate(year = as.numeric(year)) |>
mutate(fert_smooth = predict(loess(fert ~ year, span = .05)))
fertility_to_high <- fertility |>
filter(year %in% c(1800, 1964, 2016)) |>
mutate(
label = if_else(!year == 1800, paste0(year, "<br>**", round(fert, 1), " births**"), as.character(year)),
hjust = if_else(year == 2016, 0, .5)
)
ggplot(data = fertility, aes(x = year, y = fert_smooth)) +
geom_point(data = subset(fertility_to_high, year == 1964), size = 10, shape = 21, fill = NA, color = "black") +
geom_point(data = subset(fertility_to_high, year != 2016), size = 3) +
ggtext::geom_richtext(data = fertility_to_high, aes(y = fert + .15, label = label, hjust = hjust),
vjust = 0, label.colour = NA, family = font_rc, lineheight = 1.2) +
geom_line(linewidth = 1.3, linetype = "dashed") +
geom_line(data = ~ subset(.x, year <= 2016), linewidth = 1.3, arrow = arrow(length = unit(0.30, "cm"), ends = "last", type = "closed")) +
geom_hline(yintercept = 1) +
geom_vline(xintercept = 1785) +
annotate(geom = "ribbon", x = c(1780, 1790) - .55, ymin = c(1.3, 1.5), ymax = c(1.5, 1.7), fill = "white") +
annotate(
geom = "segment",
x = c(1780, 1780) - .5, xend = c(1790, 1790) - .5,
y = c(1.3, 1.5), yend = c(1.5, 1.7), linewidth = 1
) +
scale_y_continuous(breaks = 1:6, labels = c(0, 2:6), expand = c(0, .0, .05, 0)) +
scale_x_continuous(expand = c(0.05, 0, 0, 0)) +
labs(
title = toupper("Average Number Of Babies Per Woman From 1800 to Today"),
caption = "Source: Gapminder based on UN-Pop", y = "", x = ""
) +
coord_cartesian(clip = "off", ylim = c(1, 6), xlim = c(1800, NA)) +
theme_bw(base_family = font_rc, base_size = 12) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
plot.title = element_text(family = "lato"),
plot.title.position = "plot",
plot.caption = element_text(family = "lato", color = "grey40"),
axis.text.x = element_text(hjust = c(rep(.5, 3), 1))
)
The key is to add:
scale_y_continuous(limits = c(0, 6.2), expand = c(0, 0))
It tells R to limit the y range within 0 and 6.2, and show no gap beyond these two values.
The sample code below may work for you, after running it, you will get:
fertility <- read.csv("https://raw.githubusercontent.com/MarcoKuehne/marcokuehne.github.io/main/data/Gapminder/tfr-by-gapminder-v12-20171212.csv", sep = ";")
# manipulate
library(tidyverse)
fertility <- fertility |>
select(!c(geo.name, geo, indicator)) |>
t() |>
as.data.frame() |>
rownames_to_column() |>
slice(-1) |>
as_tibble() |>
rename(c(year = rowname, fert = V1)) |>
mutate(year = str_remove(year, "X"),
year = as.Date(ISOdate(year, 1, 1)),
fert = str_replace(fert, ",", "."),
fert = as.numeric(fert),
fert_1 = case_when(year <= as.Date("2017-01-01") ~ fert,
TRUE ~ as.numeric(NA)),
fert_2 = case_when(year >= as.Date("2017-01-01") ~ fert,
TRUE ~ as.numeric(NA)),
arr_data = case_when((year > as.Date("2014-01-01") & year < "2018-01-01") ~ fert,
TRUE ~ as.numeric(NA)))
fertility |>
ggplot(aes(x = year,
y = fert)) +
geom_smooth(aes(x = year,
y = fert_1,
group = 1),
span = 0.11,
se = FALSE,
colour = "black",
size = 1.5) +
geom_line(aes(x = year,
y = arr_data),
arrow = arrow(length=unit(0.4,"cm"),
ends="last",
type = "closed"),
size = 3) +
geom_line(aes(x = year,
y = fert_2,
group = 1),
linetype = 2,
size = 1.5) +
geom_point(aes(x = year[1],
y = fert[1]),
size = 5) +
annotate(geom = "text",
x = fertility$year[1],
y = fertility$fert[1],
label = "1800",
size = 4,
vjust = -1.2) +
geom_point(aes(x = fertility$year[166],
y = fertility$fert[166]),
shape = 1,
size = 12,
colour = "grey50") +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "1965",
size = 4,
vjust = -4.2) +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "5 births",
size = 5,
fontface = "bold",
vjust = -2) +
geom_point(aes(x = fertility$year[166],
y = fertility$fert[166]),
shape = 1,
size = 12,
colour = "grey50") +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "1965",
size = 4,
vjust = -4.2) +
annotate(geom = "text",
x = fertility$year[166],
y = fertility$fert[166],
label = "5 births",
size = 5,
fontface = "bold",
vjust = -2) +
annotate(geom = "text",
x = fertility$year[218],
y = fertility$fert[218],
label = "2017",
size = 4,
vjust = -4.2,
hjust = 0) +
annotate(geom = "text",
x = fertility$year[218],
y = fertility$fert[218],
label = "2.5 births",
size = 5,
fontface = "bold",
vjust = -2,
hjust = 0) +
theme_bw() +
scale_x_date(expand = expansion(mult = c(0.02, 0))) +
theme(
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.minor.y = element_blank(),
panel.border = element_blank(),
axis.text.x = element_text(size = 10),
axis.line.x = element_line(),
axis.line.y = element_line(),
plot.caption = element_text(colour = "grey50"),
plot.title = element_text(size = 16,
hjust = 0.5,
face = "bold"),
plot.margin = margin(r = 18,
t = 5,
l = 5,
b = 2)
) +
labs(
title = "AVERAGE NUMBER OF BABIES PER WOMAN FROM 1800 TO TODAY",
x = element_blank(),
y = element_blank(),
caption = "Source:Gapminder[7] based on UN-Pop[3]"
)
I have a dataframe of daily mean temperature observations for a year from two locations (i.e., Site 1 & Site 2). The three temperature variables are:
Air temperature
Water temperature
Difference = Air - Water
I would like to produce a four-panel figure where the top and bottom rows are Site 1 and Site 2 respectively, the left column displays Air and Water and the right column shows Difference. I am specifically not using facet_wrap() or facet_grid() because the y-axes are two different variables (i.e., temperature and temperature difference), and the legends are custom.
I can create the four-panel figure however, I would like the y-axis title for each column not to be repeated. Is there a way to extend each y-axis title across the stacked plots for each column?
Here is the output from the figure code below
The ideal figure would look something more like this
Example Data
library(data.table)
library(dplyr)
library(ggplot2)
library(patchwork)
set.seed(321)
# Create the example air and water temperature time series
df1 <- data.frame(matrix(ncol = 4, nrow = 365*4))
colnames(df1)[1:4] <- c("Location","Variable", "Date", "Temperature")
df1[1:730,1] <- "Site 1"
df1[731:NROW(df1),1] <- "Site 2"
df1[c(1:365,731:1095),2] <- "Air"
df1[c(366:730,1096:NROW(df1)),2] <- "Water"
df1$Date <- rep(seq.Date(as.Date("2021-01-01"),as.Date("2021-12-31"),"1 day"),4)
df1$noise <- rep(runif(365),4)
df1$t <- rep(seq(0,1*pi,,365),4)
for (i in 1:NROW(df1)) {
df1$Temperature[1:365] <- 20*sin(df1$t)+df1$noise*8
df1$Temperature[365:730] <- 17*sin(df1$t)+df1$noise*2
df1$Temperature[731:1095] <- 25*sin(df1$t)+df1$noise*6
df1$Temperature[1096:NROW(df1)] <- 18*sin(df1$t)+df1$noise*1.5
}
# Take the difference between air and water temperature
df1 <- df1[,1:4]
site1 <- df1[df1$Location == 'Site 1',]
site1 <- site1 %>%
tidyr::pivot_wider(names_from = Variable, values_from = Temperature) %>%
mutate(Difference = Air - Water)
site2 <- df1[df1$Location == 'Site 2',]
site2 <- site2 %>%
tidyr::pivot_wider(names_from = Variable, values_from = Temperature) %>%
mutate(Difference = Air - Water)
Code for figure
fig1a <- site1 %>%
ggplot() +
geom_line(aes(x = Date, y = Air), color = "red", size = 1) +
geom_line(aes(x = Date, y = Water), size = 1, alpha = 0.7) +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
labs(x = NULL,
y = expression(paste("Temperature ( ", degree, "C)"))) +
annotate("rect", fill = "white", color = "black",
xmin = as.Date("2021-01-15", "%Y-%m-%d"),
xmax = as.Date("2021-03-15", "%Y-%m-%d"),
ymin = 26, ymax = 30) +
annotate("segment", color = "red", size = 1,
x = as.Date("2021-01-20", "%Y-%m-%d"),
xend = as.Date("2021-01-30", "%Y-%m-%d"),
y = 29, yend = 29) +
annotate("segment", color = "black", size = 1,
x = as.Date("2021-01-20", "%Y-%m-%d"),
xend = as.Date("2021-01-30", "%Y-%m-%d"),
y = 27, yend = 27) +
annotate("text", x = as.Date("2021-02-01", "%Y-%m-%d"), y = 29,
label = 'Air',
size = 5, fontface = 1, hjust = 0) +
annotate("text", x = as.Date("2021-02-01", "%Y-%m-%d"), y = 27,
label = "Water",
size = 5, fontface = 1, hjust = 0) +
annotate("text", x = as.Date("2021-11-30", "%Y-%m-%d"), y = 30,
label = "(a",
size = 6, fontface = 1, hjust = 0) +
theme_bw() +
theme(plot.margin = unit(c(0, 1, 0, 1), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "white"),
axis.text.y = element_text(size = 14, color = "black"),
panel.border = element_blank()) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(0, 32)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA)))
fig1b <- site2 %>%
ggplot() +
geom_line(aes(x = Date, y = Air), color = "red", size = 1) +
geom_line(aes(x = Date, y = Water), size = 1, alpha = 0.7) +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
labs(x = NULL,
y = expression(paste("Temperature ( ", degree, "C)"))) +
annotate("text", x = as.Date("2021-11-30", "%Y-%m-%d"), y = 30,
label = "(b",
size = 6, fontface = 1, hjust = 0) +
theme_bw() +
theme(plot.margin = unit(c(0, 1, 2, 0), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 16, color = "black", angle = 90, vjust = 0.5, hjust = 1),
axis.text.y = element_text(size = 16, color = "black"),
panel.border = element_blank()) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(0,32)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA))) +
annotate(geom = "text", x = as.Date("2021-06-15", "%Y-%m-%d"), y = -7, label = 2021, size = 6)
fig1c <- site1 %>%
ggplot() +
geom_line(aes(x = Date, y = Difference), size = 1) +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
labs(x = NULL,
y = expression(paste(Delta~" Temperature ( ", degree, "C)"))) +
annotate("rect", fill = "white", color = "black",
xmin = as.Date("2021-01-15", "%Y-%m-%d"),
xmax = as.Date("2021-06-01", "%Y-%m-%d"),
ymin = 10.25, ymax = 12.5) +
annotate("text", x = as.Date("2021-01-20", "%Y-%m-%d"), y = 12,
label = 'Pos. = Air > Water',
size = 5, fontface = 1, hjust = 0) +
annotate("text", x = as.Date("2021-01-20", "%Y-%m-%d"), y = 11,
label = "Neg. = Water > Air",
size = 5, fontface = 1, hjust = 0) +
annotate("text", x = as.Date("2021-11-30", "%Y-%m-%d"), y = 12,
label = "(c",
size = 6, fontface = 1, hjust = 0) +
theme_bw() +
theme(plot.margin = unit(c(0, 1, 0, 0), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 14, color = "white"),
axis.text.y = element_text(size = 14, color = "black"),
panel.border = element_blank()) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(-2, 12)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA)))
fig1d <- site2 %>%
ggplot() +
geom_line(aes(x = Date, y = Difference), size = 1) +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
labs(x = NULL,
y = expression(paste(Delta~" Temperature ( ", degree, "C)"))) +
annotate("text", x = as.Date("2021-11-30", "%Y-%m-%d"), y = 12,
label = "(d",
size = 6, fontface = 1, hjust = 0) +
theme_bw() +
theme(plot.margin = unit(c(1, 1, 2, 0), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 16, color = "black", angle = 90, vjust = 0.5, hjust = 1),
axis.text.y = element_text(size = 16, color = "black"),
panel.border = element_blank()) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(-2,12)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA))) +
annotate(geom = "text", x = as.Date("2021-06-15", "%Y-%m-%d"), y = -5, label = 2021, size = 6)
# width = 1200 height = 900
fig1a + fig1c + fig1b + fig1d + plot_layout(ncol = 2)
I figured out how to do it, which required using facet_grid. I ended up needing to create two facets that I then stitched together, see below.
# Take the difference between air and water temperature
df1 <- df1[,1:4]
site1 <- df1[df1$Location == 'Site 1',]
site1 <- site1 %>%
tidyr::pivot_wider(names_from = Variable, values_from = Temperature) %>%
mutate(Difference = Air - Water) %>%
tidyr::pivot_longer(cols = c('Water','Air','Difference'),
names_to = 'Variable',
values_to = 'Temperature')
site2 <- df1[df1$Location == 'Site 2',]
site2 <- site2 %>%
tidyr::pivot_wider(names_from = Variable, values_from = Temperature) %>%
mutate(Difference = Air - Water) %>%
tidyr::pivot_longer(cols = c('Water','Air','Difference'),
names_to = 'Variable',
values_to = 'Temperature')
df1 <- rbind(site1,site2)
# This creates the first column of figures
p1 <- df1 %>%
subset(!df1$Variable == 'Difference',) %>%
mutate(var_air_water = ## Here is the new variable
if_else(Variable %in% c("Air", "Water"),
true = "Air & Water",
false = Variable)) %>%
ggplot() +
geom_line(aes(x = Date, y = Temperature, group = Variable, color = Variable)) +
scale_color_manual(values = c("black", "red")) +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
scale_y_continuous(breaks = seq(0,30,5)) +
labs(x = NULL,
y = expression(paste("Temperature ( ", degree, "C)"))) +
theme_bw() +
theme(plot.margin = unit(c(0, 1, 2, 0), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 16, color = "black", angle = 90, vjust = 0.5, hjust = 1),
axis.text.y = element_text(size = 16, color = "black"),
legend.title = element_blank(),
legend.text = element_text(size = 16),
legend.position = c(0.15,0.95),
legend.background = element_blank(),
strip.text = element_blank(),
strip.background = element_blank(),
panel.border = element_blank()) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(0,33)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA))) +
annotate(geom = "text", x = as.Date("2021-06-15", "%Y-%m-%d"), y = -8, label = 2021, size = 6) +
facet_grid(Location~var_air_water)
# This adds the text to the corresponding figures
dat_text1 <- data.frame(
label = c("(a","(b"),
Location = c('Site 1','Site 2'),
x = c(as.Date("2021-12-01", "%Y-%m-%d"),
as.Date("2021-12-01", "%Y-%m-%d")),
y = c(32,32))
p1 <- p1 + geom_text(
data = dat_text1,
mapping = aes(x = x, y = y, label = label,
hjust = 0,
vjust = 1),
size = 5)
# This creates the second column of figures
p2 <- df1 %>%
mutate(var_air_water = ## Here is the new variable
if_else(Variable %in% c("Air", "Water"),
true = "Air & Water",
false = Variable)) %>%
subset(!var_air_water == c('Air & Water'),) %>%
ggplot() +
geom_line(aes(x = Date, y = Temperature, group = Variable, color = Variable)) +
scale_color_manual(values = "black") +
scale_x_date(date_breaks = "2 month",
date_labels = "%b",
expand = c(0, 0)) +
scale_y_continuous(breaks = seq(0,12,2)) +
labs(x = NULL,
y = expression(paste(Delta~" Temperature ( ", degree, "C)"))) +
theme_bw() +
theme(plot.margin = unit(c(0, 1, 2, 0), "lines"),
panel.grid = element_blank(),
text = element_text(size = 16),
axis.text.x = element_text(size = 16, color = "black", angle = 90, vjust = 0.5, hjust = 1),
axis.text.y = element_text(size = 16, color = "black"),
legend.position = 'none',
strip.background = element_rect(fill = "gray80"),
strip.background.x = element_blank(),
strip.text.x = element_blank(),
strip.text.y = element_text(size = 16)) +
guides(fill = guide_legend(nrow = 2)) +
coord_cartesian(clip = 'off', ylim = c(0,12)) +
annotation_custom(grid::rectGrob(gp = grid::gpar(fill = NA))) +
annotate(geom = "text", x = as.Date("2021-06-15", "%Y-%m-%d"), y = -3, label = 2021, size = 6) +
facet_grid(Location~var_air_water)
# Like above, this adds the text to the corresponding figures
dat_text2 <- data.frame(
label = c("Pos. = Air > Water", "Neg. = Water > Air", "(c","(d"),
Location = c('Site 1','Site 1','Site 1','Site 2'),
x = c(as.Date("2021-01-15", "%Y-%m-%d"),
as.Date("2021-01-15", "%Y-%m-%d"),
as.Date("2021-12-01", "%Y-%m-%d"),
as.Date("2021-12-01", "%Y-%m-%d")),
y = c(12,11,12,12))
p2 <- p2 + geom_text(
data = dat_text2,
mapping = aes(x = x, y = y, label = label,
hjust = 0,
vjust = 1,
size = 10),
size = 5)
# width = 1200 height = 900
p1 + p2 + plot_layout(ncol = 2)
Is this even possible with ggplot?
(https://i.stack.imgur.com/wCyZN.png)
I tried geom_point(), but I don't think it can work. I also can't find the semi-circle shape.
One option would be to use ggforce::geom_arc_bar to draw the half circles for which I set sep=pi. The rest is a lot of fiddling to put the labels at the right positions.
library(ggplot2)
library(ggforce)
library(showtext)
#> Loading required package: sysfonts
#> Loading required package: showtextdb
showtext_auto()
font_add_google("Roboto Condensed", "roboto")
dat <- data.frame(
x = 1:5,
r = c(.143, .321, .176, .129, -.2)
)
col <- "grey75"
scale <- .75
fontsize <- 10
ggplot(dat) +
geom_arc_bar(
aes(
x0 = x, y0 = 0, r0 = 0, r = -scale * sign(r) * sqrt(abs(r)),
amount = 1
),
stat = "pie", sep = pi, fill = col
) +
geom_hline(yintercept = 0, color = col) +
geom_text(
aes(x = x, y = sign(r) * .1, label = scales::percent(r)),
color = "white", size = .8 + fontsize / .pt, family = "roboto"
) +
annotation_custom(
grob = grid::textGrob(
label = "Price difference %",
x = unit(-20, "pt"),
y = unit(.9, "npc"),
gp = grid::gpar(col = "white", fontsize = fontsize, fontfamily = "roboto"),
hjust = 0, vjust = 0
)
) +
annotation_custom(
grob = grid::textGrob(
label = c("% that U.S. is paying more", "% that U.S. is paying less"),
x = unit(-20, "pt"),
y = unit(.5, "npc") + unit(c(.37, -.25), "npc"),
gp = grid::gpar(col = col, fontsize = fontsize * .8, fontfamily = "roboto"),
hjust = 0, vjust = 1
)
) +
scale_y_continuous(expand = c(.2, 0, .2, 0)) +
scale_x_continuous(expand = c(0.01, 0.01)) +
coord_fixed(clip = "off") +
theme_void() +
theme(
plot.background = element_rect(fill = "black"),
plot.margin = margin(0, 11, 0, 11, "pt"),
axis.ticks.length.y.left = unit(20, "pt")
)
I have my code with that created two different graphs. I want to combine the graphs into one graph with "Elevation on the primary y axis and "Precipitation" on the secondary y axis. Is this possible or would it be best to stick with having the two graphs on top of each other?
pe1.plot <- combine.df %>% filter(site== "VWP 1") %>%
ggplot(aes(x = datetime, y = elevation)) +
geom_line(color = "blue")+
theme(plot.subtitle = element_text(vjust = 1),
plot.caption = element_text(vjust = 1),
plot.background = element_rect(linetype = "solid")) +labs(title = "VWP 1", x = "Date", y = "Elevation (MSL)")
precip.plot <- ggplot(precip.df, aes(x = datetime, y = precipitation)) +
geom_bar(stat = "identity")+
theme(plot.subtitle = element_text(vjust = 1),
plot.caption = element_text(vjust = 1),
plot.background = element_rect(linetype = "solid")) +labs(x = "Date", y = "Pecipitation (in.)")
pe1.plot+precip.plot + plot_layout(ncol = 1)
Possible but kind of a pain:
library(tidyverse)
set.seed(42)
my_data = tibble(date = seq.Date(as.Date("2020-01-01"),
as.Date("2020-06-30"), by = "day"),
line_y = seq(698, 700, length.out = 182) + rnorm(182, sd = 0.1),
bar_y = rpois(182, c(0,0,5))/10)
ggplot(my_data, aes(date)) +
geom_line(aes(y = line_y)) +
geom_col(aes(y = (2*bar_y) + 695)) +
scale_y_continuous(breaks = seq(695, 699.5, by = 0.5),
labels = c(rep("", 6), seq(698, 699.5, by = 0.5)),
sec.axis = sec_axis(~ (. - 695) / 2,
breaks = seq(0, 1, by = 0.25))) +
coord_cartesian(ylim = c(695, NA), expand = 0)
I'm trying to create a multiple plot with the same x-axis but different y-axes, because I have values for two groups with different ranges. As I want to control the values of the axes (respectively the y-axes shall reach from 2.000.000 to 4.000.000 and from 250.000 to 500.000), I don't get along with facet_grid with scales = "free".
So what I've tried is to create two plots (named "plots.treat" and "plot.control") and combine them with grid.arrange and arrangeGrob. My problem is, that I don't know how to control the exact position of the two plots, so that both y-axes are positioned on one vertical line. So in the example below the second plot's y-axis needs to be positioned a bit more to the right.
Here is the code:
# Load Packages
library(ggplot2)
library(grid)
library(gridExtra)
# Create Data
data.treat <- data.frame(seq(2005.5, 2015.5, 1), rep("SIFI", 11),
c(2230773, 2287162, 2326435, 2553602, 2829325, 3372657, 3512437,
3533884, 3519026, 3566553, 3527153))
colnames(data.treat) <- c("Jahr", "treatment",
"Aggregierte Depositen (in Tausend US$)")
data.control <- data.frame(seq(2005.5, 2015.5, 1), rep("Nicht-SIFI", 11),
c(324582, 345245, 364592, 360006, 363677, 384674, 369007,
343893, 333370, 318409, 313853))
colnames(data.control) <- c("Jahr", "treatment",
"Aggregierte Depositen (in Tausend US$)")
# Create Plot for data.treat
plot.treat <- ggplot() +
geom_line(data = data.treat,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
size = 1,
linetype = "dashed") +
geom_point(data = data.treat,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
fill = "white",
size = 2,
shape = 24) +
scale_x_continuous(breaks = seq(2005, 2015.5, 1),
minor_breaks = seq(2005, 2015.5, 0.5),
limits = c(2005, 2015.8),
expand = c(0.01, 0.01)) +
scale_y_continuous(breaks = seq(2000000, 4000000, 500000),
minor_breaks = seq(2000000, 4000000, 250000),
labels = c("2.000.000", "2.500.000", "3.000.000",
"3.500.000", "4.000.000"),
limits = c(2000000, 4000000),
expand = c(0, 0.01)) +
theme(text = element_text(family = "Times"),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.line.x = element_line(color="black", size = 0.6),
axis.line.y = element_line(color="black", size = 0.6),
legend.position = "none") +
geom_segment(aes(x = c(2008.7068),
y = c(2000000),
xend = c(2008.7068),
yend = c(3750000)),
linetype = "dotted") +
annotate(geom = "text", x = 2008.7068, y = 3875000, label = "Lehman\nBrothers + TARP",
colour = "black", size = 3, family = "Times") +
geom_segment(aes(x = c(2010.5507),
y = c(2000000),
xend = c(2010.5507),
yend = c(3750000)),
linetype = "dotted") +
annotate(geom = "text", x = 2010.5507, y = 3875000, label = "Dodd-Frank-\nAct",
colour = "black", size = 3, family = "Times") +
geom_rect(aes(xmin = 2007.6027, xmax = 2009.5, ymin = -Inf, ymax = Inf),
fill="dark grey", alpha = 0.2)
# Create Plot for data.control
plot.control <- ggplot() +
geom_line(data = data.control,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
size = 1,
linetype = "solid") +
geom_point(data = data.control,
aes(x = `Jahr`,
y = `Aggregierte Depositen (in Tausend US$)`),
fill = "white",
size = 2,
shape = 21) +
scale_x_continuous(breaks = seq(2005, 2015.5, 1), # x-Achse
minor_breaks = seq(2005, 2015.5, 0.5),
limits = c(2005, 2015.8),
expand = c(0.01, 0.01)) +
scale_y_continuous(breaks = seq(250000, 500000, 50000),
minor_breaks = seq(250000, 500000, 25000),
labels = c("250.000", "300.000", "350.000", "400.000",
"450.000", "500.000"),
limits = c(250000, 500000),
expand = c(0, 0.01)) +
theme(text = element_text(family = "Times"),
axis.title.x = element_blank(), # Achse
axis.title.y = element_blank(), # Achse
axis.line.x = element_line(color="black", size = 0.6),
axis.line.y = element_line(color="black", size = 0.6),
legend.position = "none") +
geom_segment(aes(x = c(2008.7068),
y = c(250000),
xend = c(2008.7068),
yend = c(468750)),
linetype = "dotted") +
annotate(geom = "text", x = 2008.7068, y = 484375, label = "Lehman\nBrothers + TARP",
colour = "black", size = 3, family = "Times") +
geom_segment(aes(x = c(2010.5507),
y = c(250000),
xend = c(2010.5507),
yend = c(468750)),
linetype = "dotted") +
annotate(geom = "text", x = 2010.5507, y = 484375, label = "Dodd-Frank-\nAct",
colour = "black", size = 3, family = "Times") +
geom_rect(aes(xmin = 2007.6027, xmax = 2009.5, ymin = -Inf, ymax = Inf),
fill="dark grey", alpha = 0.2)
# Combine both Plots with grid.arrange
grid.arrange(arrangeGrob(plot.treat, plot.control,
ncol = 1,
left = textGrob("Aggregierte Depositen (in Tausend US$)",
rot = 90,
vjust = 1,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold")),
bottom = textGrob("Jahr",
vjust = 0.1,
hjust = 0.2,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold"))))
Do:
install.packages("cowplot")
but do not library(cowplot) as it'll mess up your theme work.
Then, do:
grid.arrange(
arrangeGrob(cowplot::plot_grid(plot.treat, plot.control, align = "v", ncol=1),
ncol = 1,
left = textGrob("Aggregierte Depositen (in Tausend US$)",
rot = 90,
vjust = 1,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold")),
bottom = textGrob("Jahr",
vjust = 0.1,
hjust = 0.2,
gp = gpar(fontfamily = "Times",
size = 12,
colout = "black",
fontface = "bold"))))