In inbo/abvanalysis: Analysis of the Common Breeding Bird Survey

library(knitr)
opts_chunk$set(
  echo = FALSE, eval = TRUE, cache = FALSE, warning = FALSE, error = FALSE,
  message = TRUE
)
library(digest)
library(git2rdata)
library(tidyverse)
library(scales)
library(effectclass)
library(plotly)
library(pander)
library(INBOtheme)
conflicted::conflicts_prefer(dplyr::pull, plotly::filter, plotly::layout)
output_format <- ifelse(
  interactive(), "html", opts_knit$get("rmarkdown.pandoc.to")
)
output_dir <- ifelse(
  interactive(), file.path("..", "output", "website"),
  opts_knit$get("output.dir")
)
switch(
  output_format,
  html = {
    opts_chunk$set(dev = "png", dpi = 72, fig.height = 8, fig.width = 10.5)
    update_geom_defaults("point", list(size = 4))
    theme_set(theme_inbo(base_size = 14))
  },
  latex = {
    opts_chunk$set(dev = "cairo_pdf")
    update_geom_defaults("point", list(size = 2))
    theme_set(theme_inbo(base_size = 8))
  }, {
    opts_chunk$set(dev = "png", dpi = 72, fig.height = 8, fig.width = 10.5)
    update_geom_defaults("point", list(size = 4))
    theme_set(theme_inbo(base_size = 14))
  }
)
strict <- TRUE
ribbon_opacity <- 0.7
threshold <- 0.75

index_breaks <- function(x) {
  z <- 1 - c(
    9 / 10, 4 / 5, 3 / 4, 2 / 3, 1 / 2, 1 / 3, 1 / 4, 1 / 5, 1 / 10, 1 / 20,
    1 / 50, 1 / 100, 1 / 200, 0
  )
  z <- log(sort(z))
  z <- z[which(z >= min(-abs(x)))[1] + -1:2]
  c(z, 0, -z)
}
index_breaks2 <- function(x) {
  z <- 1 - c(
    9 / 10, 4 / 5, 3 / 4, 2 / 3, 1 / 2, 1 / 3, 1 / 4, 1 / 5, 1 / 10, 1 / 20,
    1 / 50, 1 / 100, 1 / 200, 0
  )
  z <- log(sort(z))
  z <- z[which(z >= min(-abs(x)))[1] + -1:1]
  c(z, 0, -z)
}
index_labels <- function(x) {
  sprintf("%+.0f%%", 100 * (exp(x) - 1))
}
display_trend <- function(mean, lcl, ucl, duration = 1) {
  mean <- 100 * exp(duration * mean) - 100
  lcl <- 100 * exp(duration * lcl) - 100
  ucl <- 100 * exp(duration * ucl) - 100
  upper <- pmax(abs(lcl), abs(ucl))
  magnitude <- floor(log10(upper))
  magnitude <- magnitude - ifelse(upper * 10 ^ -magnitude < 2, 2, 1)
  sprintf(
    "%+g%% (%+g%%; %+g%%)",
    round(mean * 10 ^ -magnitude) * 10 ^ magnitude,
    round(lcl * 10 ^ -magnitude) * 10 ^ magnitude,
    round(ucl * 10 ^ -magnitude) * 10 ^ magnitude
  )
}
c(rev(traffic_palette(7)), "grey65", "grey35", "grey50") %>%
  setNames(
    c("++", "+", "+~", "~", "-~", "-", "--", "?+", "?-", "?")
  ) -> kleurgradient
kleurgradient[4] <- inbo_steun_blauw
periode_labels <- function(x) {
  sprintf("%i - %i", x, x + 2)
}

package_list <- c("R", "git2rdata", "abvanalysis", "n2kanalysis")
references <- readLines("references.bib")
paste(package_list, collapse = "|") %>%
  sprintf(fmt = "^@.+\\{(%s),$") %>%
  grep(references) -> start
end <- grep("^\\}$", references)
lapply(
  start,
  function(i) {
    i:head(end[i < end], 1)
  }
) %>%
  do.call(what = c) -> existing_citation
cite_package <- function(x) {
  citation(ifelse(x == "R", "base", x)) %>%
  toBibtex() %>%
  str_replace("Manual\\{,", paste0("Manual\\{", x, ","))
}
package_list %>%
  map(cite_package) %>%
  c(references[-existing_citation]) %>%
  do.call(what = c) %>%
  writeLines("references.bib")

repo <- system.file("results", package = "abvanalysis")
strata <- read_vc("stratum", root = repo)
effort <- read_vc("effort", root = repo)
read_vc("meta", root = repo) %>%
  mutate(
    speciesgroup = as.character(.data$speciesgroup),
    hash = map_chr(.data$speciesgroup, sha1)
  ) -> meta
estimate <- read_vc("estimate", root = repo)
moving_trend <- read_vc("moving_trend", root = repo)
composite_moving_trend <- read_vc("composite_moving_trend", root = repo)
parent <- read_vc("parent", root = repo)
tribble(
  ~x, ~y, "stabiel", 0, "toename", 1, "afname", -1, "sterke toename", 1.5,
  "sterke afname", -1.5, "matige toename",  0.5, "matige afname", -0.5,
  "mogelijke toename", 0.5, "mogelijke afname", -0.5, "onduidelijk", 0
) %>%
  mutate(
    s = c(rep(0.25, 7), 0.5, 0.5, 1), lcl = qnorm(0.05, .data$y, .data$s),
    ucl = qnorm(0.95, .data$y, .data$s),
    klasse = classification(.data$lcl, .data$ucl, 1)
  ) %>%
  arrange(.data$klasse) %>%
  mutate(
    x = factor(.data$x, levels = rev(.data$x)), x_int = as.integer(.data$x)
  ) -> effect
looptijd <- diff(range(estimate$year))
meta %>%
  inner_join(read_vc("linear_trend", root = repo), by = "analysis") %>%
  transmute(
    .data$hash, .data$analysis, .data$cycle,
    estimate = ifelse(.data$cycle, 1 / 3, 1) %>%
      `*`(.data$estimate),
    lcl = ifelse(.data$cycle, 1 / 3, 1) %>%
      `*`(.data$lower_confidence_limit),
    ucl = ifelse(.data$cycle, 1 / 3, 1) %>%
      `*`(.data$upper_confidence_limit),
    klasse = classification(
      .data$lcl * looptijd, .data$ucl * looptijd, log(threshold)
    ),
    jaarlijks = format_ci(
      exp(.data$estimate) - 1, lcl = exp(.data$lcl) - 1,
      ucl = exp(.data$ucl) - 1, percent = TRUE, sign = TRUE
    ),
    looptijd = format_ci(
      exp(looptijd * .data$estimate) - 1, lcl = exp(looptijd * .data$lcl) - 1,
      ucl = exp(looptijd * .data$ucl) - 1, percent = TRUE, sign = TRUE
    )
  ) %>%
  inner_join(
    effect %>%
      select(.data$klasse, tekst = .data$x),
    by = "klasse"
  ) %>%
  inner_join(
    meta %>%
      filter(!.data$composite) %>%
      select(.data$hash, .data$cycle, .data$linear, .data$waic) %>%
      pivot_wider(names_from = .data$linear, values_from = .data$waic) %>%
      transmute(
        .data$hash, .data$cycle,
        interpretatie = .data$`FALSE` %>%
          `-`(.data$`TRUE`) %>%
          cut(
            breaks = c(-Inf, -2, 0, Inf),
            labels = c("niet-lineair", "mogelijk niet-lineair", "lineair")
          )
      ),
    by = c("hash", "cycle")
  ) -> linear_trend
read_vc("index", root = repo) %>%
  transmute(
    .data$analysis, referentie = .data$reference, periode = .data$alternative,
    .data$estimate, lcl = .data$lower_confidence_limit,
    ucl = .data$upper_confidence_limit,
    wijziging = format_ci(
      exp(.data$estimate) - 1, lcl = exp(.data$lower_confidence_limit) - 1,
      ucl = exp(.data$upper_confidence_limit) - 1, percent = TRUE,
      sign = TRUE
    ),
    klasse = classification(
      .data$lower_confidence_limit, .data$upper_confidence_limit,
      threshold = log(threshold)
    )
  ) %>%
  inner_join(
    effect %>%
      select(.data$klasse, interpretatie = .data$x),
    by = "klasse"
  ) -> index
effort %>%
  distinct(.data$stratum, .data$location) %>%
  count(.data$stratum, name = "onderzocht") %>%
  inner_join(
    strata %>%
      select(stratum = .data$description, totaal = .data$n),
    by = "stratum"
  ) %>%
  inner_join(read_vc("stratum_weight", root = repo), by = "stratum") %>%
  transmute(
    .data$analysis, .data$stratum, gewicht = .data$weight,
    aanwezig = .data$relevant * .data$totaal / .data$onderzocht, .data$relevant,
    .data$onderzocht, .data$totaal, bezoeken = .data$visits,
    punten = (
      .data$points_1 / 6 + .data$points_2 / 3 + .data$points_3 / 2 +
        .data$points_4 * 2 / 3 + .data$points_5 * 5 / 6 + .data$points_6
    ) / .data$relevant
  ) %>%
  arrange(desc(.data$gewicht)) -> stratum
meta %>%
  filter(.data$composite, !.data$cycle, !.data$linear) %>%
  select(.data$speciesgroup, .data$hash, .data$analysis) %>%
  inner_join(parent, by = "analysis") %>%
  inner_join(
    meta %>%
      select(.data$analysis, soort = .data$speciesgroup),
    by = c("parent" = "analysis")
  ) %>%
  select(.data$hash, .data$speciesgroup, .data$soort) %>%
  group_by(.data$hash) %>%
  mutate(drempel = log(threshold) / sqrt(n())) %>%
  ungroup() -> soortenlijst
read_vc("composite_index", root = repo) %>%
  inner_join(
    meta %>%
      select(.data$analysis, .data$hash, .data$speciesgroup),
    by = "analysis"
  ) %>%
  inner_join(
    soortenlijst %>%
      distinct(.data$hash, .data$drempel),
    by = "hash"
  ) %>%
  transmute(
    .data$analysis, referentie = .data$reference, periode = .data$alternative,
    .data$estimate, lcl = .data$lower_confidence_limit,
    ucl = .data$upper_confidence_limit,
    wijziging = format_ci(
      exp(.data$estimate) - 1, lcl = exp(.data$lower_confidence_limit) - 1,
      ucl = exp(.data$upper_confidence_limit) - 1, percent = TRUE,
      sign = TRUE
    ),
    klasse = pmap(
      list(
        .data$lower_confidence_limit, .data$upper_confidence_limit,
        threshold = .data$drempel
      ),
      classification
    ) %>%
      unlist(),
    tmp = as.character(klasse)
  ) %>%
  inner_join(
    effect %>%
      transmute(
        tmp = as.character(.data$klasse), interpretatie = .data$x
      ),
    by = "tmp"
  ) %>%
  select(-.data$tmp) -> composite_index

Samenvatting {-}

Dit rapport publiceert de meest recente analyses op basis van het telwerk voor het project "Algemene Broedvogelmonitoring Vlaanderen" of kortweg ABV. Dit project is een gezamenlijk initiatief van het Instituut voor Natuur- en Bosonderzoek (INBO) en Natuurpunt Studie in samenwerking met de lokale vogelwerkgroepen. De samenwerking tussen deze organisaties staat garant voor een goede ondersteuning van en communicatie naar het vrijwilligersnetwerk door Natuurpunt Studie, en een degelijke professionele wetenschappelijke ondersteuning en dataverwerking door het INBO. Sinds 2016 maakt het integraal deel uit van het project Soortenmeetnetten, dat door INBO en Agentschap Natuur en Bos (ANB) wordt gefinancierd.

Het project werd opgestart in 2007 en heeft als doelstelling het beschrijven van aantalsontwikkelingen van een set van ca. 80 algemene broedvogelsoorten in Vlaanderen. Zowel jaarlijkse schommelingen als meerjarige trends zijn daarbij interessante resultaten in functie van lokaal, regionaal en internationaal beleid.

Dit rapport is bedoeld als een technisch achtergrondrapport. Het bestaat uit drie delen: het eerste deel beschrijft de methodiek van de verwerking en de weergave van de resultaten; het tweede deel geeft een aantal indicatoren gebaseerd op trends van meerdere soorten; het derde deel beschrijft de tijdreeks van individuele soorten. We beperken ons in delen twee en drie tot een gestandaardiseerde weergave van de meest relevante cijfers zonder ecologische interpretatie. Voor een ecologische interpretatie van de resultaten verwijzen we naar andere publicaties zoals INBO Vogelnieuws.

inbo/abvanalysis documentation built on April 6, 2023, 5:14 a.m.