Garden bird watch
h <- here::here("E011/data")
df1 <- read_rds("gb.rds")
df2 <- read_rds("bto_data.rds")
a <- df2 %>%
filter(year %in% c(1995, 2019), !spcode %in% c("houma", "swift", "bullf")) %>%
group_by(spcode) %>%
mutate(change = 100 * (sm[2]/sm[1] -1)) %>%
select(spcode, change) %>%
mutate(sc = ifelse(spcode %in% c("grefi", "starl", "housp"), "red",
ifelse(spcode %in% c("swift",
"houma", "dunno",
"sonth"), "amber", "green" ))) %>%
mutate(spcode = case_when(spcode == "bluti" ~ "Blue Tit",
spcode == "chaff" ~ "Chaffinch",
spcode == "housp" ~ "House Sparrow",
spcode == "grefi" ~ "Greenfinch",
spcode == "sonth" ~ "Song Thrush",
spcode == "goldf" ~ "Goldfinch",
spcode == "grswo" ~ "Gt Sp Woodpecker",
spcode == "starl" ~ "Starling",
spcode == "dunno" ~ "Dunnock",
spcode == "greti" ~ "Great Tit",
spcode == "blabi" ~ "Blackbird",
spcode == "jackd" ~ "Jackdaw",
spcode == "wren." ~ "Wren",
spcode == "lotti" ~ "Long-tailed Tit",
spcode == "carcr" ~ "Carrion Crow",
spcode == "robin" ~ "Robin",
spcode == "coati" ~ "Coal Tit",
spcode == "magpi" ~ "Magpie",
spcode == "coldo" ~ "Collared Dove",
spcode == "woodp" ~ "Woodpigeon"
)) %>%
distinct() %>%
ggplot(aes(reorder(spcode, change), change)) +
#geom_point() +
geom_col(aes(fill = sc)) +
coord_flip() +
scale_fill_manual(values = c("goldenrod", "darkgreen", "red"), name = "Red-list\nstatus") +
theme_minimal() +
theme(plot.title.position = "plot",
plot.title = element_text(face = "bold", size = 24),
plot.subtitle = element_text(size = 16),
axis.text = element_text(size = 12),
axis.title = element_text(size = 16),
legend.text = element_text(size = 12),
legend.title = element_text(size = 14),
plot.caption = element_text(size = 12),
plot.caption.position = "panel") +
labs(x = "",
y = "Change between 1995 and 2019",
caption = "Sources: BTO BirdTrends",
title = "Relative change in abundance",
subtitle = "Bars coloured by current red-list status")
a
unique(df2$spcode)
## [1] "blabi" "bluti" "bullf" "carcr" NA "chaff" "coati" "coldo" "dunno"
## [10] "goldf" "greti" "grefi" "grswo" "housp" "houma" "jackd" "lotti" "magpi"
## [19] "robin" "sonth" "starl" "swift" "woodp" "wren."
g <- df2 %>%
filter(year > 1994) %>%
group_by(spcode) %>%
select(year, sm, spcode) %>%
fill(sm, .direction = "up") %>%
arrange(spcode, desc(year)) %>%
mutate(trend = sm/sm[25] * 100) %>%
mutate(sc = ifelse(spcode %in% c("grefi", "starl", "housp"), "red",
ifelse(spcode %in% c("swift",
"houma", "dunno",
"sonth"), "amber", "green" )))
g %>%
filter(spcode %in% c("bluti", "chaff", "goldf", "greti", "grefi", "grswo", "housp", "sonth", "starl", "dunno", "blabi")) %>%
mutate(spcode = case_when(spcode == "bluti" ~ "Blue Tit",
spcode == "chaff" ~ "Chaffinch",
spcode == "housp" ~ "House Sparrow",
spcode == "grefi" ~ "Greenfinch",
spcode == "sonth" ~ "Song Thrush",
spcode == "goldf" ~ "Goldfinch",
spcode == "grswo" ~ "Gt Sp Woodpecker",
spcode == "starl" ~ "Starling",
spcode == "dunno" ~ "Dunnock",
spcode == "greti" ~ "Great Tit",
spcode == "blabi" ~ "Blackbird"
)) %>%
ggplot(aes(year, trend, group = spcode, colour = sc)) +
stat_smooth(aes(label = spcode), show.legend = FALSE,
geom = "textpath",
hjust = 1.11,
vjust = 0.5,
lwd = 4) +
#geom_text_repel(aes(label = spcode, year, trend), data = end, nudge_x = 2, show.legend = FALSE) +
geom_hline(yintercept = 100, lty = "dotted") +
theme(plot.background = element_rect(fill = "white"),
panel.background = element_rect(fill = "white")) +
#panel.grid = element_blank()) +
scale_color_manual(values = c("goldenrod", "darkgreen", "red")) +
labs(title = "Relative change in selected species abundance since 1995",
subtitle = "Smoothed data",
y = "Relative change",
x = "Year",
caption = "Baseline year 1995: 100\nSource: BTO Trends") +
theme_minimal() +
theme(plot.title.position = "plot",
plot.title = element_text(size = 16, face = "bold"),
axis.text = element_text(size = 12),
axis.title = element_text(size = 14)) +
ylim(c(10, 240)) +
xlim(c(1995, 2024)) +
scale_y_continuous(position = "right", n.breaks = 6)
## Scale for 'y' is already present. Adding another scale for 'y', which will
## replace the existing scale.
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
min_max <- data.frame(
sp = c("cf", "gbfs_blue_tit", "gbfs_gsw", "gdf", "gf", "sthrush", "gbfs_house_sparrow", "grtit", "starl"),
min = c(31.5, 83.3, 6.6, 6.9, 23.3, 3.2, 56.9, 62.3, 31.1),
max = c(85.8, 97, 33.4, 71.2, 82.7, 55.3, 88.6, 86.1, 84)
)
df1 <- df1 %>%
left_join(min_max) %>%
janitor::remove_empty() %>%
group_by(sp) %>%
mutate(scale = (max(rate) - min(rate))/(max - min),
maxr = max(rate),
z = maxr - rate,
a = z/scale,
b = a + min,
sp1 = case_when(str_detect(sp, "blue") ~ "Blue tit",
str_detect(sp, "house") ~ "House sparrow",
str_detect(sp, "cf") ~ "Chaffinch",
str_detect(sp, "gf") ~ "Greenfinch",
str_detect(sp, "gsw") ~ "Great spotted woodpecker",
str_detect(sp, "sthrush") ~ "Song thrush",
str_detect(sp, "grtit") ~ "Great tit",
str_detect(sp, "gdf") ~ "Goldfinch",
str_detect(sp, "starl") ~ "Starling"))
## value for "which" not specified, defaulting to c("rows", "cols")
## Joining, by = "sp"
df1 <- df1 %>%
group_by(sp1) %>%
mutate(date1 = rep(c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep","Oct", "Nov", "Dec"),
length.out = 326),
year = rep(1995:2022, each = 12, length.out = 326),
date2 = paste(year = year, month = date1, day = "01", sep = "-"),
date2 = lubridate::ymd(date2))
df1 %>%
ggplot(aes(date2, b, group = sp1)) +
stat_smooth(
aes(label = sp1),
geom = "textpath",
color = "red",
linecolor = "navyblue",
hjust = 1,
size = rel(2)
) +
#geom_line(aes(date2, b), data = df %>% filter(sp == "Greenfinch")) +
labs(
title = "Smoothed trend in proportion of gardens visited",
y = "% gardens",
x = "Year",
caption = "Source: BTO Garden Birdwatch Survey"
) +
theme(
panel.background = element_rect("#EDF2BD"),
legend.position = "",
panel.grid.minor = element_blank()
) +
#scale_x_date(breaks = "2 years") +
scale_y_continuous(position = "right") +
theme(axis.text.x = element_text(angle = 0, hjust = 0.5),
plot.title.position = "plot",
plot.title = element_text(face = "bold", size = 14))
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
