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

```r}-set} if (interactive()) { meta %>% filter(.data$composite, .data$status == "converged") %>% sample_n(1) %>% pull(.data$hash) -> id } else { id <- "{{id}}" }

```r}-basis}
meta %>%
  filter(.data$hash == id) -> deze_analyse
deze_analyse %>%
  slice(1) %>%
  pull(.data$speciesgroup) -> soort_naam
soortenlijst %>%
  filter(.data$hash == id) %>%
  mutate(
    soort = tolower(.data$soort) %>%
      str_replace_all(" ", "-") %>%
      str_remove_all("'") %>%
      sprintf(fmt = "[%2$s](#soort-%1$s)", .data$soort)
  ) %>%
  arrange(.data$soort) %>%
  pull(.data$soort) -> deze_soorten
soortenlijst %>%
  filter(.data$hash == id) %>%
  distinct(.data$drempel) %>%
  pull(.data$drempel) -> deze_threshold
deze_analyse %>%
  select(.data$analysis, .data$cycle) %>%
  inner_join(composite_index, by = "analysis") -> deze_wijziging

r sprintf("%s {#index-%s}", soort_naam, tolower(soort_naam))

Deze indicator is gebaseerd op volgende soorten: r paste(deze_soorten, collapse = ", "). De indicator bestaat uit r length(deze_soorten) soorten. De aangepaste grenswaarden zijn r sprintf("%+.1f%%", exp(deze_threshold) * 100 - 100) en r sprintf("%+.1f%%", exp(-deze_threshold) * 100 - 100).

(ref:{{id}}-index) Wijzigingen t.o.v. de start van het meetnet voor r soort_naam. Zie §\@ref(s:onzekerheid) voor een verklaring van de intervallen en §\@ref(s:trendklasse) voor uitleg over de symbolen en referentielijnen.

```r}-wijziging-jaar, fig.cap = "(ref:{{id}}-index)", eval = nrow(deze_wijziging) > 0, warning = FALSE} deze_wijziging %>% filter(!.data$cycle) %>% mutate( klasse = factor(.data$klasse, levels = c(levels(.data$klasse), "R")), interpretatie = as.character(interpretatie) ) %>% complete( .data$referentie, periode = unique(.data$referentie, .data$periode), fill = list( klasse = "R", estimate = 0, interpretatie = "referentie", wijziging = "n.v.t." ) ) %>% mutate( naar_0 = .data$periode - 0.5, naar_1 = .data$periode + 0.5, alpha_punt = ifelse(.data$periode < .data$referentie, 0, 1), alpha_vlak = ifelse(.data$periode < .data$referentie, 0, ribbon_opacity), klasse = ifelse( .data$periode < .data$referentie, NA, as.character(.data$klasse) ) ) -> jaarlijks if (!interactive() && opts_knit$get("rmarkdown.pandoc.to") != "html") { jaarlijks %>% filter(.data$referentie == min(.data$referentie)) -> jaarlijks } p <- ggplot( jaarlijks, aes( x = periode, xmin = naar_0, xmax = naar_1, y = estimate, frame = referentie, periode = periode, wijziging = wijziging, interpretatie = interpretatie ) ) + geom_hline(yintercept = 0) + geom_hline(yintercept = deze_threshold * c(-1, 1), linetype = 2) + geom_rect( aes(ymin = lcl, ymax = ucl, fill = klasse), alpha = jaarlijks$alpha_vlak, show.legend = FALSE ) + geom_point(size = 6, alpha = jaarlijks$alpha_punt) + geom_text(aes(label = klasse), hjust = 0.5, vjust = 0.5, colour = "white") + scale_y_continuous( "procentuele wijziging t.o.v. referentieperiode", breaks = index_breaks, labels = index_labels ) + scale_fill_manual(values = kleurgradient) + theme(axis.title.x = element_blank()) if (interactive() || opts_knit$get("rmarkdown.pandoc.to") == "html") { ggplotly( p, tooltip = c("referentie", "periode", "wijziging", "interpretatie") ) %>% animation_opts(frame = 1000, transition = 0, redraw = TRUE) %>% animation_slider( font = list(color = "black"), currentvalue = list( prefix = "geselecteerd referentiejaar: ", font = list(color = inbo_hoofd), xanchor = "center" ) ) %>% animation_button(label = "\u25B6") %>% layout(showlegend = FALSE) %>% plotly::config( modeBarButtonsToRemove = list( "lasso2d", "select2d", "autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "toggleSpikelines" ), displaylogo = FALSE ) } else { p }

(ref:{{id}}-index-cyclus) Wijzigingen per driejarige cyclus voor `r soort_naam`. Zie §\@ref(s:onzekerheid) voor een verklaring van de intervallen en §\@ref(s:trendklasse) voor uitleg over de symbolen en referentielijnen.

```r}-wijziging-cyclus, fig.cap = "(ref:{{id}}-index-cyclus)", eval = nrow(deze_wijziging) > 0}
deze_wijziging %>%
  filter(.data$cycle) %>%
  mutate(
    klasse = factor(.data$klasse, levels = c(levels(.data$klasse), "R")),
    interpretatie = as.character(.data$interpretatie)
  ) %>%
  complete(
    .data$referentie, periode = unique(.data$referentie, .data$periode),
    fill = list(
      klasse = "R", estimate = 0, interpretatie = "referentie",
      wijziging = "n.v.t."
    )
  ) %>%
  mutate(
    naar_0 = .data$periode - 1.5, naar_1 = .data$periode + 1.5,
    alpha_punt = ifelse(.data$periode < .data$referentie, 0, 1),
    alpha_vlak = ifelse(.data$periode < .data$referentie, 0, ribbon_opacity),
    klasse = ifelse(
      .data$periode < .data$referentie, NA, as.character(.data$klasse)
    ),
    referentie = periode_labels(.data$referentie),
    naar = .data$periode, periode = periode_labels(.data$periode)
  ) -> driejaarlijks
if (!interactive() && opts_knit$get("rmarkdown.pandoc.to") != "html") {
  driejaarlijks %>%
    filter(.data$referentie == "2007 - 2009") -> driejaarlijks
}
p <- ggplot(
  driejaarlijks,
  aes(
    x = naar, xmin = naar_0, xmax = naar_1, y = estimate, frame = referentie,
    periode = periode, wijziging = wijziging, interpretatie = interpretatie
  )
) +
  geom_hline(yintercept = 0) +
  geom_hline(yintercept = deze_threshold * c(-1, 1), linetype = 2) +
  geom_rect(
    aes(ymin = lcl, ymax = ucl, fill = klasse),
    alpha = driejaarlijks$alpha_vlak, show.legend = FALSE
  ) +
  geom_point(size = 6, alpha = driejaarlijks$alpha_punt) +
  geom_text(aes(label = klasse), hjust = 0.5, vjust = 0.5, colour = "white") +
  scale_x_continuous(
    breaks = unique(driejaarlijks$naar), labels = periode_labels
  ) +
  scale_y_continuous(
    "procentuele wijziging t.o.v. referentieperiode", breaks = index_breaks,
    labels = index_labels
  ) +
  scale_fill_manual(values = kleurgradient) +
  theme(axis.title.x = element_blank())
if (interactive() || opts_knit$get("rmarkdown.pandoc.to") == "html") {
  ggplotly(
    p,
    tooltip = c("referentie", "periode", "wijziging", "interpretatie")
  ) %>%
    animation_opts(frame = 1000, transition = 0, redraw = TRUE) %>%
    animation_button(label = "\u25B6") %>%
    animation_slider(
      len = 0.9, font = list(color = "black"),
      currentvalue = list(
        prefix = "geselecteerd referentieperiode: ",
        font = list(color = inbo_hoofd), xanchor = "center"
      )
    ) %>%
    layout(showlegend = FALSE) %>%
    plotly::config(
      modeBarButtonsToRemove = list(
        "lasso2d", "select2d", "autoScale2d", "hoverClosestCartesian",
        "hoverCompareCartesian", "toggleSpikelines"
      ),
      displaylogo = FALSE
    )
} else {
  p
}

(ref:{{id}}-raster) Paarsgewijze vergelijking tussen jaren voor r soort_naam.

```r}-wijziging-jaar-alles2, fig.cap = "(ref:{{id}}-raster)", eval = output_format != "html" && nrow(deze_wijziging) > 0} deze_wijziging %>% filter(!.data$cycle) %>% rename(periode = .data$referentie, referentie = .data$periode) %>% mutate( klasse = classification(-.data$ucl, -.data$lcl, threshold = deze_threshold) ) %>% bind_rows( deze_wijziging %>% filter(!.data$cycle) ) %>% ggplot(aes(x = periode, y = referentie, label = klasse)) + geom_point(aes(colour = klasse), size = 4, show.legend = FALSE) + scale_colour_manual(values = kleurgradient) + geom_text( aes(label = klasse), hjust = 0.5, vjust = 0.5, colour = "white", size = 2 ) + coord_fixed() + theme( axis.title.x = element_blank(), axis.text.x = element_text(angle = 90, vjust = 0.5) )

(ref:{{id}}-raster3) Paarsgewijze vergelijking tussen driejarige cycli voor `r soort_naam`.

```r}-wijziging-jaar-alles3, fig.cap = "(ref:{{id}}-raster3)", eval = output_format != "html" && nrow(deze_wijziging) > 0}
deze_wijziging %>%
  filter(.data$cycle) %>%
  rename(periode = .data$referentie, referentie = .data$periode) %>%
  mutate(
    klasse = classification(-.data$ucl, -.data$lcl, threshold = deze_threshold)
  ) %>%
  bind_rows(
    deze_wijziging %>%
      filter(.data$cycle)
  ) %>%
  ggplot(aes(x = periode, y = referentie, label = klasse)) +
  geom_point(aes(colour = klasse), size = 6, show.legend = FALSE) +
  scale_colour_manual(values = kleurgradient) +
  geom_text(
    aes(label = klasse),
    hjust = 0.5, vjust = 0.5, colour = "white"
  ) +
  scale_x_continuous(
    breaks = function(x) {
      seq(2007, x[2], by = 3)
    },
    labels = function(x) {
      sprintf("%02i-%02i", x, x + 2)
    }
  ) +
  scale_y_continuous(
    breaks = function(x) {
      seq(2007, x[2], by = 3)
    },
    labels = function(x) {
      sprintf("%02i-%02i", x, x + 2)
    }
  ) +
  coord_fixed() +
  theme(
    axis.title.x = element_blank(),
    axis.text.x = element_text(angle = 90, vjust = 0.5)
  )

(ref:{{id}}-hash) Data-hashes van de analyse in het kader van traceerbaarheid (zie §\@ref(s:traceerbaarheid)).

r}-hash, results = "asis"} deze_analyse %>% arrange(.data$cycle, .data$linear) %>% transmute( frequentie = factor( .data$cycle, levels = c(TRUE, FALSE), labels = c("driejaarlijks", "jaarlijks") ), model = ifelse(.data$linear, "lineair", "niet-lineair"), analyse = str_replace(.data$analysis, "(.{20})", "\\1 "), status = str_replace(.data$status_fingerprint, "(.{20})", "\\1 ") ) %>% pandoc.table(caption = "(\\#tab:{{id}}-hash) (ref:{{id}}-hash)")

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