Related
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)
Here is my data which produces a heat map. What I am hoping to do is produce multiple difference heatmaps with an outline around each of x categories.
data <- data.frame(id=c("john","john","john","kate","kate","kate","chris","chris","chris"),
group=c("geo","his","math","geo","his","math","geo","his","math"),
grade=c(65,76,87,67,89,98,99,97,96),
class=c("A","A","A","A","A","A","B","B","B"))
data
mine.heatmap <- ggplot(data = data, mapping = aes(x = id, y = group, fill = grade)) +
geom_tile() +
xlab(label = "id") +
ylab(label="group") +
labs(fill="grade")+
scale_fill_gradient2(low = "#800080",
high = "#FF8C00",mid = "white")
x <- mine.heatmap + facet_grid(
cols = vars(class), scales = "free", space = "free"
)
x + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1, size = 18, margin = margin(b=2)))+
theme(axis.text.y= element_text(angle = 0, vjust = 0.5, hjust=1, size = 18)) +
theme(legend.text = element_text(size=14))+
theme(legend.title = element_text(size=14))+
theme(strip.text = element_text(size=14))+
theme(axis.title.x = element_text(size=18)) +theme(axis.title.y = element_text(size=18))
Original Heat map:
What I am hoping to get are the following heatmaps:
One option to achieve your desired result would be to
put your plotting code in a function which takes as one argument the id for which you want to draw a outline.
Use some data wrangling to convert the categories to be plotted on the x and y aes to numerics per facet variable.
Add a geom_rect to your plotting code to draw the outline which uses the numerics computed in step 2.
library(ggplot2)
library(dplyr)
mine_heatmap <- function(x) {
p <- ggplot(data = data, mapping = aes(x = id, y = group, fill = grade)) +
geom_tile() +
# Add outline via a geom_rect
geom_rect(
data = subset(data, id == x),
aes(
xmin = id_num - .5, xmax = id_num + .5,
ymin = min(group_num) - .5, ymax = max(group_num) + .5
), fill = NA, color = "black", size = 1
) +
labs(x = "id", y = "group", fill = "grade") +
scale_fill_gradient2(
low = "#800080",
high = "#FF8C00", mid = "white"
)
p <- p + facet_grid(
cols = vars(class), scales = "free", space = "free"
)
p + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1, size = 18, margin = margin(b = 2))) +
theme(axis.text.y = element_text(angle = 0, vjust = 0.5, hjust = 1, size = 18)) +
theme(legend.text = element_text(size = 14)) +
theme(legend.title = element_text(size = 14)) +
theme(strip.text = element_text(size = 14)) +
theme(axis.title.x = element_text(size = 18)) + theme(axis.title.y = element_text(size = 18))
}
# Convert id and group to numerics per facet variable
data <- data |>
group_by(class) |>
mutate(
id_num = as.numeric(factor(id)),
group_num = as.numeric(factor(group))
) |>
ungroup()
mine_heatmap("john")
mine_heatmap("kate")
mine_heatmap("chris")
I am a novice coder and have been trying to understand the code posted here: Forest plot with table ggplot coding
I am hoping to use the script to display my own univariate analysis results for a project. I want the script to read the data from a csv file with the columns: "Predictor", "N", "rr", "rrlow", "rrhigh", and "arr". There are in total 19 variables ("Predictors") that I need to display. I have altered the script to read in the values into a single dataframe (rather than having a separate forestdf and fplottable like in the linked thread). However, I am getting multiple "replacement has x rows, data has y".
Here is the code in question:
###dataframe
library(ggplot2)
library(tidyr)
library(grid)
library(gridExtra)
library(forcats)
forestdf<- read.csv("UnivariateAnalysis2.csv",header=T)
forestdf$Predictor <- factor(forestdf$Predictor,levels = forestdf$Predictor)
levels(forestdf$Predictor)
forestdf$colour <- rep(c("white", "gray95"), length.out = 19)
p <- ggplot(forestdf, aes(x = rr, y = Predictor, xmin = rrlow, xmax = rrhigh)) +
geom_hline(aes(yintercept = 1, colour = colour), size = 7) +
geom_pointrange(shape = 22, fill = "black") +
geom_vline(xintercept = 1, linetype = 3) +
xlab("Variable") +
ylab("Hazard Ratio with 95% Confidence Interval") +
theme_classic() +
scale_colour_identity() +
scale_y_discrete(limits = rev(forestdf$Predictor)) +
scale_x_log10(limits = c(0.25, 4),
breaks = c(0.25, 0.5, 1, 2, 4),
labels = c("0.25", "0.5", "1", "2", "4"), expand = c(0,0)) +
theme(axis.text.y = element_blank(), axis.title.y = element_blank())
forestdf$Predictor <- factor(forestdf$Predictor, rev(levels(forestdf$Predictor)))
forestdf$colour <- rep(c("white", "gray95"), length.out=19)
data_table <- ggplot(data = forestdf, aes(y = Predictor)) +
geom_hline(aes(yintercept = 1, colour = colour), size = 7) +
geom_text(aes(x = 0, label = Predictor), hjust = 0) +
geom_text(aes(x = 5, label = N)) +
geom_text(aes(x = 7, label = arr), hjust = 1) +
scale_colour_identity() +
theme_void() +
theme(plot.margin = margin(5, 0, 35, 0))
grid.arrange(data_table,p, ncol = 2)
And the errors I have been receiving:
> ###dataframe
> library(ggplot2)
> library(tidyr)
> library(grid)
> library(gridExtra)
> library(forcats)
>
> forestdf<- read.csv("UnivariateAnalysis2.csv",header=T)
> forestdf$Predictor <- factor(forestdf$Predictor,levels = forestdf$Predictor)
Error in `$<-.data.frame`(`*tmp*`, Predictor, value = integer(0)) :
replacement has 0 rows, data has 19
> levels(forestdf$Predictor)
NULL
> forestdf$colour <- rep(c("white", "gray95"), length.out = 19)
> p <- ggplot(forestdf, aes(x = rr, y = Predictor, xmin = rrlow, xmax = rrhigh)) +
+ geom_hline(aes(yintercept = 1, colour = colour), size = 7) +
+ geom_pointrange(shape = 22, fill = "black") +
+ geom_vline(xintercept = 1, linetype = 3) +
+ xlab("Variable") +
+ ylab("Hazard Ratio with 95% Confidence Interval") +
+ theme_classic() +
+ scale_colour_identity() +
+ scale_y_discrete(limits = rev(forestdf$Predictor)) +
+ scale_x_log10(limits = c(0.25, 4),
+ breaks = c(0.25, 0.5, 1, 2, 4),
+ labels = c("0.25", "0.5", "1", "2", "4"), expand = c(0,0)) +
+ theme(axis.text.y = element_blank(), axis.title.y = element_blank())
>
> forestdf$Predictor <- factor(forestdf$Predictor, rev(levels(forestdf$Predictor)))
Error in `$<-.data.frame`(`*tmp*`, Predictor, value = integer(0)) :
replacement has 0 rows, data has 19
> forestdf$colour <- rep(c("white", "gray95"), length.out=19)
>
> data_table <- ggplot(data = forestdf, aes(y = Predictor)) +
+ geom_hline(aes(yintercept = 1, colour = colour), size = 7) +
+ geom_text(aes(x = 0, label = Predictor), hjust = 0) +
+ geom_text(aes(x = 5, label = N)) +
+ geom_text(aes(x = 7, label = arr), hjust = 1) +
+ scale_colour_identity() +
+ theme_void() +
+ theme(plot.margin = margin(5, 0, 35, 0))
>
> grid.arrange(data_table,p, ncol = 2)
Error in FUN(X[[i]], ...) : object 'Predictor' not found
I greatly appreciate any help or suggestions you may provide.
Thanks!
EDIT:
###dataframe
library(ggplot2)
library(tidyr)
library(grid)
library(gridExtra)
library(forcats)
forestdf<- read.csv("UnivariateAnalysis2.csv",header=TRUE)
names(forestdf)[1]<-"Predictor"
forestdf$Predictor <- factor(forestdf$Predictor)
forestdf$colour <- rep(c("white", "gray95"), length.out = length(unique(unlist(forestdf[c("Predictor")]))))
p <- ggplot(forestdf, aes(x = rr, y = Predictor, xmin = rrlow, xmax = rrhigh)) +
geom_hline(aes(yintercept = Predictor, colour = colour), size = 7) +
geom_pointrange(shape = 22, fill = "black") +
geom_vline(xintercept = 1, linetype = 3, colour = "red") +
xlab("Hazard Ratio") +
ylab("Hazard Ratio with 95% Confidence Interval") +
theme_classic() +
scale_colour_identity() +
scale_y_discrete(limits = rev(forestdf$Predictor)) +
scale_x_log10(limits = c(0.25, 4),
breaks = c(0.25, 0.5, 1, 2, 4),
labels = c("0.25", "0.5", "1", "2", "4"), expand = c(0,0)) +
theme(axis.text.y = element_blank(), axis.title.y = element_blank())
forestdf$Predictor <- factor(forestdf$Predictor, rev(levels(forestdf$Predictor)))
data_table <- ggplot(data = forestdf, aes(y = Predictor)) +
geom_hline(aes(yintercept = Predictor, colour = colour), size = 7) +
geom_text(aes(x = 0, label = Predictor), hjust = 0) +
geom_text(aes(x = 3, label = N)) +
geom_text(aes(x = 7, label = arr), hjust = 1) +
scale_colour_identity() +
theme_void() +
theme(plot.margin = margin(5, 0, 35, 0))
grid.arrange(data_table,p, ncol = 2)
I have made some changes as per IRTFM (thank you!) and it now produces a plot and table. I'm not sure why but it wasn't reading the csv correctly. My main issues now are the following:
The alternating grey and white bars do not alternate correctly on the table side
The header for the columns does not show up on the table
The table is not aligned with the forestplot (ie. top row's forest plot is not the correct forest plot for Albumin) Example Plot
EDIT2:
I was able to fix the alternating colours and alignment with the forestplot. My issue now is that the column titles I've made are now cut off: New Plot. Also, how would I go about only bolding the values with an asterisk?
###dataframe
library(ggplot2)
library(tidyr)
library(grid)
library(gridExtra)
library(forcats)
forestdf<- read.csv("UnivariateAnalysis2.csv",header=TRUE)
names(forestdf)[1]<-"Predictor"
forestdf$Predictor <- rev(factor(forestdf$Predictor))
forestdf$colour <- rep(c("white", "gray95"), length.out = length(unique(unlist(forestdf[c("Predictor")]))))
p <- ggplot(forestdf, aes(x = rr, y = Predictor, xmin = rrlow, xmax = rrhigh)) +
geom_hline(aes(yintercept = Predictor, colour = colour), size = 7) +
geom_pointrange(shape = 22, fill = "black") +
geom_vline(xintercept = 1, linetype = 3, colour = "red") +
xlab("Hazard Ratio") +
ylab("Hazard Ratio with 95% Confidence Interval") +
theme_classic() +
scale_colour_identity() +
scale_y_discrete(limits = forestdf$Predictor) +
scale_x_log10(limits = c(0.25, 4),
breaks = c(0.25, 0.5, 1, 2, 4),
labels = c("0.25", "0.5", "1", "2", "4"), expand = c(0,0)) +
theme(axis.text.y = element_blank(), axis.title.y = element_blank())
#forestdf$Predictor <- factor(forestdf$Predictor, rev(levels(forestdf$Predictor)))
data_table <- ggplot(data = forestdf, aes(y = rev(factor(Predictor)))) +
geom_hline(aes(yintercept = Predictor, colour = colour), size = 7) +
geom_text(aes(x = 0, label = Predictor), show.legend=TRUE, hjust = 0) +
geom_text(aes(x = 3, label = N)) +
geom_text(aes(x = 5.5, label = arr), hjust = 1) +
geom_text(aes(x = 7, label = PVALUE), hjust = 1) +
geom_text(aes(x = 0, y = 20, label = "Predictor"), hjust = 0) +
geom_text(aes(x = 3, y= 20, label = "N")) +
geom_text(aes(x = 5, y= 20, label = "95% CI"), hjust = 1) +
geom_text(aes(x = 7, y= 20, label = "P Value"), hjust = 1) +
scale_colour_identity() +
theme_void() +
theme(plot.margin = margin(5, 0, 35, 0))
grid.arrange(data_table,p, ncol = 2)
Thanks!
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've been scratching my head for hours on this. What I have up to now:
library(ggplot2)
library(grid)
all_data = data.frame(country=rep(c("A","B","C","D"),times=1,each=20),
value=rep(c(10,20,30,40),times=1,each=20),
year = rep(seq(1991,2010),4))
# PLOT GRAPH
p1 <- ggplot() + theme_bw() + geom_line(aes(y = value, x = year,
colour=country), size=2,
data = all_data, stat="identity") +
theme(plot.title = element_text(size=18,hjust = -0.037), legend.position="bottom",
legend.direction="horizontal", legend.background = element_rect(size=0.5, linetype="solid", colour ="black"),
legend.text = element_text(size=16,face = "plain"), panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.border = element_blank(),axis.line = element_line(colour = "black"),legend.title = element_blank(),
axis.text=element_text(size=18,face = "plain"),axis.title.x=element_text(size=18,face = "plain", hjust = 1,
margin = margin(t = 10, r = 0, b = 0, l = 0)),
axis.title.y=element_blank())
p1 <- p1 + ggtitle("Index")
p1 <- p1 + xlab("Year")
p1 <- p1 + scale_x_continuous(expand=c(0,0),breaks=seq(1991,2010,4))
p1 <- p1 + theme(plot.margin=unit(c(5.5, 300, 5.5, 5.5), "points"))
p1 <- p1 + geom_text(aes(label = "Country", x = 2011, y =
max(all_data$value)+10), hjust = 0, vjust = -2.5, size = 6)
p1 <- p1 + geom_text(aes(label = "Average", x = Inf, y =
max(all_data$value)+10), hjust = -1.5, vjust = -2, size = 6)
p1 <- p1 + geom_text(aes(label = all_data$country, x = 2011, y =
all_data$value), hjust = 0, size = 6)
p1 <- p1 + geom_text(aes(label = as.character(all_data$value), x = Inf,
y = all_data$value), hjust = -5, size = 6)
p1 <- p1 +
annotate("segment",x=2011,xend=2014,y=Inf,yend=Inf,color="black",lwd=1)
# Override clipping
gg2 <- ggplot_gtable(ggplot_build(p1))
gg2$layout$clip[gg2$layout$name == "panel"] <- "off"
grid.draw(gg2)
What I am struggling with is the following:
1) how to annotate outside of the plot, underline both "Country" and "Average" without extending the x-axis.
2) Isn't there more systematic approach to the whole annotation process. Adjusting hjust and vjust by visual inspection seems very troublesome.
Any help is appreciated!
See if this works for you:
# define some offset parameters
x.offset.country = 2
x.offset.average = 5
x.range = range(all_data$year) + c(0, x.offset.average + 2)
y.range = range(all_data$value) + c(-5, 10)
y.label.height = max(all_data$value) + 8
# subset of data for annotation
all_data_annotation <- dplyr::filter(all_data, year == max(year))
p <- ggplot(all_data,
aes(x = year, y = value, group = country, colour = country)) +
geom_line(size = 2) +
# fake axes (x-axis stops at year 2009, y-axis stops at value 45)
annotate("segment", x = 1991, y = 5, xend = 2009, yend = 5) +
annotate("segment", x = 1991, y = 5, xend = 1991, yend = 45) +
# country annotation
geom_text(data = all_data_annotation, inherit.aes = FALSE,
aes(x = year + x.offset.country, y = value, label = country)) +
annotate("text", x = max(all_data$year) + x.offset.country, y = y.label.height,
label = "~underline('Country')", parse = TRUE) +
# average annotation
geom_text(data = all_data_annotation, inherit.aes = FALSE,
aes(x = year + x.offset.average, y = value, label = value)) +
annotate("text", x = max(all_data$year) + x.offset.average, y = y.label.height,
label = "~underline('Average')", parse = TRUE) +
# index (fake y-axis label)
annotate("text", x = 1991, y = y.label.height,
label = "Index") +
scale_x_continuous(name = "Year", breaks = seq(1991, 2009, by = 4), expand = c(0, 0)) +
scale_y_continuous(name = "", breaks = seq(10, 40, by = 10), expand = c(0, 0)) +
scale_colour_discrete(name = "") +
coord_cartesian(xlim = x.range, ylim = y.range) +
theme_classic() +
theme(axis.line = element_blank(),
legend.position = "bottom",
legend.background = element_rect(size=0.5, linetype="solid", colour ="black"))
# Override clipping (this part is unchanged)
gg2 <- ggplot_gtable(ggplot_build(p))
gg2$layout$clip[gg2$layout$name == "panel"] <- "off"
grid.draw(gg2)