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 %>%
  select(.data$analysis, .data$cycle) %>%
  inner_join(x = estimate, by = "analysis") %>%
  filter(
    !.data$cycle | .data$year < max(.data$year) |
      (.data$year == max(.data$year) & (max(.data$year) - 2007) %% 3 == 2)
  ) |>
  mutate(
    text_median = format_ci(
      estimate = .data$estimate, lcl = .data$lower_confidence_limit,
      ucl = .data$upper_confidence_limit, link = "log"
    )
  ) -> dit_aantal
looptijd <- diff(range(dit_aantal$year))
linear_trend %>%
  semi_join(deze_analyse, by = "analysis") -> deze_lineair
deze_analyse %>%
  slice(1) %>%
  pull(.data$speciesgroup) -> soort_naam
tolower(soort_naam) %>%
  str_replace_all(" ", "-") %>%
  str_remove_all("'") %>%
  sprintf(fmt = "# %2$s {#soort-%1$s}", soort_naam) -> titel
deze_analyse %>%
  select(.data$analysis, .data$cycle) %>%
  inner_join(x = index, by = "analysis") |>
  filter(
    !.data$cycle | .data$periode < max(.data$periode) |
      (.data$periode == max(.data$periode) & (.data$periode - 2007) %% 3 == 2)
  ) -> deze_wijziging
stratum %>%
  semi_join(deze_analyse, by = "analysis") -> dit_stratum
trend_tekst <- function(x) {
  if (x == "stabiel") {
    return("een stabiele toestand. De trend blijft beperkt tot")
  }
  if (x == "onduidelijke") {
    return("een onduidelijke toestand. De geschatte trend bedraagt")
  }
  paste("een", x, "met")
}

r titel

Op basis van jaarlijkse gegevens zien we gemiddeld r trend_tekst(deze_lineair$tekst[!deze_lineair$cycle]) r deze_lineair$jaarlijks[!deze_lineair$cycle] per jaar of r deze_lineair$looptijd[!deze_lineair$cycle] over de volledige looptijd van het meetnet. Deze trend is r deze_lineair$interpretatie[!deze_lineair$cycle].

Op basis van driejaarlijkse gegevens zien we gemiddeld r trend_tekst(deze_lineair$tekst[deze_lineair$cycle]) r deze_lineair$jaarlijks[deze_lineair$cycle] per jaar of r deze_lineair$looptijd[deze_lineair$cycle] over de volledige looptijd van het meetnet. Deze trend is r deze_lineair$interpretatie[deze_lineair$cycle].

(ref:{{id}}-aantal) Evolutie van het gemodelleerde gemiddeld aantal waargenomen dieren op een meetpunt voor r soort_naam tijdens de referentieperiode. Zie §\@ref(s:onzekerheid) voor een verklaring van de intervallen.

```r}-aantal, fig.cap = "(ref:{{id}}-aantal)", eval = output_format == "html" && nrow(dit_aantal) > 0, warning = FALSE} dit_aantal %>% filter(!.data$cycle) %>% mutate( hover = format_ci( .data$estimate, lcl = .data$lower_confidence_limit, ucl = .data$upper_confidence_limit, link = "log" ) %>% sprintf(fmt = "%2$i: %1$s", .data$year) ) -> aantal_jaar dit_aantal %>% filter(.data$cycle) -> poly_cyclus bind_rows( poly_cyclus %>% transmute( .data$year, x = .data$year - 1.4, y = .data$lower_confidence_limit ), poly_cyclus %>% transmute( .data$year, x = .data$year + 1.4, y = .data$lower_confidence_limit ), poly_cyclus %>% transmute( .data$year, x = .data$year + 1.4, y = .data$upper_confidence_limit ), poly_cyclus %>% transmute( .data$year, x = .data$year - 1.4, y = .data$upper_confidence_limit ) ) %>% group_by(.data$year) -> poly_cyclus dit_aantal %>% filter(.data$cycle) %>% transmute(.data$year, label = sprintf("%i-%i", .data$year, .data$year + 2)) -> cyclus_labs updatemenus <- list( list( active = 1, showactive = FALSE, type = "dropdown", y = 1.2, buttons = list( list( label = "Driejaarlijks", method = "update", args = list( list(visible = c(FALSE, TRUE)), list( xaxis = list( tickvals = cyclus_labs$year, ticktext = cyclus_labs$label ) ) ) ), list( label = "Jaarlijks", method = "update", args = list( list(visible = c(TRUE, FALSE)), list(xaxis = list(tick0 = min(aantal_jaar$year))) ) ) ) ) ) plot_ly( fillcolor = inbo_steun_blauw, opacity = ribbon_opacity, showlegend = FALSE, hoverinfo = "none" ) %>% add_ribbons( data = aantal_jaar, x = ~year, ymin = ~exp(lower_confidence_limit), ymax = ~exp(upper_confidence_limit), line = list(width = 0) ) %>% add_polygons( data = poly_cyclus, x = ~x, y = ~exp(y), line = list(width = 0), visible = FALSE ) %>% add_lines( data = aantal_jaar, x = ~year, y = ~exp(estimate), line = list(color = inbo_steun_blauw, width = 4), text = ~hover, hoverinfo = "text" ) %>% add_lines( data = dit_aantal %>% filter(.data$cycle) %>% transmute( .data$year, .data$estimate, start = -1.4, mid = 0, end = 1.4, hover = format_ci( .data$estimate, lcl = .data$lower_confidence_limit, ucl = .data$upper_confidence_limit, link = "log" ) %>% sprintf(fmt = "%2$i-%3$i: %1$s", .data$year, .data$year + 1) ) %>% pivot_longer(c("start", "mid", "end")) %>% mutate(x = .data$year + .data$value) %>% group_by(.data$year), x = ~x, y = ~exp(estimate), text = ~hover, hoverinfo = "text", line = list(color = inbo_steun_blauw, width = 4), visible = FALSE ) %>% layout( updatemenus = updatemenus, xaxis = list(title = "", tick0 = min(aantal_jaar$year)), yaxis = list( title = "gemiddeld aantal dieren per meetpunt", range = range(pretty(c(0, exp(max(dit_aantal$upper_confidence_limit))))) ), title = soort_naam, hoverlabel = list(bgcolor = inbo_lichtblauw, bordercolor = inbo_steun_blauw) ) %>% config( modeBarButtonsToRemove = list( "lasso2d", "select2d", "autoScale2d", "hoverClosestCartesian", "hoverCompareCartesian", "toggleSpikelines" ), displaylogo = FALSE )

```r}-aantal2, fig.cap = "(ref:{{id}}-aantal)", eval = output_format != "html" && nrow(dit_aantal) > 0, warning = FALSE}
dit_aantal %>%
  filter(!.data$cycle) %>%
  ggplot(
    aes(
      x = year, y = exp(estimate), ymin = exp(lower_confidence_limit),
      ymax = exp(upper_confidence_limit)
    )
  ) +
  geom_ribbon(alpha = ribbon_opacity) +
  geom_line() +
  scale_x_continuous(breaks = pretty) +
  scale_y_continuous(
    "gemiddeld aantal dieren per meetpunt", limits = c(0, NA)
  ) +
  theme(axis.title.x = element_blank()) +
  ggtitle(soort_naam)

```r}-aantal3, fig.cap = "(ref:{{id}}-aantal)", eval = output_format != "html" && nrow(dit_aantal) > 0, warning = FALSE} breaks <- seq(min(dit_aantal$year), max(dit_aantal$year), by = 3) labels <- sprintf("%i-%i", breaks, breaks + 2) dit_aantal %>% filter(.data$cycle) %>% ggplot( aes( x = year, y = exp(estimate), ymin = exp(lower_confidence_limit), ymax = exp(upper_confidence_limit), xmin = year - 1.4, xmax = year + 1.4, ) ) + geom_rect(alpha = ribbon_opacity) + geom_segment(aes(x = year - 1.4, xend = year + 1.4, yend = exp(estimate))) + scale_x_continuous(breaks = breaks, labels = labels) + scale_y_continuous( "gemiddeld aantal dieren per meetpunt", limits = c(0, NA) ) + theme(axis.title.x = element_blank()) + ggtitle(soort_naam)

(ref:{{id}}-index) Wijzigingen tussen jaren 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(dit_aantal) > 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 = log(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}}-index3) 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}}-index3)", 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 = log(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}}-raster2) Paarsgewijze vergelijking tussen jaren voor `r soort_naam`. Uitleg van de symbolen in tabel \@ref(tab:regels).

(ref:{{id}}-raster3) Paarsgewijze vergelijking tussen driejarige cycli voor `r soort_naam`. Uitleg van de symbolen in tabel \@ref(tab:regels).

```r}-wijziging-jaar-alles2, fig.cap = "(ref:{{id}}-raster2)", 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 = log(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)
  )

```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 = log(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}}-sg) Stratumgewicht, raming van het aantal hokken waarin de soort aanwezig is, aantal relevante hokken voor de analyse, aantal onderzochte hokken in het stratum, totaal aantal hokken van het stratum in Vlaanderen, aantal bezoeken aan een meetpunt en het gemiddeld aandeel relevante punten per hok voor `r soort_naam` (zie §\@ref(s:stratumgewicht)).

```r}-sd}
dit_stratum %>%
  transmute(
    .data$stratum,
    gewicht = sprintf("%.1f%%", 100 * .data$gewicht),
    aanwezig = round(.data$aanwezig, 1), .data$relevant, .data$onderzocht,
    .data$totaal, .data$bezoeken, punten = sprintf("%.1f%%", 100 * .data$punten)
  ) %>%
  kable(caption = "(ref:{{id}}-sg)", align = "lrrrrrrr")

(ref:{{id}}-hash) Data-hashes van de analyses 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.