Lab 5

R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

setwd("~/Downloads/EEB 4100/Labs/Lab5")

#Load the appropriate lab files for the spatial data

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.0     ✔ readr     2.1.6
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.2     ✔ tibble    3.3.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.2
## ✔ purrr     1.2.1     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(leaflet)
library(sf)

## Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUE

library(rgbif)
#install.packages(c("geodata", "terra", "elevatr", "rnaturalearth"))
library(terra)

## terra 1.8.93
## 
## Attaching package: 'terra'
## 
## The following object is masked from 'package:tidyr':
## 
##     extract

library(geodata)
library(elevatr)

## elevatr v0.99.0 NOTE: Version 0.99.0 of 'elevatr' uses 'sf' and 'terra'.  Use 
## of the 'sp', 'raster', and underlying 'rgdal' packages by 'elevatr' is being 
## deprecated; however, get_elev_raster continues to return a RasterLayer.  This 
## will be dropped in future versions, so please plan accordingly.

library(rnaturalearth)

#Connect the data - Hummingbird or Archilochus colubris

hummingbird_gbif_readr <- readr::read_delim(
  "0016905-260226173443078.csv", 
  delim = "\t", 
  escape_double = FALSE, 
  col_names = TRUE, 
  na = c("","NA")
)

## Rows: 39911 Columns: 50
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr  (25): datasetKey, occurrenceID, kingdom, phylum, class, order, family, ...
## dbl  (10): gbifID, decimalLatitude, decimalLongitude, coordinateUncertaintyI...
## lgl  (12): infraspecificEpithet, verbatimScientificNameAuthorship, locality,...
## dttm  (3): eventDate, dateIdentified, lastInterpreted
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

hummingbird_cleaned <- hummingbird_gbif_readr %>%
  filter(
    !is.na(decimalLatitude), 
    !is.na(decimalLongitude), 
    !is.na(month), 
    !is.na(year)) %>%
      select(gbifID, species, decimalLatitude, decimalLongitude,
         month, year, stateProvince, countryCode, eventDate) %>%
      mutate(season = case_when(
        month %in% c(3, 4, 5)   ~ "Spring Observation",
        month %in% c(6, 7, 8)   ~ "Summer Observation",
        month %in% c(9, 10, 11) ~ "Fall Observation",
        month %in% c(12, 1, 2)  ~ "Winter Observation" )
  )

season_pal <- colorFactor(
  palette= c("pink", "lightgreen", "orange", "skyblue"),
  domain = c("Spring Observation", "Summer Observation", "Fall Observation", "Winter Observation")
)

#Temperature Data

temp_us <- worldclim_country(
  country = "USA", 
  var = "tavg", 
  path = tempdir()
)

temp_us <- rast(temp_us)

temp_mean <- mean(temp_us)

east_us_ext <- ext(-100, -65, 24, 50)
temp_crop <- crop(temp_mean, east_us_ext)

temp_crop <- aggregate(temp_crop, fact = 2)

temp_pal <- colorNumeric(
  palette = "RdYlBu", 
  domain = values(temp_crop, na.rm = TRUE), 
  na.color = "transparent", 
  reverse = TRUE
)

## Warning: [readValues] raster has no values

#Elevation data

bbox_sf <- st_as_sf(st_as_sfc(st_bbox(c(
  xmin = -125, xmax = -65, 
  ymin = 24, ymax = 50), 
  crs = 4326
)))

us_ext <- ext(-125, -65, 24, 50)

elev_raster <- get_elev_raster(locations = bbox_sf, z = 4, clip = "bbox")

## Mosaicing & Projecting

## Clipping DEM to bbox

## Note: Elevation units are in meters.

elev_terra <- rast(elev_raster)
elev_crop <- crop(elev_terra, us_ext)
elev_crop[elev_crop < 0] <- NA


elev_pal <- colorNumeric(
  palette = c("darkgreen", "yellow", "saddlebrown", "white"), 
  domain = values(elev_crop, na.rm = TRUE), 
  na.color = "transparent"
)

Honestly, I am so lost. I was asking my friend who knows how to code and they sat down with me and we were reseraching things and they suggested doing this, but I’m not entirely sure that it is correct.

#City data

obs_density <- hummingbird_cleaned %>%
  mutate(lat_round = round(decimalLatitude, 0),
         lng_round = round(decimalLongitude, 0)) %>%
  count(lat_round, lng_round, sort = TRUE)



top_3_cities <- tibble(
  city = c("Washington, D.C.", "Philadelphia, PA", "Chicago, IL"), 
  lat = c(39, 40, 42), 
  lng = c(-77, -75, -88), 
  pop = c(1786, 1370, 1246)
)

#Map

map_hummingbird <- leaflet() %>%
  addProviderTiles("CartoDB.Positron", group = "Base Map") %>%
    addRasterImage(elev_crop,
                   colors = elev_pal,
                   opacity = 0.5, 
                   group = "Elevation (m)") %>%
    addRasterImage(temp_crop,
                   colors = temp_pal, 
                   opacity = 0.5, 
                   group = "Avg. Temperature (C)") %>%
    addCircleMarkers(
      data = hummingbird_cleaned, 
      lng = ~decimalLongitude, lat = ~decimalLatitude, 
      color = ~season_pal(season), 
      radius = 2.5, stroke = FALSE, fillOpacity = 0.8, 
      popup = ~paste0(
        "<b>Species:</b> ", species, "<br>",
        "<b>Date:</b> ",    eventDate, "<br>",
        "<b>Season:</b> ",  season, "<br>",
        "<b>State:</b> ",   stateProvince),
      group = "Hummingbird Observations") %>%
    addCircleMarkers(
      data = top_3_cities, 
      lng = ~lng, lat = ~lat, radius = 8, 
      color = "black", 
      popup = ~paste0("<b>", city, "</b><br>Population: ", pop),
      group = "Major Cities") %>%
    addLayersControl(
      baseGroups = "Base Map", 
      overlayGroups = c("Elevation (m)", "Avg. Temperature (C)", "Hummingbird Observations", "Major Cities"), 
      options = layersControlOptions(collapsed = FALSE)
    ) %>%
    hideGroup("Elevation (m)") %>%
    hideGroup("Avg. Temperature (C)") %>%
    addLegend(
      position = "topleft", 
      pal = season_pal, 
      values = hummingbird_cleaned$season, 
      title = "Observation Season", 
      opacity = 0.8) %>%
    addLegend(
      position = "bottomleft", 
      pal = temp_pal, 
      values = values(temp_crop), 
      title = "Mean Annual Temp (C)", 
      opacity = 0.8) %>%
    addLegend(
      position = "bottomright", 
      pal = elev_pal, 
      values = values(elev_crop), 
      title = "Elevation (m)", 
      opacity = 0.8) %>%
    addScaleBar(position = "bottomleft")

## Warning: [readValues] raster has no values

## Warning in min(x): no non-missing arguments to min; returning Inf

## Warning in max(x): no non-missing arguments to max; returning -Inf

## Warning: [readValues] raster has no values

map_hummingbird

Lab 5

Olivia Conte

2026-03-03

R Markdown

Map Design Choices