Marked Herd Plots
JM Weissman
November 27, 2018
This contains the code to produce plots of Sierra Bighorn population trends. Specifically, these plots are designed to illustrate how the marked populations have changed relative to the herd populations, and how these trends have varied between herds.
This document is intended to be used to produce population plots and to provide templates for future plots.
Requirements:
library("tidyverse")## -- Attaching packages ------------------------------------------------------------------------------------------ tidyverse 1.2.1 --## v ggplot2 3.1.0 v purrr 0.2.5
## v tibble 1.4.2 v dplyr 0.7.8
## v tidyr 0.8.2 v stringr 1.3.1
## v readr 1.2.1 v forcats 0.3.0## -- Conflicts --------------------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library("ggthemes")Data Import:
# import csv:
marks_tbl <- read_csv("Overview_Collars.csv")## Parsed with column specification:
## cols(
## `Sheep Year` = col_double(),
## Herd = col_character(),
## Sex = col_character(),
## `%Marks` = col_double(),
## `%VHF` = col_double(),
## `%GPS` = col_double(),
## Marks = col_double(),
## GPS = col_double(),
## VHF = col_double()
## )# replace problem characters in column names:
names(marks_tbl) <- gsub(" ", "_", names(marks_tbl))
names(marks_tbl) <- gsub("%", "percent_", names(marks_tbl))
summary(marks_tbl)## Sheep_Year Herd Sex percent_Marks
## Min. :2010 Length:186 Length:186 Min. :0.0000
## 1st Qu.:2012 Class :character Class :character 1st Qu.:0.2500
## Median :2014 Mode :character Mode :character Median :0.4400
## Mean :2014 Mean :0.4973
## 3rd Qu.:2016 3rd Qu.:0.6000
## Max. :2017 Max. :6.0000
## NA's :21
## percent_VHF percent_GPS Marks GPS
## Min. :0.0000 Min. :0.0000 Min. : 0.00 Min. : 0.000
## 1st Qu.:0.1800 1st Qu.:0.0700 1st Qu.: 3.00 1st Qu.: 1.000
## Median :0.3300 Median :0.1400 Median : 6.00 Median : 2.000
## Mean :0.4112 Mean :0.2327 Mean : 7.36 Mean : 3.333
## 3rd Qu.:0.5600 3rd Qu.:0.2500 3rd Qu.:10.75 3rd Qu.: 5.000
## Max. :5.0000 Max. :4.0000 Max. :24.00 Max. :14.000
## NA's :21 NA's :21
## VHF
## Min. : 0.000
## 1st Qu.: 3.000
## Median : 4.000
## Mean : 5.742
## 3rd Qu.: 8.000
## Max. :17.000
## Preliminary Data Processing:
# What % of the population do we want marked?
target_mark_fraction = 0.3
# number of total herds:
n_herds <- dim(unique(marks_tbl['Herd']))[1]
# years over which we have data
years <- seq(min(marks_tbl[['Sheep_Year']]),max(marks_tbl[['Sheep_Year']]))
# Add column for estimated herd total:
marks_tbl <- marks_tbl %>%
mutate(N_est = round(Marks / percent_Marks))
# mean counts
mean_N <- mean(marks_tbl$N_est, na.rm = T)
# new herds:
new_herds = c("Big Arroyo", "Laurel Creek", "Cathedral", "Bubbs Creek", "Olancha Peak")
# Convert to Long Data
nmarks_tbl <- marks_tbl %>% select(Sheep_Year, Herd, Sex, N_est, Marks, GPS, VHF)
nmarks_tbl <- nmarks_tbl %>% mutate(Mark_Target = as.integer(floor(target_mark_fraction * N_est)) )
nmarks_long_tbl <- nmarks_tbl %>%
gather(count_type, n, N_est:Mark_Target) %>%
mutate(count_type = gsub("N_est", "Est_Total", count_type))Now the data is in long format, and we can apply filters and produce plots:
# P1 table: large herds, no vhf, ewes only
p1_tbl <- nmarks_long_tbl %>%
filter(Sex == "Female") %>%
filter(count_type != "VHF") %>%
group_by(Herd) %>%
filter(max(n, na.rm = T) > mean_N)
p1 <- ggplot() +
geom_area(data = p1_tbl %>% filter(count_type != "Mark_Target"),
aes(x=Sheep_Year, y=n, fill=count_type), position = "identity", alpha = 0.8) +
geom_line(data = p1_tbl %>% filter(count_type == "Mark_Target"),
aes(x=Sheep_Year, y=n, col="Mark_Target"), size = 1) +
scale_colour_manual(name = "", values = c("Mark_Target" = "coral3")) +
scale_fill_manual(name = "Counts", values =
c("Est_Total" = "grey",
"Marks" = "cornflowerblue",
"GPS" = "blue4")) +
scale_x_continuous(expand=c(0,0), limits=c(min(years), max(years))) +
scale_y_continuous(expand=c(0,0), limits=c(0, max(p1_tbl$n) + 2)) +
ylab("# of ewes") +
ggtitle("Sierra Bighorn Marks Relative to Population (large herds only)") +
theme(axis.title.x=element_text(size=10, lineheight=.9, face="bold")) +
theme(axis.title.y=element_text(size=10, lineheight=.9, face="bold")) +
facet_wrap(~ Herd, ncol=2)
p1
# p2 table: new herds, no vhf, ewes only
p2_tbl <- nmarks_long_tbl %>%
filter(Sex == "Female") %>%
filter(count_type != "VHF") %>%
filter(Herd %in% new_herds)
p2 <- ggplot() +
geom_area(data = p2_tbl %>% filter(count_type != "Mark_Target"),
aes(x=Sheep_Year, y=n, fill=count_type), position = "identity", alpha = 0.8) +
geom_line(data = p2_tbl %>% filter(count_type == "Mark_Target"),
aes(x=Sheep_Year, y=n, col="Mark_Target"), size = 1) +
scale_colour_manual(name = "", values = c("Mark_Target" = "coral3")) +
scale_fill_manual(name = "Counts", values =
c("Est_Total" = "grey",
"Marks" = "cornflowerblue",
"GPS" = "blue4")) +
scale_x_continuous(expand=c(0,0), limits=c(min(years), max(years))) +
scale_y_continuous(expand=c(0,0), limits=c(0, max(p2_tbl$n) + 2)) +
ylab("# of ewes") +
ggtitle("Sierra Bighorn Marks Relative to Population (new herds only)") +
theme(axis.title.x=element_text(size=10, lineheight=.9, face="bold")) +
theme(axis.title.y=element_text(size=10, lineheight=.9, face="bold")) +
facet_wrap(~ Herd, ncol=2)
p2## Warning: Removed 1 rows containing missing values (geom_path).