Related
I am attempting to combine four plots on to a single page. However, when I combine the four plots together, I lose the x-axis labels for "Juvenile females". The "juvenile females" plot is also not quite aligned with the neighbouring "juvenile male" plot.
My code is as follows:
# Create plot for ADULT MALE
theme_set(theme_classic())
count(AHYM_Mass, Month, Time_Period, Habitat.Type, wt = NULL, sort = FALSE, name = NULL)
AHYM_summary <- AHYM_Mass %>%
group_by(Month, Time_Period, Habitat.Type) %>%
summarise(
se = sd(Mass, na.rm = TRUE)/sqrt(length(Mass)),
Mass = mean(as.numeric(Mass), na.rm = TRUE),
n = n()
) %>%
ungroup() %>%
na.omit() %>%
dplyr::mutate(
Month = factor(Month, levels = c("Nov-Dec", "Jan-Feb", "Mar-Apr"))
)
p_AHYM <- ggplot(data=AHYM_summary, aes(x = Month, y = Mass, col = Time_Period, group = Time_Period)) +
geom_errorbar(
aes(ymin = Mass - se, ymax = Mass + se, linetype = Time_Period),
width = 0.3,
position = ggstance::position_dodgev(height = 0.8),
colour = "black"
) +
geom_line(colour = "black") +
geom_point(position = ggstance::position_dodgev(height = 0.8), size = 3, shape = 21, aes(fill = Time_Period)) +
scale_fill_manual(
values = c(
"2001-2008" = "white",
"2021" = "black"
)
) +
scale_color_manual(
values = c(
"2001-2008" = "black",
"2021" = "black"
)
) +
xlab("") +
ylab("Mass (g)") +
ggtitle("Adult Male") +
theme(
plot.title = element_text(hjust = 0.5)
) +
theme(text=element_text(size=15), legend.title=element_blank(), strip.text.x = element_text(size = 15, face ='bold'),
axis.text = element_text(size=12, face = 'bold'), legend.text = element_text(face='bold'), plot.title = element_text(face='bold')) +
facet_wrap(~Habitat.Type, ncol=1) #+ coord_cartesian(ylim = c(925, 1110))
p_AHYM
# Create plot for ADULT FEMALE
theme_set(theme_bw())
AHYF_summary <- AHYF_Mass %>%
group_by(Month, Time_Period, Habitat.Type) %>%
summarise(
se = sd(Mass, na.rm = TRUE)/sqrt(length(Mass)),
Mass = mean(as.numeric(Mass), na.rm = TRUE),
n = n()
) %>%
ungroup() %>%
na.omit() %>%
dplyr::mutate(
Month = factor(Month, levels = c("Nov-Dec", "Jan-Feb", "Mar-Apr"))
)
p_AHYF <- ggplot(data=AHYF_summary, aes(x = Month, y = Mass, col = Time_Period, group = Time_Period)) +
geom_errorbar(
aes(ymin = Mass - se, ymax = Mass + se, linetype = Time_Period),
width = 0.3,
position = ggstance::position_dodgev(height = 0.8),
colour = "black"
) +
geom_line(colour = "black") +
geom_point(position = ggstance::position_dodgev(height = 0.8), size = 3, shape = 21, aes(fill = Time_Period)) +
scale_fill_manual(
values = c(
"2001-2008" = "white",
"2021" = "black"
)
) +
scale_color_manual(
values = c(
"2001-2008" = "black",
"2021" = "black"
)
) +
xlab("") +
ylab("Mass (g)") +
ggtitle("Adult Female") +
theme(
plot.title = element_text(hjust = 0.5)
) +
theme(text=element_text(size=15), legend.title=element_blank(), strip.text.x = element_text(size = 15, face ='bold'),
axis.text = element_text(size=12, face = 'bold'), legend.text = element_text(face='bold'), plot.title = element_text(face='bold')) +
facet_wrap(~Habitat.Type, ncol=1) # + coord_cartesian(ylim = c(850, 975))
p_AHYF
# JUVENILE MALE
HYM_summary <- HYM_Mass %>%
group_by(Month, Time_Period, Habitat.Type) %>%
summarise(
se = sd(Mass, na.rm = TRUE)/sqrt(length(Mass)),
Mass = mean(as.numeric(Mass), na.rm = TRUE),
n = n()
) %>%
ungroup() %>%
na.omit() %>%
dplyr::mutate(
Month = factor(Month, levels = c("Nov-Dec", "Jan-Feb", "Mar-Apr"))
)
p_HYM <- ggplot(data=HYM_summary, aes(x = Month, y = Mass, col = Time_Period, group = Time_Period)) +
geom_errorbar(
aes(ymin = Mass - se, ymax = Mass + se, linetype = Time_Period),
width = 0.3,
position = ggstance::position_dodgev(height = 0.8),
colour = "black"
) +
geom_line(colour = "black") +
geom_point(position = ggstance::position_dodgev(height = 0.8), size = 3, shape = 21, aes(fill = Time_Period)) +
scale_fill_manual(
values = c(
"2001-2008" = "white",
"2021" = "black"
)
) +
scale_color_manual(
values = c(
"2001-2008" = "black",
"2021" = "black"
)
) +
xlab("") +
ylab("Mass (g)") +
ggtitle("Juvenile Male") +
theme(
plot.title = element_text(hjust = 0.5)
) +
theme(text=element_text(size=15), legend.title=element_blank(), strip.text.x = element_text(size = 15, face ='bold'),
axis.text = element_text(size=12, face = 'bold'), legend.text = element_text(face='bold'), plot.title = element_text(face='bold')) +
facet_wrap(~Habitat.Type, ncol=1) + coord_cartesian(ylim = c(850, 1100))
p_HYM
# JUVENILE FEMALE
HYF_summary <- HYF_Mass %>%
group_by(Month, Time_Period, Habitat.Type) %>%
summarise(
se = sd(Mass, na.rm = TRUE)/sqrt(length(Mass)),
Mass = mean(as.numeric(Mass), na.rm = TRUE),
n = n()
) %>%
ungroup() %>%
na.omit() %>%
dplyr::mutate(
Month = factor(Month, levels = c("Nov-Dec", "Jan-Feb", "Mar-Apr"))
)
p_HYF <- ggplot(data=HYF_summary, aes(x = Month, y = Mass, col = Time_Period, group = Time_Period)) +
geom_errorbar(
aes(ymin = Mass - se, ymax = Mass + se, linetype = Time_Period),
width = 0.3,
position = ggstance::position_dodgev(height = 0.8),
colour = "black"
) +
geom_line(colour = "black") +
geom_point(position = ggstance::position_dodgev(height = 0.8), size = 3, shape = 21, aes(fill = Time_Period)) +
scale_fill_manual(
values = c(
"2001-2008" = "white",
"2021" = "black"
)
) +
scale_color_manual(
values = c(
"2001-2008" = "black",
"2021" = "black"
)
) +
xlab("") +
ylab("Mass (g)") +
ggtitle("Juvenile Female") +
theme(
plot.title = element_text(hjust = 0.5)
) +
theme(text=element_text(size=15), legend.title=element_blank(), strip.text.x = element_text(size = 15, face ='bold'),
axis.text = element_text(size=12, face = 'bold'), legend.text = element_text(face='bold'), plot.title = element_text(face='bold')) +
facet_wrap(~Habitat.Type, ncol=1) + coord_cartesian(ylim = c(775, 1050))
p_HYF
ggarrange(p_AHYM, p_AHYF, p_HYM, p_HYF + rremove("x.text"),
common.legend = TRUE, legend = "none",
ncol = 2, nrow = 2)
When I plot the 4 plots together without specifying the legend, the x-axis titles appear for "juvenile females" but this is a very squished orientation and I don't need to repeat the legend four times. But if there is at least some way to make this orientation work I would be happy with that too.
grid.arrange(p_AHYM, p_AHYF, p_HYM, p_HYF, ncol=2, nrow=2)
Thank you for your help!!!
I was able to use patchwork to align two xaxis, but when I add ggbreak::scale_break(), it no longer aligns. What am I doing wrong here? Code of alignment issues follows. UnComment out scale_break() lines to see difference.
library(scales)
library(ggplot2)
library(ggbreak)
library(patchwork)
y <- as_tibble(c(rnorm(400,100,25),250) )
n= nrow(y)
cor = n/100
a.mean = mean(y$value)
a.median= quantile(y$value,0.5)
a.sd = sd(y$value)
binwidth = 5
upper.limit <- 260
plt1 <-ggplot(y, aes(x="", y = value) ) +
geom_boxplot(fill = "lightblue", color = "black", outlier.shape=NA) +
stat_boxplot(geom='errorbar',coef=NULL) +
stat_summary(fun=mean, geom="point", shape=23, size=7.6, color="black", fill = "blue") +
coord_flip() +
theme_classic() +
theme(panel.border = element_rect(color="black", fill = NA, size = 1),
axis.text = element_text(size=14)) +
xlab("") +
ylab("Value ($)") +
#scale_y_break(c(200,240 ) ) +
scale_y_continuous(breaks=pretty(c(0,upper.limit), n=10), limits=c(0,upper.limit) ) +
theme(axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
axis.text.x.top=element_blank(),
axis.ticks.x.top=element_blank() )
plt2 <- ggplot(y, aes(x = value) ) +
geom_histogram(aes(y = (..count..)/sum(..count..)*100 ),
position = "identity", binwidth = 5,
fill = "lightblue", color = "black") +
stat_function(fun = function(x)
dnorm(x, mean = a.mean, sd = a.sd) * n * binwidth / cor,
color="darkblue", size =1) +
ylab("Percentage") +
xlab("") +
#scale_x_break(c(200,240 ) ) +
scale_x_continuous(breaks=pretty(c(0,upper.limit), n=10), limits=c(0,upper.limit) ) +
scale_y_continuous(breaks=seq(0,15, by=2.5)) +
theme(panel.border = element_rect(color="black", fill = NA, size = 1),
plot.title = element_text(hjust = 0.5),
text=element_text(size=20),
axis.text = element_text(size=14),
axis.text.x.top=element_blank(),
axis.ticks.x.top=element_blank() )
Fig01_01 <- plt2 / plt1 + plot_layout(nrow = 2, heights = c(10, 2) )
Fig01_01
One solution might be to manually/invisibly add in the y-axis labels and ticks for the bottom plot as exactly the same size as the upper plot. ggbreak does additionally seem to add in an immovable margin around the whole plotting area, so you may have some extra white space between plots doing it this way:
library(scales)
library(tidyverse)
library(ggbreak)
library(patchwork)
y <- as_tibble(c(rnorm(400,100,25),250) )
n= nrow(y)
cor = n/100
a.mean = mean(y$value)
a.median= quantile(y$value,0.5)
a.sd = sd(y$value)
binwidth = 5
upper.limit <- 260
plt1 <-ggplot(y, aes(x=1, y = value) ) +
geom_boxplot(fill = "lightblue", color = "black", outlier.shape=NA) +
stat_boxplot(geom='errorbar',coef=NULL) +
stat_summary(fun=mean, geom="point", shape=23, size=7.6, color="black", fill = "blue") +
coord_flip() +
theme_classic() +
theme(panel.border = element_rect(color="black", fill = NA, size = 1),
axis.text = element_text(size=14)) +
xlab(" ") +
ylab("Value ($)") +
scale_y_break(c(200,240 ) ) +
scale_y_continuous(breaks=pretty(c(0,upper.limit), n=10), limits=c(0,upper.limit) ) +
theme(axis.text.y=element_text(colour = "white", size = 14),
axis.ticks.y=element_line(colour = "white"),
axis.text.x.top=element_blank(),
axis.title.y=element_text(size=20),
axis.ticks.x.top=element_blank() )
plt2 <- ggplot(y, aes(x = value) ) +
geom_histogram(aes(y = (..count..)/sum(..count..)*100 ),
position = "identity", binwidth = 5,
fill = "lightblue", color = "black") +
stat_function(fun = function(x)
dnorm(x, mean = a.mean, sd = a.sd) * n * binwidth / cor,
color="darkblue", size =1) +
ylab("Percentage") +
xlab("") +
scale_x_break(c(200,240 ) ) +
scale_x_continuous(breaks=pretty(c(0,upper.limit), n=10), limits=c(0,upper.limit) ) +
scale_y_continuous(breaks=seq(0,15, by=2.5)) +
theme(panel.border = element_rect(color="black", fill = NA, size = 1),
plot.title = element_text(hjust = 0.5),
text=element_text(size=20),
axis.text = element_text(size=14),
axis.text.x.top=element_blank(),
axis.ticks.x.top=element_blank() )
Fig01_01 <- plt2 / plt1 + plot_layout(nrow = 2, heights = c(6, 2) )
Fig01_01
The code below is adapted from https://simplystatistics.org/2019/08/28/you-can-replicate-almost-any-plot-with-ggplot2/
I am trying to overlap the current heatmap for rate continuous variable with Vaccine factor (binary) variable.
2 questions:
1-Instead of the vertical line, let's say I want to transform the colour of my heat map to be more pink ("palevioletred1") when Vaccine ==1 and grey ("gray95") otherwise (Vaccine=0).
2-I included colour = Vaccine in the gglot to get the bar outline showing pink when Vaccine ==1, but by including it, I saw no difference.
Any ideas on how to do 1 or 2? Thanks in advance.
Code below:
library(tidyverse)
library(dslabs)
data(us_contagious_diseases)
the_disease <- "Measles"
dat <- us_contagious_diseases %>%
filter(!state%in%c("Hawaii","Alaska") & disease == the_disease) %>%
mutate(rate = count / population * 10000 * 52 / weeks_reporting)
dat1 <- dat
levels(dat1$state) <- c("State1_1","State1_2","State1_3","State1_4","State1_5","State1_6","State1_7","State1_8","State1_9","State1_10",
"State1_11","State1_12","State1_13","State1_14","State1_15","State1_16","State1_17","State1_18","State1_19","State1_20",
"State1_21","State1_22","State1_23","State1_24","State1_25","State1_26","State1_27","State1_28","State1_29","State1_30",
"State1_31","State1_32","State1_33","State1_34","State1_35","State1_36","State1_37","State1_38","State1_39","State1_40",
"State1_41","State1_42","State1_43","State1_44","State1_45","State1_46","State1_47","State1_48","State1_49","State1_50","State1_51")
dat2 <- dat
levels(dat2$state) <- c("State2_1","State2_2","State2_3","State2_4","State2_5","State2_6","State2_7","State2_8","State2_9","State2_10",
"State2_11","State2_12","State2_13","State2_14","State2_15","State2_16","State2_17","State2_18","State2_19","State2_20",
"State2_21","State2_22","State2_23","State2_24","State2_25","State2_26","State2_27","State2_28","State2_29","State2_30",
"State2_31","State2_32","State2_33","State2_34","State2_35","State2_36","State2_37","State2_38","State2_39","State2_40",
"State2_41","State2_42","State2_43","State2_44","State2_45","State2_46","State2_47","State2_48","State2_49","State2_50","State2_51")
dat3 <- dat
levels(dat3$state) <- c("State3_1","State3_2","State3_3","State3_4","State3_5","State3_6","State3_7","State3_8","State3_9","State3_10",
"State3_11","State3_12","State3_13","State3_14","State3_15","State3_16","State3_17","State3_18","State3_19","State3_20",
"State3_21","State3_22","State3_23","State3_24","State3_25","State3_26","State3_27","State3_28","State3_29","State3_30",
"State3_31","State3_32","State3_33","State3_34","State3_35","State3_36","State3_37","State3_38","State3_39","State3_40",
"State3_41","State3_42","State3_43","State3_44","State3_45","State3_46","State3_47","State3_48","State3_49","State3_50","State3_51")
dat4 <- dat
levels(dat4$state) <- c("State4_1","State4_2","State4_3","State4_4","State4_5","State4_6","State4_7","State4_8","State4_9","State4_10",
"State4_11","State4_12","State4_13","State4_14","State4_15","State4_16","State4_17","State4_18","State4_19","State4_20",
"State4_21","State4_22","State4_23","State4_24","State4_25","State4_26","State4_27","State4_28","State4_29","State4_30",
"State4_31","State4_32","State4_33","State4_34","State4_35","State4_36","State4_37","State4_38","State4_39","State4_40",
"State4_41","State4_42","State4_43","State4_44","State4_45","State4_46","State4_47","State4_48","State4_49","State4_50","State4_51")
dat5 <- dat
levels(dat5$state) <- c("State5_1","State5_2","State5_3","State5_4","State5_5","State5_6","State5_7","State5_8","State5_9","State5_10",
"State5_11","State5_12","State5_13","State5_14","State5_15","State5_16","State5_17","State5_18","State5_19","State5_20",
"State5_21","State5_22","State5_23","State5_24","State5_25","State5_26","State5_27","State5_28","State5_29","State5_30",
"State5_31","State5_32","State5_33","State5_34","State5_35","State5_36","State5_37","State5_38","State5_39","State5_40",
"State5_41","State5_42","State5_43","State5_44","State5_45","State5_46","State5_47","State5_48","State5_49","State5_50","State5_51")
dat <- rbind(dat,dat1,dat2,dat3,dat4,dat5)
dat$Vaccine <- 0
dat$Vaccine[dat$year >= 1963] <- 1
dat$Vaccine <- as.factor(dat$Vaccine)
jet.colors <- colorRampPalette(c("#F0FFFF", "cyan", "#007FFF", "yellow", "#FFBF00", "orange", "red", "#7F0000"), bias = 2.25)
dat %>% mutate(state = reorder(state, desc(state))) %>%
ggplot(aes(year, state, fill = rate, colour= Vaccine)) +
geom_tile(color = "white", size = 0.35) +
scale_x_continuous(expand = c(0,0)) +
scale_fill_gradientn(colors = jet.colors(16), na.value = 'white') +
geom_vline(xintercept = 1963, col = "black") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = 'off') +
ggtitle(the_disease) +
ylab("") +
xlab("") +
theme(legend.position = "bottom", text = element_text(size = 8)) +
annotate(geom = "text", x = 1963, y = 50.5, label = "Vaccine introduced", size = 3, hjust = 0)
Option 1
Use annotate to add a transluscent rectangle.
dat %>% mutate(state = reorder(state, desc(state))) %>%
ggplot(aes(year, state, fill = rate)) +
geom_tile(color = "white", size = 0.35) +
annotate("rect", xmin = 1963, xmax = Inf, ymin = -Inf, ymax = Inf,
alpha = 0.2, fill = "palevioletred1") +
scale_x_continuous(expand = c(0,0)) +
scale_fill_gradientn(colors = jet.colors(16), na.value = 'white') +
geom_vline(xintercept = 1963, col = "black") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = 'off') +
ggtitle(the_disease) +
ylab("") +
xlab("") +
theme(legend.position = "bottom", text = element_text(size = 8)) +
annotate(geom = "text", x = 1963, y = 50.5,
label = "Vaccine introduced", size = 3, hjust = 0)
Option 2
You can use scale_color_manual. Just ensure your Vaccine column is genuinely a factor variable with levels "0" and "1"
dat %>% mutate(state = reorder(state, desc(state))) %>%
ggplot(aes(year, state, fill = rate)) +
geom_tile(aes(color = Vaccine), size = 0.35) +
scale_color_manual(values = c('0' = "white", '1' = "pink")) +
scale_x_continuous(expand = c(0,0)) +
scale_fill_gradientn(colors = jet.colors(16), na.value = 'white') +
geom_vline(xintercept = 1963, col = "black") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = 'off') +
ggtitle(the_disease) +
ylab("") +
xlab("") +
theme(legend.position = "bottom", text = element_text(size = 8)) +
annotate(geom = "text", x = 1963, y = 50.5, label = "Vaccine introduced",
size = 3, hjust = 0) +
guides(color = guide_legend(override.aes = list(fill = "white")))
For what it's worth, I prefer option 1
Update
If you want multiple vaccine starting points you can do this too:
dat %>% mutate(state = reorder(state, desc(state))) %>%
ggplot(aes(year, state, fill = rate)) +
geom_tile(color = "white", size = 0.35) +
annotate("rect", xmin = 1963, xmax = Inf, ymin = 25, ymax = 50,
alpha = 0.2, fill = "palevioletred1") +
annotate("rect", xmin = 1975, xmax = Inf, ymax = 25, ymin= 0,
alpha = 0.2, fill = "palevioletred1") +
scale_x_continuous(expand = c(0,0)) +
scale_fill_gradientn(colors = jet.colors(16), na.value = 'white') +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = 'off') +
ggtitle(the_disease) +
ylab("") +
xlab("") +
theme(legend.position = "bottom", text = element_text(size = 8)) +
annotate(geom = "text", x = 1963, y = 50.5,
label = "Vaccine introduced", size = 3, hjust = 0)
I am trying to fill with the same colour as the lines the data of the histograms shown in the figure below, I am using the following code. I have tried many things using fill, scale_fill_manual but without success. Any idea in how to correct this?
(stations = unique(DSF_moments$Station))
(station_cols = scales::hue_pal()(length(stations)))
(names(station_cols) = sort(stations))
for (i in 1:length(listDF2))
{
df1 <- as.data.frame(listDF2[[i]])
df1[is.na(df1)] <- 0
plot1 <- ggplot(df1, aes(x = Date, y = DailyMeanStreamflow, colour=Station)) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Daily Mean Streamflow", y = "Q[m3/s/Day]", x = "Date") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_color_manual(values = station_cols)
plot2 <- ggplot(df1, aes(DailyMeanStreamflow, colour=Station)) +
geom_histogram(show.legend = FALSE) +
labs(title = "Daily Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Day]")+
scale_colour_manual(values = station_cols) + scale_fill_manual(values = station_cols)
(Monthly_Streamflow_Station <- df1 %>% group_by(month) %>% summarise(Monthly_Streamflow_Station = mean(DailyMeanStreamflow, na.rm=TRUE)))
plot3 <- ggplot(Monthly_Streamflow_Station, aes(x = month, y = Monthly_Streamflow_Station, colour=unique(df1$Station))) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Monthly Mean Streamflow", y = "Q[m3/s/Month]", x = "Month") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_x_continuous (breaks=seq(1,12,by=1)) +
scale_color_manual(values = station_cols)
plot4 <- ggplot(Monthly_Streamflow_Station, aes(Monthly_Streamflow_Station, colour=unique(df1$Station))) +
geom_histogram(show.legend = FALSE) +
labs(title = "Monthly Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Month]") +
scale_colour_manual(values = station_cols)
(Annual_Streamflow_Station <- df1 %>% group_by(year) %>% summarise(Annual_Streamflow_Station = mean(DailyMeanStreamflow, na.rm=TRUE)))
plot5 <- ggplot(Annual_Streamflow_Station, aes(x = year, y = Annual_Streamflow_Station, colour=unique(df1$Station))) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Annual Mean Streamflow", y = "Q[m3/s/Year]", x = "Year") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_color_manual(values = station_cols)
plot6 <- ggplot(Annual_Streamflow_Station, aes(Annual_Streamflow_Station,colour=unique(df1$Station))) +
geom_histogram(show.legend = FALSE) +
labs(title = "Annual Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Year]") +
scale_colour_manual(values = station_cols)
grid.arrange(grobs=list(plot1, plot2, plot3, plot4, plot5, plot6), ncol = 2, nrow = 3)
name5<- paste("Plots","_", siteNumber[i], ".png", sep="")
g <- arrangeGrob(plot1, plot2, plot3, plot4, plot5, plot6, ncol = 2, nrow = 3)
ggsave(g,filename = name5,width=22,height=11,units="in",dpi=500)
dev.off()
}
Try this change on your loop. No output produced due to lack of data. I have also changed scale_color_*() by scale_fill_*() where necesssary as said by great #aosmith that histograms require filling option enabled:
#Code
for (i in 1:length(listDF2))
{
df1 <- as.data.frame(listDF2[[i]])
df1[is.na(df1)] <- 0
plot1 <- ggplot(df1, aes(x = Date, y = DailyMeanStreamflow, colour=Station)) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Daily Mean Streamflow", y = "Q[m3/s/Day]", x = "Date") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_color_manual(values = station_cols)
plot2 <- ggplot(df1, aes(DailyMeanStreamflow, fill=Station)) +
geom_histogram(show.legend = FALSE) +
labs(title = "Daily Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Day]")+
scale_fill_manual(values = station_cols)
(Monthly_Streamflow_Station <- df1 %>% group_by(month) %>% summarise(Monthly_Streamflow_Station = mean(DailyMeanStreamflow, na.rm=TRUE)))
plot3 <- ggplot(Monthly_Streamflow_Station, aes(x = month, y = Monthly_Streamflow_Station, colour=unique(df1$Station))) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Monthly Mean Streamflow", y = "Q[m3/s/Month]", x = "Month") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_x_continuous (breaks=seq(1,12,by=1)) +
scale_color_manual(values = station_cols)
plot4 <- ggplot(Monthly_Streamflow_Station,
aes(Monthly_Streamflow_Station,
fill=unique(df1$Station))) +
geom_histogram(show.legend = FALSE) +
labs(title = "Monthly Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Month]") +
scale_fill_manual(values = station_cols)
(Annual_Streamflow_Station <- df1 %>% group_by(year) %>% summarise(Annual_Streamflow_Station = mean(DailyMeanStreamflow, na.rm=TRUE)))
plot5 <- ggplot(Annual_Streamflow_Station, aes(x = year, y = Annual_Streamflow_Station, colour=unique(df1$Station))) +
geom_line(size = 1, show.legend = FALSE) +
geom_point(size=1.5, shape=21, fill="white",na.rm = TRUE, show.legend = FALSE)+
labs(title = "Annual Mean Streamflow", y = "Q[m3/s/Year]", x = "Year") +
theme(plot.title = element_text(size=16), axis.text.y = element_text(size=11), axis.text.x = element_text(size=11)) +
scale_color_manual(values = station_cols)
plot6 <- ggplot(Annual_Streamflow_Station,
aes(Annual_Streamflow_Station,
fill=unique(df1$Station))) +
geom_histogram(show.legend = FALSE) +
labs(title = "Annual Mean Streamflow Histogram", y = "Frequency", x="Q[m3/s/Year]") +
scale_fill_manual(values = station_cols)
grid.arrange(grobs=list(plot1, plot2, plot3, plot4, plot5, plot6), ncol = 2, nrow = 3)
name5<- paste("Plots","_", siteNumber[i], ".png", sep="")
g <- arrangeGrob(plot1, plot2, plot3, plot4, plot5, plot6, ncol = 2, nrow = 3)
ggsave(g,filename = name5,width=22,height=11,units="in",dpi=500)
dev.off()
}
So, I have the two dataframes that produces two ggplots with the same facet that I want to combine
The first dataframe produces the following ggplot
Dataframe1
library(ggh4x)
library(ggnomics)
library(ggplot2)
library(data.table)
#dataframe
drug <- c("DrugA","DrugB1","DrugB2","DrugB3","DrugC1","DrugC2","DrugC3","DrugC4")
PR <- c(18,430,156,0,60,66,113,250)
GR <- c(16,425,154,0,56,64,111,248)
PS <- c(28,530,256,3,70,76,213,350)
GS <- c(26,525,254,5,66,74,211,348)
group<-c("n=88","n=1910","n=820","n=8","n=252","n=280","n=648","n=1186")
class<-c("Class A","Class B","Class B","Class B","Class C","Class C","Class C","Class C")
df <-data.frame(drug,group, class,PR,GR,PS,GS)
#make wide to long df
df.long <- melt(setDT(df), id.vars = c("drug","group","class"), variable.name = "type")
#Order of variables
df.long$type <- factor(df.long$type, levels=c("PR","GR","PS","GS"))
df.long$class <- factor(df.long$class, levels= c("Class B", "Class A", "Class C"))
df.long$group <- factor(df.long$group, levels= c("n=1910","n=820","n=8","n=88","n=252","n=280","n=648","n=1186"))
df.long$drug <- factor(df.long$drug, levels= c("DrugB1","DrugB2","DrugB3","DrugA","DrugC1","DrugC2","DrugC3","DrugC4"))
Ggplot for dataframe 1
ggplot(df.long, aes(fill = type, x = drug, y = value)) +
geom_bar(aes(fill = type), stat = "identity", position = "dodge", colour="white") +
geom_text(aes(label = value), position = position_dodge(width = 1.2), vjust = -0.5)+
scale_fill_manual(values = c("#fa9fb5","#dd1c77","#bcbddc","756bb1")) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 600)) +
theme(title = element_text(size = 18),
legend.text = element_text(size = 12),
axis.text.x = element_text(size = 9),
axis.text.y =element_text(size = 15),
plot.title = element_text(hjust = 0.5)) +
ggh4x::facet_nested(.~class + group, scales = "free_x", space= "free_x")
This is the 2nd dataframe
#dataframe 2
drug <- c("DrugA","DrugB1","DrugB2","DrugB3","DrugC1","DrugC2","DrugC3","DrugC4")
Sens <- c(0.99,0.97,NA,0.88,0.92,0.97,0.98,0.99)
Spec <- c(1,0.99,1,0.99,0.99,0.99,0.99,1)
class<-c("Class A","Class B","Class B","Class B","Class C","Class C","Class C","Class C")
df2 <-data.frame(drug,class,Sens,Spec)
#wide to long df2
df2.long <- melt(setDT(df2), id.vars = c("drug","class"), variable.name = "type")
#additional variables
df2.long$UpperCI <- c(0.99,0.99,NA,0.98,0.98,0.99,0.99,0.99,1,1,1,1,1,1,1,1)
df2.long$LowerCI <- c(0.97,0.98,NA,0.61,0.83,0.88,0.93,0.97,0.99,0.99,0.99,0.99,0.98,0.99,0.99,0.99)
#order of variables
df2.long$class <- factor(df2.long$class, levels= c("Class B", "Class A", "Class C"))
Ggplot for dataframe 2
ggplot(df2.long, aes(x=drug, y=value, group=type, color=type)) +
geom_line() +
geom_point()+
geom_errorbar(aes(ymin=LowerCI, ymax=UpperCI), width=.2,
position=position_dodge(0.05)) +
scale_y_continuous(labels=scales::percent)+
labs(x="drug", y = "Percentage")+
theme_classic() +
scale_color_manual(values=c('#999999','#E69F00')) +
theme(legend.text=element_text(size=12),
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"))+
facet_wrap(facets = vars(class),scales = "free_x")
So I am trying to combine the two plots under the one facet (the one from dataframe 1), and so far I have done the following
ggplot(df.long)+
aes(x=drug, y=value,fill = type)+
geom_bar(, stat = "identity", position = "dodge", colour="white") +
geom_text(aes(label=value), position=position_dodge(width=0.9), vjust=-0.5, size=2) +
scale_fill_manual(breaks=c("PR","GR","PS","GS"),
values=c("#dd1c77","#756bb1","#fa9fb5","#e7e1ef","black","black")) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1100),sec.axis=sec_axis(~./10, labels = function(b) { paste0(b, "%")},name="Percentage")) + #remove space between x axis labels and bottom of chart
theme(legend.text=element_text(size=12),
legend.position = 'bottom',
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"), #color of plot background
panel.border = element_blank(), #remove border panels of each facet
strip.background = element_rect(colour = NA)) + #remove border of strip
labs(y = "Number of isolates", fill = "")+
geom_errorbar(data=df2.long,aes(x=drug, y=value*1000,ymin=LowerCI*1000, ymax=UpperCI*1000,color=type), width=.2,
position=position_dodge(0.05))+
geom_point(data=df2.long,aes(x=drug,y=value*1000,color=type),show.legend = F)+
geom_line(data=df2.long, aes(x=drug, y=value*1000, group=type, color=type)) +
scale_color_manual(values=c('#999999','#E69F00'))
but I'm stuck on adding the facet from the plot1. I hope anyone can help :)
For this specific case, I don't think the nested facets are the appropriate solution as the n = ... seems metadata of the x-axis group instead of a subcategory of the classes.
Here is how you could plot the data with facet_grid() instead:
ggplot(df.long, aes(drug, value, fill = type)) +
geom_col(position = "dodge") +
geom_text(aes(label = value),
position = position_dodge(0.9),
vjust = -0.5, size = 2) +
geom_errorbar(data = df2.long,
aes(y = value * 1000, color = type,
ymin = LowerCI * 1000, ymax = UpperCI * 1000),
position = position_dodge(0.05), width = 0.2) +
geom_point(data = df2.long,
aes(y = value * 1000, color = type),
show.legend = FALSE) +
geom_line(data = df2.long,
aes(y = value * 1000, group = type, color = type)) +
scale_fill_manual(breaks = c("PR", "GR", "PS", "GS"),
values=c("#dd1c77","#756bb1","#fa9fb5","#e7e1ef","black","black")) +
scale_color_manual(values=c('#999999','#E69F00')) +
scale_y_continuous(expand = c(0, 0), limits = c(0, 1100),
sec.axis = sec_axis(~ ./10,
labels = function(b) {
paste0(b, "%")
}, name = "Percentage")) +
scale_x_discrete(
labels = levels(interaction(df.long$drug, df.long$group, sep = "\n"))
) +
facet_grid(~ class, scales = "free_x", space = "free_x") +
theme(legend.text=element_text(size=12),
legend.position = 'bottom',
axis.text.x=element_text(size=9),
axis.text.y =element_text(size=15),
panel.background = element_rect(fill = "whitesmoke"), #color of plot background
panel.border = element_blank(), #remove border panels of each facet
strip.background = element_rect(colour = NA))
If you insist on including the n = ... labels, perhaps a better way is to add these as text somehwere, i.e. adding the following:
stat_summary(fun = sum,
aes(group = drug, y = stage(value, after_stat = -50),
label = after_stat(paste0("n = ", y))),
geom = "text") +
And setting the y-axis limits to c(-100, 1000) for example.