_body.qmd

## Allgemeine Information

```{r statsDistinct}
if(!is.null(resultsDf)){
  resultsINat <- resultsDf |> filter(project.type == 'inat')
  resultsObs <- resultsDf |> filter(project.type == 'obs')
  if(nrow(resultsINat) == 0){
    resultsINat = NULL
  }
  if(nrow(resultsObs) == 0){
    resultsObs = NULL
  }
} else {
  resultsINat = NULL
  resultsObs = NULL
}

if(!is.null(resultsDf)){
  distinctObserver <- resultsDf$user.id |> unique()
  distinctSpecies <- resultsDf |> 
    filterSpeciesLevel() |>
    pull(scientificName) |>
    unique()

  statsObserver <- resultsDf |> 
    count(user.id) |>
    summarise(
        mean = round(mean(n), 1),
        median = median(n),
    )

} else {
  distinctObserver <- c()
  distinctSpecies <- c()
  statsObserver <- tibble(mean = c(0), median = c(0))
}
```

Insgesamt wurden **`r nrow(resultsDf)`** Beobachtungen von **`r length(distinctObserver)`** Beobachterinnen und Beobachtern hochgeladen. Dies ergibt einen Mittelwert von **`r statsObserver$mean[1]`** und einen Median von **`r statsObserver$median[1]`** Beobachtungen pro Person. Auf Artebene (Spezies-Ebene) wurden **`r length(distinctSpecies)`** unterschiedliche Arten beobachtet.

```{r plotUserHistogram}
#| label: fig-histo
#| fig-cap: "Histogramm der Anzahl Beobachtungen pro Beobachter/in"
if(!is.null(resultsDf)){
  resultsDf |>
    count(user.id) |>
    ggplot(aes(x = n)) +
    geom_histogram(bins = 30, fill = 'steelblue', color = 'black') +
    labs(
      x = 'Anzahl Beobachtungen',
      y = 'Anzahl Beobachter/innen'
    ) +
    scale_y_continuous(
      breaks = scales::pretty_breaks(),
    ) +
    scale_x_continuous(
      breaks = scales::pretty_breaks(),
    ) +
    theme(
      panel.grid.major.y = element_line()
    )
} else {
  print('Noch keine Beobachtungen')
}
```

```{r plotUserTime}
#| label: fig-time
#| fig-cap: "Anzahl der Beobachtungen pro Stunde und Wochentag"
if(!is.null(resultsDf)){
  tempDf <- resultsDf |> 
    drop_na(time_observed_at)
  if(nrow(tempDf) > 0) {
    resultsDf |> 
      drop_na(time_observed_at) |>
      mutate(
        time_observed_at = lubridate::ymd_hms(time_observed_at, tz = "Europe/Vienna", quiet = TRUE),
        hour_observed_at = hms::as_hms(time_observed_at),
        weekday_observed_at = lubridate::wday(
          time_observed_at, 
          label = TRUE,
          week_start = 1,
          locale="de_AT"
          )
      ) |>
      select(time_observed_at, weekday_observed_at, hour_observed_at)  |>
      ggplot(aes(x = hour_observed_at, fill = weekday_observed_at)) +
      geom_histogram(binwidth = 60*60, color = 'black') +
      labs(
        x = 'Stunde',
        y = 'Anzahl Beobachtungen',
        fill = 'Wochentag'
      ) +
      scale_y_continuous(
        breaks = scales::pretty_breaks(),
      ) +
      scale_x_time(
        breaks = scales::breaks_width("1 hour"),
        labels = scales::label_time(format = "%H")
      ) +
      theme(
        panel.grid.major.y = element_line()
      ) + 
      facet_wrap(~weekday_observed_at, ncol = 1)
  }
} else {
  print('Noch keine Beobachtungen')
}
```

## Beobachtungskarte

```{r mapObs}
if(!is.null(resultsDf)){
  mapDf <- resultsDf |>
    drop_na(location, time_observed_at) |>
    separate(location, c('latitude', 'longitude'), sep = ',', remove = FALSE, convert = TRUE) |>
    mutate(
      time_observed_at = lubridate::ymd_hms(time_observed_at, tz = "Europe/Vienna", quiet = TRUE),
      label = glue("{user.name} <br/> {scientificName} <br/> {time_observed_at} <br/> {uri_html}"),
      group = lubridate::wday(
        time_observed_at, 
        label = TRUE,
        week_start = 1,
        locale="de_AT"
      )
    )
  mapDfSplit <- split(mapDf, mapDf$group)

  m <- leaflet() |> # create map with dataset
    setView(lng = 14.12456, lat = 47.59397, zoom = 6) |> # fyi geographic center of austria
    addTiles()


  for(name in names(mapDfSplit)){
    if(nrow(mapDfSplit[[name]]) > 0){
    m <- m |>
      addCircleMarkers(
        data = mapDfSplit[[name]],
        lng = ~longitude,
        lat = ~latitude,
        popup = ~label,
        label = ~scientificName,
        group = name,
        clusterOptions = markerClusterOptions()
      )
    }
  }
  m |>
    addLayersControl(
      overlayGroups = names(mapDfSplit),
      options = layersControlOptions(collapsed = FALSE)
    )
} else {
  print('Noch keine Beobachtungen')
}
```


## Fun Facts
  
```{r funFacts}
if(!is.null(resultsDf)){
  mostDuplicatedObservations <- resultsDf |>
    filterSpeciesLevel() |>
    count(user.id, user.name, scientificName) |>
    slice_max(n = 1, order_by = n, with_ties = FALSE)

  longestName <- resultsDf |>
    filterSpeciesLevel() |>
    mutate(
      nameLength = nchar(scientificName)
    ) |>
    slice_max(n = 1, order_by = nameLength, with_ties = FALSE)

  longestDistance <- resultsDf |>
    separate(location, c('latitude', 'longitude'), sep = ',', remove  = FALSE, convert = TRUE) |>
    group_by(user.id, user.name) |>
    group_split() |>
    furrr::future_map_dfr(function(user_df) {
      if(nrow(user_df) > 1) {
        coords <- cbind(user_df$longitude, user_df$latitude)
        dist_matrix <- geosphere::distm(coords, fun =   geosphere::distHaversine) / 1000 # in km
        tibble(
          user.id = user_df$user.id[1], 
          user.name = user_df$user.name[1],
          distance = max(dist_matrix, na.rm = TRUE)
        )
      } else {
        # For users with only one observation, distance is 0
        tibble(
          user.id = user_df$user.id[1], 
          user.name = user_df$user.name[1],
          distance = 0
        )
      }
    }) |>
    slice_max(n = 1, order_by = distance, with_ties = FALSE)
} else {
  mostDuplicatedObservations <- tibble(user.id = c(0), user.name = c(0), scientificName = c(0), n = c(0))
  longestName <- tibble(scientificName = c(0), nameLength = c(0))
  longestDistance <- tibble(user.id = c(0), user.name = c(0), distance = c(0))
}
if(exists("resultsINat") && !is.null(resultsINat)){
  isBirder <- resultsINat |>
    filter(project.type == 'inat' & class == 'Aves') |>
    count(user.id, user.name) |>
    slice_max(n = 1, order_by = n, with_ties = FALSE)
} else {
  isBirder <- tibble(user.id = c(0), user.name = c(0), n = c(0))
}

if(any(!is.na(resultsDf$time_observed_at))) {
  mostActiveDayHour <- resultsDf |>
      drop_na(time_observed_at) |>
      mutate(
        time_observed_at = lubridate::ymd_hms(time_observed_at, tz = "Europe/Vienna", quiet = TRUE),
        day = lubridate::date(time_observed_at),
        hour = lubridate::hour(time_observed_at)
      ) |>
      count(day, hour) |>
      slice_max(n = 1, order_by = n, with_ties = FALSE)
} else {
  mostActiveDayHour <- tibble(day = as.Date("1989-01-05"), hour = 0, n = c(0))
}
```

Der/Die User/in (auch bekannt als Birder) **`r isBirder$user.name[1]`** hat mit `r isBirder$n[1]` Vogelbeobachtungen die meisten Beiträge in dieser Kategorie hochgeladen. Besonders häufig, nämlich `r mostDuplicatedObservations$n[1]` Mal, hat der/die User/in **`r mostDuplicatedObservations$user.name[1]`** die Art *`r mostDuplicatedObservations$scientificName[1]`* beobachtet. Das Taxon mit dem längsten wissenschaftlichen Namen ist **_`r longestName$scientificName[1]`_** mit `r longestName$nameLength[1]` Zeichen. Als Wanderer/in hat **`r longestDistance$user.name[1]`** die größte Distanz von `r round(longestDistance$distance[1], 2)` km zwischen zwei Beobachtungen zurückgelegt. In der Stunde `r mostActiveDayHour$hour[1]` am `r mostActiveDayHour$day[1]` wurden die meisten Beobachtungen gemacht, nämlich `r mostActiveDayHour$n[1]` Mal.

## Top Beobachter/innen

Diese Liste zeigt die Beobachter/innen, geordnet nach der Gesamtzahl ihrer Beobachtungen (inklusive Mehrfachbeobachtungen derselben Art).

```{r tableTopObserver}
#| label: tbl-topObserver
#| tbl-cap: "Beobachter/innen geordnet nach der Anzahl ihrer Beobachtungen"
if(!is.null(resultsDf)){
  resultsDf |> 
    count(user.id, user.name) |>
    arrange(desc(n)) |>
    select('Beob. [#]' = n, 'User' = user.name) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```

## Top Bestimmer/Innen (iNaturalist)

Die hochgeladenen Beobachtungen gewinnen erst durch die wertvolle Arbeit der Bestimmer/innen an wissenschaftlicher Bedeutung. Ein großes Dankeschön an alle, die durch ihre Bestimmungen iNaturalist zu dem machen, was es heute ist!

```{r tableTopIdentifier}
# This function could (should) be vectorized to speed up the process
getIdentifierAsVector <- function(identifications, observerId){
  if(!is.na(identifications)){
    if(identifications == 'list()'){
      return(c(""))
    }
    parsedList <- eval(parse(text=identifications))
    identifiers <- parsedList$user |>
      as_tibble() |>
      filter(id != observerId) |>
      mutate(
        name = ifelse(is.na(name), login, paste(login, ' (', name, ')', sep = ''))
      ) |>
      pull(name)
    if(length(identifiers) == 0){
      identifiers <- c("")
    }
    return(identifiers)
  } else {
    return(c(""))
  }
}


if(!is.null(resultsINat)){
  resultsINat |>
    drop_na(identifications) |>
    mutate(
      identifiers = furrr::future_map2(identifications, user.id, getIdentifierAsVector)
    ) |>
    pull(identifiers) |>
    unlist() |>
    as_tibble() |>
    filter(value != "") |>
    count(value) |>
    arrange(desc(n)) |>
    select('Bestimmungen [#]' = n, 'Bestimmer/In' = value) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```

## Top Beobachter/innen mit den meisten unterschiedlichen Arten

Gezählt werden nur Beobachtungen, die mindestens auf Artebene bestimmt und als "Research Grade" (iNaturalist) eingestuft oder positiv validiert (Observation.org) wurden.

```{r tableTopObserverSpecies}
#| label: tbl-topObserverSpecies
#| tbl-cap: "Liste der Beobachter/innen, geordnet nach der Anzahl unterschiedlicher beobachteter Arten"
if(!is.null(resultsDf)){
  resultsDf |> 
    filterSpeciesLevelResearch() |>
    distinct(scientificName, user.id, .keep_all = TRUE) |>
    count(user.id, user.name) |>
    arrange(desc(n)) |>
    select('Uniques [#]' = n, 'User' = user.name) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```

## Top Taxa (Spezies-Ebene)

Diese Liste enthält die am häufigsten beobachteten und bereits auf Artebene bestimmten Taxa ("Research Grade" oder positiv validiert).

```{r tableTopTaxa}
#| label: tbl-topTaxa
#| tbl-cap: "Häufigste Taxa (Artebene, Research Grade/validiert), geordnet nach Anzahl der Beobachtungen."
if(!is.null(resultsDf)){
  resultsDf |> 
    filterSpeciesLevelResearch() |>
    count(scientificName, vernacularName) |> 
    arrange(desc(n)) |>
    select('Beob. [#]' = n, 'Wiss. Name' = scientificName, 'Umgangspr. Name' = vernacularName) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```

## Unique Taxa mit Research-Grade

Einzigartige Funde, die nur von einer einzigen Person während der Challenge beobachtet und hochgeladen wurden, sind besonders erfreulich.

```{r tableUniqueTaxa}
#| label: tbl-uniqueTaxa
#| tbl-cap: "Einmalig beobachtete Taxa (Artebene, Research Grade/validiert) mit Angabe des/der Beobachters/in"
if(!is.null(resultsDf)){
  resultsDf |> 
    filterSpeciesLevelResearch() |>
    add_count(scientificName, vernacularName) |> 
    filter(n == 1) |> 
    select('Wiss. Name' = scientificName, 'Umgangspr. Name' = vernacularName,  'User' = user.name, "Link" = uri_html) |>
    datatable(
      rownames = FALSE, 
      escape = FALSE,
      options = list(
        columnDefs = list(list(type = 'html', targets = c(3)
        )
      )
))
} else {
  print('Noch keine Beobachtungen')
}
```

## Raritäten (observation.org)

Observation.org verwendet eine eigene Einstufung für die Seltenheit von Beobachtungen, die sich von der iNaturalist-Einteilung unterscheidet. Die Verteilung dieser Raritätsstufen ist unten dargestellt.

```{r plotQuality}
#| label: fig-QualityRarity
#| fig-cap: "Verteilung der Raritätsstufen auf observation.org"
if(!is.null(resultsObs)){
  resultsObs |>
    count(rarity_name) |> 
    arrange(desc(n)) |>
    mutate(
      np = n / nrow(resultsObs),
      quality_grade = forcats::fct_reorder(rarity_name, np, .desc = TRUE)
    ) |> 
    ggplot() +
      aes(x = rarity_name, y = np, fill = rarity_name) +
      geom_bar(position = 'dodge', stat='identity', show.legend = FALSE) +
      geom_text(aes(label=paste("n =", n)), position=position_dodge(width=0.9), hjust=-0.25) +
      labs(
        y = "Beobachtungen Rarität [%]",
        x = ""
      ) +
      scale_y_continuous(
        labels = scales::percent_format(),
        limits = c(0, 1)
      ) +
      coord_flip(clip="off") +
      theme(
        panel.grid.major.x = element_line()
      )
} else {
  print('Noch keine Beobachtungen')
}
```

## Beobachtungen mit Rarität "selten" (observation.org)

Die folgende Liste zeigt Beobachtungen, die auf observation.org als "selten" eingestuft wurden.

```{r tableRarityTaxa}
#| label: tbl-rarityTaxa
#| tbl-cap: "Beobachtungen, die laut observation.org als selten gelten"
if(!is.null(resultsObs)){
  resultsObs |> 
    filter(rarity >= 3) |>
    add_count(scientificName, vernacularName) |> 
    filter(n == 1) |> 
    select('Wiss. Name' = scientificName, 'Umgangspr. Name' = vernacularName,  'User' = user.name, "Link" = uri_html, "Level" = rarity_name) |>
    datatable(
      rownames = FALSE, 
      escape = FALSE,
      options = list(
        columnDefs = list(list(type = 'html', targets = c(3)
        )
      )
))
} else {
  print('Noch keine Beobachtungen')
}
```

## Beobachtungs Qualität (iNaturalist)

iNaturalist teilt die Beobachtungsqualität in drei Stufen ein:
- **Zwanglos (casual):** Beobachtungen, bei denen Datum, Ort oder ein Belegfoto/-ton fehlt.
- **Benötigt Bestimmung (needs_id):** Beobachtungen, bei denen noch keine übereinstimmende Bestimmung durch mindestens zwei Personen vorliegt.
- **Forschungsqualität (research):** Bestätigte Beobachtungen auf Artebene.

```{r plotQuality}
#| label: fig-QualityINat
#| fig-cap: "Verteilung der Beobachtungsqualität auf iNaturalist"
if(!is.null(resultsINat)){
  resultsINat |> 
    count(quality_grade) |> 
    arrange(desc(n)) |>
    mutate(
      np = n / nrow(resultsINat),
      quality_grade = forcats::fct_reorder(quality_grade, np, .desc = TRUE)
    ) |> 
    ggplot() +
      aes(x = quality_grade, y = np, fill = quality_grade) +
      geom_bar(position = 'dodge', stat='identity', show.legend = FALSE) +
      geom_text(aes(label=paste("n =", n)), position=position_dodge(width=0.9), hjust=-0.25) +
      labs(
        y = "Beobachtungen Qualität [%]",
        x = ""
      ) +
      scale_y_continuous(
        labels = scales::percent_format(),
        limits = c(0, 1)
      ) +
      coord_flip(clip="off") +
      theme(
        panel.grid.major.x = element_line()
      )
} else {
  print('Noch keine Beobachtungen')
}
```

## Beobachtungen Phylum (iNaturalist)

```{r plotPhylum}
#| label: fig-Phylum
#| fig-cap: "Relative und absolute Anzahl der Beobachtungen pro Phylum (Stamm)"
if(!is.null(resultsINat)){
  resultsINat |> 
    count(phylum) |> 
    drop_na(phylum) |> 
    arrange(desc(n)) |>
    mutate(
      np = n / nrow(resultsINat),
      phylum = forcats::fct_reorder(phylum, np, .desc = TRUE)
    ) |> 
    ggplot() +
      aes(x = phylum, y = np, fill = np) +
      geom_bar(position = 'dodge', stat='identity', show.legend = FALSE) +
      geom_text(aes(label=paste("n =", n)), position=position_dodge(width=0.9), hjust=-0.25) +
      labs(
        y = "Beobachtungen Phyla [%]",
        x = ""
      ) +
      scale_fill_viridis_c(
        option = "turbo",
      ) +
      scale_y_continuous(
        labels = scales::percent_format(),
        limits = c(0, 1)
      ) +
      coord_flip(clip="off") +
      theme(
        panel.grid.major.x = element_line()
      )
} else {
  print('Noch keine Beobachtungen')
}
```

## Insecta - Ordnungen (iNaturalist)

```{r plotInsecta}
#| label: fig-Insecta
#| fig-cap: "Ordnungen innerhalb der Klasse Insecta: Relative und absolute Anzahl der Beobachtungen."
if(!is.null(resultsINat)){
  obsInsecta <- resultsINat |> 
    filter(class == "Insecta") |>
    drop_na(order)

  obsInsecta |>
    count(order) |>
    mutate(
        p = n / nrow(obsInsecta),
        order = forcats::fct_reorder(order, p, .desc = TRUE)
    ) |>
    ggplot(aes(y = order, x = p, label = n, fill = p)) +
    geom_col(show.legend = FALSE) +
    geom_text(nudge_x = 0.01, check_overlap = TRUE) +
    scale_x_continuous(
        breaks = scales::pretty_breaks(),
        labels = scales::label_percent()
    ) +
    scale_fill_viridis_c(
      option = "turbo",
    ) +
    labs(
        y = "Insecta - Ordnung",
        x = glue("Beobachtungen (# = {nrow(obsInsecta)}) [%]")
    ) +
    theme(
        panel.grid.major.x = element_line()
    )
} else {
  print('Noch keine Beobachtungen')
}
``` 

## Beobachtungen mit Konflikt Bestimmungen (iNaturalist)

Diese Tabelle listet Beobachtungen auf, bei denen Uneinigkeit über das bestimmte Taxon zwischen den Usern besteht.

```{r tableConflict}
#| label: tbl-Conflict
#| tbl-cap: "Beobachtungen mit widersprüchlichen Bestimmungen"
if(!is.null(resultsINat)){
  resultsINat |> 
    filter(num_identification_disagreements > 0) |> 
    select("Link" = uri_html, "User" = user.name, "Taxa" = scientificName) |>
    datatable(
      rownames = FALSE,
      escape = FALSE,
      options = list(
        columnDefs = list(list(type = 'html', targets = c(1)))
      )
    )
} else {
  print('Noch keine Beobachtungen')
}
```

## Verifizierung Status (observation.org)

Observation.org klassifiziert Beobachtungen nach ihrem Validierungsstatus.

```{r plotVerification}
#| label: fig-verification
#| fig-cap: "Verteilung des Validierungsstatus auf observation.org"
if(!is.null(resultsObs)){
  resultsObs |> 
    count(validation_status_name) |> 
    arrange(desc(n)) |>
    mutate(
      np = n / nrow(resultsObs),
      quality_grade = forcats::fct_reorder(validation_status_name, np, .desc = TRUE)
    ) |> 
    ggplot() +
      aes(x = quality_grade, y = np, fill = quality_grade) +
      geom_bar(position = 'dodge', stat='identity', show.legend = FALSE) +
      geom_text(aes(label=paste("n =", n)), position=position_dodge(width=0.9), hjust=-0.25) +
      labs(
        y = "Beobachtungen Status [%]",
        x = ""
      ) +
      scale_y_continuous(
        labels = scales::percent_format(),
        limits = c(0, 1)
      ) +
      coord_flip(clip="off") +
      theme(
        panel.grid.major.x = element_line()
      )
} else {
  print('Noch keine Beobachtungen')
}
```

## Beobachtungen die nicht Verizifiert werden können (observation.org)

Hier werden Beobachtungen von observation.org angezeigt, die nicht verifiziert werden konnten oder deren Bestimmung nicht genehmigt wurde.

```{r tableUnverified}
#| label: tbl-unverified
#| tbl-cap: "Nicht verifizierte oder nicht genehmigte Beobachtungen auf observation.org"
if(!is.null(resultsObs)){
  resultsObs |> 
    filter(validation_status %in% c("N", "U")) |>
    select("Link" = uri_html, "User" = user.name, "Taxa" = scientificName) |>
    datatable(
      rownames = FALSE,
      escape = FALSE,
      options = list(
        columnDefs = list(list(type = 'html', targets = c(1)))
      )
    )
} else {
  print('Noch keine Beobachtungen')
}
```

## Rote Liste

```{r tableCheckList}
#| label: tbl-CheckList
#| tbl-cap: "Beobachtungen von Arten, die in zumindest einem EU-Land auf der Roten Liste (FFH-Anhänge) stehen"
if(!is.null(resultsDf)){
  checkList |> 
    right_join(resultsDf, by = c("scientific_name" = "scientificName")) |>
    drop_na(annex_II) |>
    add_count(scientific_name) |> 
    count(scientific_name, vernacularName, annex_II_priority, annex_II, annex_IV) |> 
    arrange(scientific_name) |> 
    select("Wiss. Name" = scientific_name, "Umgangspr. Name" = vernacularName, annex_II_priority, annex_II, annex_IV, "Beob. (#)" = n) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```
```{r tableBirdsList}
#| label: tbl-BirdsList
#| tbl-cap: "Beobachtungen von Vogelarten, die in zumindest einem EU-Land auf der Roten Liste (Vogelschutzrichtlinie Anhang I) stehen"
if(!is.null(resultsDf)){
  birdsList |> 
    right_join(resultsDf, by = c("scientific_name" = "scientificName")) |>
    drop_na(AnnexI) |>
    arrange(scientific_name) |> 
    count(scientific_name, vernacularName, AnnexI) |> 
    select("Wiss. Name" = scientific_name, "Umgangspr. Name" = vernacularName, AnnexI, "Beob. (#)" = n) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}
```