Dataset Description

Grus grus is known for its migration at the end of the European summer to nest in Spain, Greece, southern Italy, northern Africa, the Middle East and Asia, where it remains throughout the winter. I chose it because it’s a species that is often seen where I live in the south of France and a lot of people study their migration.

library(imager)
## Loading required package: magrittr
## 
## Attaching package: 'imager'
## The following object is masked from 'package:magrittr':
## 
##     add
## The following objects are masked from 'package:stats':
## 
##     convolve, spectrum
## The following object is masked from 'package:graphics':
## 
##     frame
## The following object is masked from 'package:base':
## 
##     save.image
im<-load.image("~/UConn Courses/Big data science for biologists/Lab due/Week7/imagegrus.jpg")
plot(im, axes = FALSE)

Step 0: Install all required packages

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.0     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ imager::add()       masks magrittr::add()
## ✖ stringr::boundary() masks imager::boundary()
## ✖ tidyr::extract()    masks magrittr::extract()
## ✖ tidyr::fill()       masks imager::fill()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ✖ purrr::set_names()  masks magrittr::set_names()
## ✖ dplyr::where()      masks imager::where()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(leaflet)
library(sf)
## Linking to GEOS 3.11.2, GDAL 3.7.2, PROJ 9.3.0; sf_use_s2() is TRUE
library(rgbif)

library(skimr)
library(scales)
## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor
library(ggmap)
## ℹ Google's Terms of Service: <https://mapsplatform.google.com>
##   Stadia Maps' Terms of Service: <https://stadiamaps.com/terms-of-service/>
##   OpenStreetMap's Tile Usage Policy: <https://operations.osmfoundation.org/policies/tiles/>
## ℹ Please cite ggmap if you use it! Use `citation("ggmap")` for details.
## 
## Attaching package: 'ggmap'
## 
## 
## The following object is masked from 'package:magrittr':
## 
##     inset
library(dplyr)

library(htmlwidgets)

Step 2: Loading dataset

grusgrus_observations <- occ_search(
  scientificName = "grus grus",
  hasCoordinate = TRUE,
  limit = 4000
)$data

head(grusgrus_observations)
## # A tibble: 6 × 125
##   key        scientificName   decimalLatitude decimalLongitude issues datasetKey
##   <chr>      <chr>                      <dbl>            <dbl> <chr>  <chr>     
## 1 4507703118 Grus grus (Linn…            51.2            12.4  cdc,c… 50c9509d-…
## 2 4507704132 Grus grus (Linn…            49.7             6.12 cdc,c… 50c9509d-…
## 3 4507980100 Grus grus (Linn…            51.4            -2.31 cdc,c… 50c9509d-…
## 4 4507706089 Grus grus (Linn…            39.4            -4.24 cdc,c… 50c9509d-…
## 5 4507737105 Grus grus (Linn…            39.4            -4.23 cdc,c… 50c9509d-…
## 6 4507710179 Grus grus (Linn…            39.4            -4.23 cdc,c… 50c9509d-…
## # ℹ 119 more variables: publishingOrgKey <chr>, installationKey <chr>,
## #   hostingOrganizationKey <chr>, publishingCountry <chr>, protocol <chr>,
## #   lastCrawled <chr>, lastParsed <chr>, crawlId <int>, basisOfRecord <chr>,
## #   occurrenceStatus <chr>, taxonKey <int>, kingdomKey <int>, phylumKey <int>,
## #   classKey <int>, orderKey <int>, familyKey <int>, genusKey <int>,
## #   speciesKey <int>, acceptedTaxonKey <int>, acceptedScientificName <chr>,
## #   kingdom <chr>, phylum <chr>, order <chr>, family <chr>, genus <chr>, …
europe_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= -10 & decimalLongitude <= 40 & decimalLatitude >= 35 & decimalLatitude <= 70)

africa_middleeast_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= -20 & decimalLongitude <= 60 & decimalLatitude >= -40 & decimalLatitude <= 40)

Step 3: Filtering the regions regarding the migration period

spain_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= -10 & decimalLongitude <= 5 & decimalLatitude >= 35 & decimalLatitude <= 45)

greece_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= 20 & decimalLongitude <= 30 & decimalLatitude >= 35 & decimalLatitude <= 42)

southitaly_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= 9 & decimalLongitude <= 10 & decimalLatitude >= 42 & decimalLatitude <= 45)

asia_observations <- grusgrus_observations %>%
  filter(decimalLongitude >= 60 & decimalLongitude <= 180 & decimalLatitude >= -10 & decimalLatitude <= 70)
  
africa_middleeast_observations <- rbind(africa_middleeast_observations, spain_observations, greece_observations, southitaly_observations, asia_observations)

Step 4: Finding the three most populous cities near the largest set of observations

largest_set <- grusgrus_observations %>%
  group_by(stateProvince) %>%
  summarize(count = n()) %>%
  arrange(desc(count)) %>%
  slice(1:4)

head(largest_set)
## # A tibble: 4 × 2
##   stateProvince   count
##   <chr>           <int>
## 1 <NA>             3202
## 2 Rheinland-Pfalz   153
## 3 Grevenmacher       84
## 4 Sachsen            44

We can see that the State province that has the most observation is “Rheinland-Pfalz” and the 3 closest cities having the most people are: Mainz, Kaiserslautern, and Trier. Let’s create the map with these cities

Step 5: Preparing the layers for the map (temperature & grus picture)

library(raster)
## Loading required package: sp
## 
## Attaching package: 'sp'
## The following object is masked from 'package:imager':
## 
##     bbox
## 
## Attaching package: 'raster'
## The following object is masked from 'package:skimr':
## 
##     bind
## The following object is masked from 'package:dplyr':
## 
##     select
#Adding Temperature raster
temperature_raster <- raster::getData(name = "worldclim", var = "bio", res = 2.5)
## Warning in raster::getData(name = "worldclim", var = "bio", res = 2.5): getData will be removed in a future version of raster
## . Please use the geodata package instead
factor <- 2
aggregate_temp <- aggregate(temperature_raster, fact = factor, fun = mean)

#conversion of the data in celsius degrees
gain(aggregate_temp) <- 0.1
finaltemplayer <- aggregate_temp[[1]]

temperature_palette <- colorNumeric(palette = "YlOrRd", domain = c(minValue(finaltemplayer), maxValue(finaltemplayer)))

#Adding of the grus picture
grusimage <- makeIcon(
  iconUrl = "~/UConn Courses/Big data science for biologists/Lab due/Week7/imagegrus.jpg",
  iconWidth = 30, 
  iconHeight = 30)

Step 6: Creating the map

map2 <- leaflet() %>%
  addTiles() %>%
  setView(lng = 10, lat = 50, zoom = 3) %>%
  addProviderTiles(providers$Esri.NatGeoWorldMap) %>% 
  addProviderTiles(providers$OpenTopoMap) %>%
  
  #Adding circle markers for observations
  addCircleMarkers(data = grusgrus_observations, 
                   ~decimalLongitude, ~decimalLatitude, 
                   color = "red", fillOpacity = 1, radius = 3, 
                   popup = ~paste(scientificName, "<br>", eventDate),
                   group = "All Grus grus observations") %>%
  
  addCircleMarkers(data = africa_middleeast_observations, 
                   ~decimalLongitude, ~decimalLatitude, 
                   color = "blue", fillOpacity = 1, radius = 3, 
                   popup = ~paste(scientificName, "<br>", eventDate),
                   group = "Grus grus winter observations") %>%
  
  #Adding raster images for temperature and elevation
  addRasterImage(finaltemplayer, colors = "YlOrRd", opacity = 0.5, group = "Temperature") %>%
  
  #Adding layers control
  addLayersControl(
    overlayGroups = c("All Grus grus observations", "Grus grus winter observations", "Temperature"),
    options = layersControlOptions(collapsed = FALSE)) %>%
  
  #Adding legends
  addLegend(position = "bottomright", 
            colors = c("#FFB6C1", "blue", "cyan"), 
            labels = c("All Grus grus observations", "Grus grus winter observations", "Temperature"), 
            opacity = 1) %>%
  addLegend("bottomleft", title = "Elevation (m)",
            pal = colorNumeric(palette = c("lightgreen", "green", "darkgreen", "yellow", "orange", "red"), domain = c(0, 2000)),
            values = c(0, 2000),
            labels = c("0-200m", "201-400m", "401-600m", "601-800m", "801-1000m", "1001-2000m"),opacity = 1) %>%
  addLegend("bottomright", title = "Temperature (°c)",
            pal = temperature_palette,
            values = c(minValue(finaltemplayer), maxValue(finaltemplayer)),
            opacity = 1)%>%
  
  #Adding markers for cities
  addMarkers(lng = 8.2473, lat = 49.9929, popup = "Mainz") %>%
  addMarkers(lng = 7.7550, lat = 49.4435, popup = "Kaiserslautern") %>%
  addMarkers(lng = 6.6498, lat = 49.7561, popup = "Trier") %>%
  
  #Adding grus grus image
  addMarkers(lng = 2.3522, lat = 48.8566, label = "Grus grus", icon = grusimage)

map2