City Nature Challenges in Österreich, 28. April – 1. Mai 2023

Veröffentlichungsdatum

2024-04-01T00:02:16+00:00

Code
if(!is.null(obsResults)){
  obsResults |>
    group_by(project.name) |>
    summarise(n = n()) |>
    ggplot(
      aes(x = reorder(project.name, n), y = n, fill = project.name)
      ) +
    geom_bar(stat = "identity", show.legend = FALSE) +
    coord_flip() +
    labs(x = "", y = "Anzahl der Beobachtungen")+
    theme(
      panel.grid.major.x = element_line()
    )
} else {
  print('Noch keine Beobachtungen')
}
Abbildung 1: Anzahl der Beobachtungen in den einzelnen Projekt Regionen

Indizes zwischen den Regionen

Code
if(!is.null(obsResults)){
  obsResults |>
    group_by(project.name) |>
    summarise(
      nObserver = n_distinct(user.name),
      nObservations = n(),
      nTaxa = n_distinct(scientificName),
      nResearchGrade = sum(quality_grade == "research"),
      ) |>
    select("Region" = project.name, "BeobachterInnen" = nObserver, "Beobachtungen" = nObservations, "Taxa" = nTaxa, "Research Grade" = nResearchGrade) |>
    datatable(rownames = FALSE)
} else {
  print('Noch keine Beobachtungen')
}

Beobachtungen Regnum

Code
if(!is.null(obsResults)){
  obsResults |> 
    drop_na(kingdom) |> 
    count(kingdom, project.name) |> 
    select(n, "Region" = project.name, kingdom) |>
    ggplot() +
      aes(x = kingdom, y = n, fill = Region) +
      geom_bar(position = 'dodge', stat='identity', show.legend = TRUE) +
      labs(
        y = "Beobachtungen pro Reich [#]",
        x = ""
      ) +
      scale_y_continuous(
        labels = scales::label_number(scale_cut = cut_short_scale()),
      ) +
      coord_flip(clip="off") +
      theme(
        panel.grid.major.x = element_line()
      )
} else {
  print('Noch keine Beobachtungen')
}
Abbildung 2: Absolute Anzahl der Beobachtungen pro Reich, aufgeteilt in teilnehmende Regionen
Code
nextRender <- (lubridate::now() + lubridate::hours(12)) |> 
  lubridate::with_tz(tzone = 'Europe/Vienna')

Hinweis: Die Seite wird circa alle 12 Stunden mit neuen Daten befüllt. Nächstes Update um circa 2024-04-01 14:41:58.

Allgemeine Information

Code
if(!is.null(obsResults)){
  distinctObserver <- obsResults$user.id |> unique()
  distinctSpecies <- obsResults |> 
    filter(taxonRank == 'species' | taxonRank == 'subspecies') |>
    pull(scientificName) |>
    unique()

  statsObserver <- obsResults |> 
    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 62235 Beobachtungen von 1020 Beobachterinnen und Beobachtern hochgeladen. Das ergibt einen Mittelwert von 61 Beobachtungen pro Beobachter bzw. Beobachterin und einen Median von 8. Auf Spezies-Ebene wurden 4462 Beobachtungen hochgeladen.

Code
if(!is.null(obsResults)){
  obsResults |>
    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')
}
Abbildung 3: Histogramm der Beobachtungen pro Beobachter/in
Code
if(!is.null(obsResults)){
  tempDf <- obsResults |> 
    drop_na(time_observed_at)
  if(nrow(tempDf) > 0) {
    obsResults |> 
      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')
}
Abbildung 4: In welcher Stunde an welchen Wochentag wie viele Beobachtungen gemacht wurden

Beobachtungskarte

Code
if(!is.null(obsResults)){
  mapDf <- obsResults |>
    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/> <a href='{uri}'>Beobachtung auf iNat</a>"),
      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')
}