Reproductive cover class
Chelsey Wegener
11 May, 2021
Using Daubenmire cover class, I would assign a number 1-6 to each quadrat to estimate the percent cover of reproductive apices.
Class Estimated Percent Cover
1 0-5
2 5-25
3 25-50
4 50-75
5 75-100
Here I graph the percent of these classes per month per site. First I subset the data and make new dataframes that count the frequency of each class. Then I graph this as a percent. I’m not sure what to title this graph as.
Removing legend: https://www.datanovia.com/en/blog/how-to-remove-legend-from-a-ggplot/
Ended up doing “common legend” on ggarrange but this is still good to know
Set-up
rm(list=ls())
library(ggplot2)
library(ggpubr)
library(scales)
library(lubridate)
library(readr)
library(dplyr)
library(chron)
library(plotly)
library(dplyr)
library(tidyr) Setting up
#read in data
alldata<-read.csv(
"https://raw.githubusercontent.com/Cmwegener/thesis/master/data/field/CB_field_data_10.12.2020.csv",
header = TRUE
)
#format
alldata$date<-as.Date(alldata$date, format = c("%m/%d/%Y"))
alldata$covcl.repro<-as.factor(alldata$covcl.repro)
#subset
HS<-subset(alldata, site.old == "HS")
BY<-subset(alldata, site.old == "BY")
ND<-subset(alldata, site.old == "ND")
PC<-subset(alldata, site.old == "PC")Creating frequency tables as a new dataframe
hsfreq<-data.frame(table(HS$date,HS$covcl.repro))
byfreq<-data.frame(table(BY$date,BY$covcl.repro))
ndfreq<-data.frame(table(ND$date,ND$covcl.repro))
pcfreq<-data.frame(table(PC$date,PC$covcl.repro))Change column names of new data frame and convert date column to date
names(hsfreq)[1] <- "date"
names(byfreq)[1] <- "date"
names(ndfreq)[1] <- "date"
names(pcfreq)[1] <- "date"
names(hsfreq)[2] <- "class"
names(byfreq)[2] <- "class"
names(ndfreq)[2] <- "class"
names(pcfreq)[2] <- "class"
hsfreq$date<-as.Date(hsfreq$date, format = c("%Y-%m-%d"))
byfreq$date<-as.Date(byfreq$date, format = c("%Y-%m-%d"))
ndfreq$date<-as.Date(ndfreq$date, format = c("%Y-%m-%d"))
pcfreq$date<-as.Date(pcfreq$date, format = c("%Y-%m-%d"))Graph: don’t like the default colors
a <- ggplot(hsfreq, aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") + ggtitle("Horseshoe Bay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") + theme(plot.title = element_text(size = 20, face = "plain")) +
theme(
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain")
) + ylab(" ") + xlab(" ") + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
)
b <- ggplot(byfreq, aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") + ggtitle("Brickyard Park") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") + theme(plot.title = element_text(size = 20, face = "plain")) +
theme(
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain")
) + ylab(" ") + xlab(" ") + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
)
c <- ggplot(ndfreq, aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") + ggtitle("Point Chauncy") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") + theme(plot.title = element_text(size =20, face = "plain")) +
theme(
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain")
) + ylab(" ") + xlab(" ") + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
)
d <- ggplot(pcfreq, aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") + ggtitle("Paradise Cay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") + theme(
axis.text.x = element_text(angle = 60, hjust = 1),
plot.title = element_text(size = 20, face = "plain")
) + theme(axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain")) + ylab(" ") + xlab(" ") + theme(
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
)
figure <- ggarrange(d, c, b, a, ncol = 4, nrow = 1)## Warning: Removed 10 rows containing missing values (geom_bar).## Warning: Removed 5 rows containing missing values (geom_bar).annotate_figure(
figure,
left = text_grob(
"Percent reproductive cover class",
color = "black",
rot = 90,
size = 25,
face="bold"
)
)
Greyscale: hard to tell the difference between the 5 shades of grey
hsfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") +
scale_fill_grey()+
ggtitle("Horseshoe Bay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")) +
ylab(" ") + xlab(" ") 
Gradient: gradient of a single color so the darker the color, the more reproductive. I like it more but it’s hard to make out the lightest color
hsfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity") +
scale_fill_brewer(palette="Blues")+
ggtitle("Horseshoe Bay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")) +
ylab(" ") + xlab(" ") 
Outline bar: outlining the bar so that you can see the lightest color better
hsfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill", stat = "identity", color="black") +
scale_fill_brewer(palette="Blues")+
ggtitle("Horseshoe Bay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")) +
ylab(" ") + xlab(" ") 
Formatting all graphs like that, changing the y-axis to percent format, adding common legend
a <-
hsfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill",
stat = "identity",
color = "black",
show.legend = TRUE) +
scale_y_continuous(labels = scales::percent)+
scale_fill_brewer(palette = "Blues") +
ggtitle("Horseshoe Bay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
) +
ylab(" ") + xlab(" ")
b<-
byfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill",
stat = "identity",
color = "black",
show.legend = TRUE) +
scale_y_continuous(labels = scales::percent)+
scale_fill_brewer(palette = "Blues") +
ggtitle("Brickyard Park") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
) +
ylab(" ") + xlab(" ")
c<-
ndfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill",
stat = "identity",
color = "black",
show.legend = TRUE) +
scale_y_continuous(labels = scales::percent)+
scale_fill_brewer(palette = "Blues") +
ggtitle("Point Chauncy") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
) +
ylab(" ") + xlab(" ")
d<-
pcfreq %>% ggplot(aes(fill = class, y = Freq, x = date)) +
geom_bar(position = "fill",
stat = "identity",
color = "black",
show.legend = TRUE) +
scale_fill_brewer(palette = "Blues") +
scale_y_continuous(labels = scales::percent)+
ggtitle("Paradise Cay") +
scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
theme(
plot.title = element_text(size = 20, face = "plain"),
axis.text.x = element_text(angle = 60, hjust = 1),
axis.text = element_text(size = 20),
axis.title = element_text(size = 20, face = "plain"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.background = element_blank(),
axis.line = element_line(colour = "black")
) +
ylab(" ") + xlab(" ")
figure <- ggarrange(d, c, b, a, ncol = 4, nrow = 1, common.legend = TRUE)## Warning: Removed 10 rows containing missing values (geom_bar).
## Warning: Removed 10 rows containing missing values (geom_bar).## Warning: Removed 5 rows containing missing values (geom_bar).annotate_figure(
figure,
left = text_grob(
"Percent reproductive cover class",
color = "black",
rot = 90,
size = 25,
face="bold"
)
)
Across all sites and all months there is only one survey (Paradise Cay August 2018) that is 100% the lowest repro class