The question

Malaria was one of the first health effects people suspected climate change might cause, and the question has been debated for decades. Despite progress in climate attribution, many health effects of climate change still haven’t been measured. We used over a century of clinical data to test whether human-caused warming has actually changed the burden of childhood malaria across sub-Saharan Africa.

What we found

• Temperature and extreme precipitation have a robust effect on malaria prevalence. This matches earlier local studies and laboratory experiments.
• The past effect differs by region. Rising temperatures have probably increased malaria in East and southern Africa but averted a comparable number of cases in West Africa. Across the continent, the net effect is about 1 excess case per 1,000 children (95% CI −4 to 6).
• The future could look different from what many expect. Over the coming century, climate change could slightly speed up malaria elimination in West and central Africa, where the burden is highest today. Across the continent, it could avert 1 (low emissions) to 20 (high emissions) cases per 1,000 children by 2100.
• Mitigation still matters a great deal locally. Holding warming under 2 °C instead of 3 °C could prevent an average of about 5 excess cases per 1,000 children by 2100 in high-elevation East Africa (above 1 km) and in southern Africa.

Why it matters

The results settle a long-running debate and give a template for measuring the true global health burden of climate change. The effects vary a lot from region to region, and a single continental number can hide large local risks.

The data behind the paper are openly available on Zenodo.

Citation: Carlson, C.J., Carleton, T., Odoulami, R.C., Molitor, C., Trisos, C.H. (2026). The past and future impact of climate change on childhood malaria in Africa. Nature, 657(8131), 487–494. doi:10.1038/s41586-026-10840-w

The problem

Satellite imagery covers the whole globe, but the labels used to train models on it usually don’t. They tend to be small, spatially clustered, and collected for some other purpose, such as administrative surveys or field plots. Most research responds with new model architectures built to cope with scarce data. That leaves a practical question unanswered: if you have money to collect more data, where should you collect it?

What we did

We wrote down the first formal version of this problem. It has two features that real fieldwork always has: collection costs that vary from place to place (some sites are harder to reach than others) and a fixed budget. We then developed new methods for choosing which locations to sample under those constraints.

What we found

We ran simulations across three continents and four prediction tasks. Optimizing where samples are collected produced substantial gains in model performance. Further experiments showed which settings benefit most from optimized sampling.

Why it matters

The methods are designed to carry over to any domain that uses satellite machine learning. We paid particular attention to one setting where our coauthors can use the results right away: adding to clustered agricultural surveys in Togo so they can support satellite-based monitoring. This links closely to my maize yield work in Zambia, where limited ground data is the main bottleneck.

Citation: Betti, L., Sanni, F., Sogoyou, G.Z., Agbagla, T., Molitor, C., Carleton, T., Rolf, E. (2026). Mapping on a Budget: Optimizing Spatial Data Collection for ML. Proceedings of the AAAI Conference on Artificial Intelligence, 40(45), 38233–38241. doi:10.1609/aaai.v40i45.41162

The question

Zambia is prone to severe droughts and crop failures, but ground data on yields is limited. During COVID-19, for example, district-level maize surveys stopped entirely. Methods like MOSAIKS make it cheap to turn satellite imagery into features for prediction. Until now, though, nobody had tested whether these simple pipelines can track change over time in a low-data, developing-country setting. Most evaluations only look at variation across space.

What we did

We computed random convolutional features from Landsat and Sentinel-2 imagery and paired them with district-level yield data. We then fit plain linear ridge regression models. There is no deep learning and no task-specific architecture.

What we found

• The model explains 83% of out-of-sample maize yield variation from 2016 to 2021. That is slightly better than a model built on NDVI features, the standard approach practitioners use to monitor crop health.
• The real difference shows up over time. When predicting year-to-year variation alone, our model keeps an R² of 0.74, while the NDVI model drops to 0.39.

Why it matters

Monitoring droughts and food security depends on catching change from year to year. Our results show that task-agnostic featurization can capture that change even where ground truth is sparse and compute is limited. Imagery-based monitoring can work in exactly the places where expensive approaches are out of reach.

Citation: Molitor, C., Cohen, J., Lewin, G., Cognac, S., Hadunka, P., Proctor, J., Carleton, T. (2025). Monitoring Maize Yield Variability over Space and Time with Unsupervised Satellite Imagery Features. Remote Sensing, 17(21), 3641. doi:10.3390/rs17213641

Data exploration

The published data product includes 11 sets (1 for each time step) of global tidal flat extent maps at 30 meter Ground Sample Distance (GSD; AKA resolution). This means that each pixel in each raster represents 30 m², and contains either 0 for “not tidal flat”, or 1 for “tidal flat.” This is a massive amount of data, but thankfully, each of the 11 time steps were broken into 108 files with discrete spatial extents, making individual files easy to work with.

So where to begin? Well first, we needed to access the data. The authors provide several options for data access including through Google Earth Engine, UNEP-WCMC Ocean Data Viewer, and finally through direct download. We chose the direct download option and wrote a simple shell script that is executed in an R Markdown code chunk.

### Make the new directory and move into it
mkdir /<path>/<to>/<directory>/<of>/<choice>/tidal_flats && cd $_

### Declare an array of strings, one for each time step
declare -a StringArray=(
  "1984-1986" "1987-1989" "1990-1992" "1993-1995" "1996-1998" 
  "1999-2001" "2002-2004" "2005-2007" "2008-2010" "2011-2013" 
  "2014-2016"
)

### Iterate through the array using for loop
for val in ${StringArray[@]}; do
  echo $val
  wget https://storage.googleapis.com/uq-intertidal/v1_1/global_intertidal/$val.zip
  unzip $val.zip -d ./$val
  rm $val.zip
done

With the data in hand, we first do some basic exploration and ensure it is what we expect, and that it makes sense. The terra package has some handy functions for doing this. After reading the first file of the first time step with terra::rast(), I used terra::freq() to check how many unique values there were, expecting only 0 or 1 based on the metadata.

image <- here::here("tidal_flats", "1984-1986", "-100_-20.tif") %>% 
  terra::rast() 
image # print the raster metadata

Output (raster metadata)

class       : SpatRaster 
dimensions  : 74213, 74213, 1  (nrow, ncol, nlyr)
resolution  : 0.0002694946, 0.0002694946  (x, y)
extent      : -160, -140, -20, 0  (xmin, xmax, ymin, ymax)
coord. ref. : lon/lat WGS 84 (EPSG:4326) 
source      : -160_0.tif 
name        : classification

terra::freq(image)

Output (frequency table)

     layer value      count
[1,]     1     0 5507569369

Dang! All 0’s. This is most likely due to the spatial tile not intersecting any intertidal region. There will be many tiles over nothing but ocean or land. While not a satisfying result for our first data exploration, it is important to anticipate what you are looking for and what you might find. Lets take a look at this files spatial extent in relation to the global coastline to make sure that our results match what we now expect of it.

library(rnaturalearth)
library(rnaturalearthdata)
library(tidyterra)

world <- ne_countries(scale = "medium", returnclass = "sf")

extent <- terra::ext(image)

extent_polygon <- terra::as.polygons(extent)

terra::crs(extent_polygon) <- "epsg:4326"

ggplot(data = world) +
  geom_sf() +
  tidyterra::geom_spatvector(data = extent_polygon, color = "Red", fill = NA)

Looks like our intuition matches the result! This plot shows the extent only covers open ocean.

Now lets examine another raster to see what kind of unique value we get.

image <- here::here("tidal_flats", "1984-1986", "0_-20.tif") %>% 
  terra::rast() %>% 
  terra::freq()

Output (frequency table)

     layer value      count
[1,]     1     0 5506916280
[2,]     1     1     653089

That is better! Now lets see where this file lands on the globe.

extent_polygon <- terra::ext(image) %>% 
  terra::as.polygons()

terra::crs(extent_polygon) <- "epsg:4326"

ggplot(data = world) +
  geom_sf() +
  tidyterra::geom_spatvector(data = extent_polygon, color = "Red", fill = NA)

Now we can see that this tile falls along a section of coastline, and has both 0 and 1 values. Things look good so far.

Transforming the data

Now that we know our files contain what we expect, and have seen a few outputs, it is time to design a workflow that will allow us to extract the information we want from the files. For OHI, our goal is to summarize the extent of habitat in each region, for each time step. Our ideal final product will have an extent measured in \(km^2\), the region ID, the year, and the habitat type.

Even though each time step is broken into 108 files, the resolution still makes this data hard to work with. The terra package offers a solution to reduce resolution, often referred to as down-sampling. The function terra::aggregate() allows a user to specify how many pixels should be connected into one and what function to use on the pixels being aggregated. In our case we want to sum the pixels to retain all of the habitat information. We want to choose a resolution that will allow us to continue using the rasters for analysis without bogging down our computer. We chose to down-sample to ~1 \(km^2\) resolution by choosing 30 pixels as our aggregation factor. Our function then looks like:

down_sampled_image <- terra::aggregate(
  x = image, 
  fact = 30, 
  fun = sum, 
  na.rm = T
)

The true resolution in \(km^2\) can be found with a bit of simple math, 30 meters by 30 pixels is 900 meters to a side, and squaring that gives our new pixel dimensions of \(900 x 900\) meters. We then divide these new dimensions by by a pixel with an area of 1 \(km^2\): \[\frac{900 * 900}{1,000 * 1,000} = .81 \text{ }km^2\] Using 33 pixels would have brought us closer to 1 \(km^2\), but this brings the image to a reasonable size, and in general we would like to keep the resolution as high as possible.

Our next goal is to convert pixel counts into area. If the native raster cells are 30 x 30 meters, then a raster cell with a value of 1 would be equivalent to 0.0009 \(km^2\) habitat area. This can be found by multiplying the pixel dimensions together and dividing by a pixel with an area of 1 \(km^2\): \[\frac{30 * 30}{1,000 * 1,000} = 0.0009 \text{ }km^2\] The simplest way to convert to area in this scenario is to simply multiply our down-sampled raster by 0.0009.

down_sampled_image <- down_sampled_image * 0.0009

This works because each pixel started out as a 0 or a 1, so the aggregated raster has values in multiples of 1. We can check this by again using terra::freq() to see that our new raster has values in multiples of 0.0009. We use the digits argument to make sure values are not rounded to 0 in the output table.

terra::freq(
  down_sampled_image, 
  digits = 6
) 

Output (frequency table)

     layer  value   count
[1,]     1 0.0000 6117245
[2,]     1 0.0009      61
[3,]     1 0.0018      59
(cropped for brevity)

Results look good! Just as expected, we now have raster cells at ~1 \(km^2\) resolution, with cell values representing the area in \(km^2\) of tidal flat habitat. In this case there are 61 cells which contained a single cell of tidal flat, prior to aggregation, 59 which had two, and so on.

Now we need to extract the values that fall with each OHI region polygon. To do this we use another package new to OHI, exactextractr. As we saw in the previous post on soft bottom habitat analysis, this package allows us to extract values from polygons and return an estimate if a polygon goes through a raster cell. This is handy to implement after aggregation as it allows us to maintain a higher level of precision. The raster::extract() function will only include a cell if the center of the cell falls inside a polygon. Our shapefile has separate polygons for all regions’ EEZ’s and for their land area. We want to use both because our data primarily goes through the intersection of these two polygons.

The first thing we need to do is download the OHI region polygon file.

mkdir /<path>/<to>/<directory>/<of>/<choice>/regions && cd $_
wget https://ohi.nceas.ucsb.edu/data/data/regions.zip
unzip regions.zip 
rm regions.zip

Next we read in the data and filter for what we want. We also create a dummy dataframe to use when reconstructing the extracted values into a usable data format.

regions_eez_and_land <- here::here('regions', 'regions.shp') %>% 
  sf::read_sf() %>%
  dplyr::filter(rgn_type %in% c("eez", 'land')) %>% 
  sf::st_transform(crs = 4326)
  
dummy_df <- regions_eez_and_land %>% 
  tibble::as_tibble() %>% 
  dplyr::select(rgn_id, rgn_name) 

We use the sum of values in our extraction because our downsampled image has also been converted to area in each pixel. The sum will give us the total area inside each polygon. Our function to extract values then looks like:

exactextractr::exact_extract(
 x = down_sampled_image, 
 y = regions_eez_and_land, 
 fun = 'sum'
)

Putting it all together

Now that we have a workflow that has been tested on a single raster, all we have to do is design a loop that goes through each raster file and outputs a simple .csv file.

### Create an empty intermediate output folder
dir.create("int") 

tictoc::tic() # time this code 

folders <- here::here("tidal_flats") %>% 
  list.files()

j <- 1

### To run this code in parallel, 
### Uncomment next two lines and comment out one after
### You will loose the pretty output messages :(

# doParallel::registerDoParallel(11)
# foreach::foreach (dir = folders) %dopar% {

for (dir in folders) { 
  
  files <- here::here("tidal_flats", dir) %>% 
    list.files()
  
  year = stringr::str_split(dir, pattern = "-", n = 2)[[1]][2]
  
  for (file in files){
    
    cat(j, "/", length(files), "\n")
    
    j <- j + 1
    
    fn <- file %>% 
      stringr::str_replace(
        pattern     = ".tif",
        replacement = paste0("_", year, ".csv"))
    
    ### make a new int folder to hold the output
    
    file_name <- here::here("int", "tidal_flat", fn)
    
    if(!file.exists(file_name)){
      
      cat(fn, " is being created!\n")
      
      cat("    down sampling...\n")
      
      image <- here::here("tidal_flats", dir, file) %>% 
        terra::rast() 
       
      down_sampled_image <- terra::aggregate(
        x = image, 
        fact = 30, 
        fun = sum,
        na.rm = T
      )

      cat("    converting to area (km2)...\n\n")
      
      down_sampled_image <- down_sampled_image * 0.0009
      
      cat("    extracting...\n")
      
      extracted_values <- exactextractr::exact_extract(
        x = down_sampled_image, y = regions_eez_and_land, fun = 'sum'
      )
      
      cbind("km2" = extracted_values, dummy_df) %>% 
        dplyr::group_by(rgn_id, rgn_name) %>% 
        dplyr::summarise(km2 = sum(km2)) %>% 
        dplyr::mutate(year = year, habitat = "tidal flat") %>% 
        readr::write_csv(file_name)
      
    } else {cat(paste0(fn, " already exists!\n"))}
  }
}
tictoc::toc()

There is a lot to take in there, but if you follow it line by line it isn’t too bad.

To recap:
List raw data folders
Outer loop iterates through folders
List files in the folder
Find the year by splitting the folder name
Inner loop iterates through files in folder
Check if desired output already esists, if not, create it!
Create the SpatRaster
Down-sample resolution
Convert cell values to area
Extract area inside region polygons
Assign values to dummy dataframe Summarize to the region level
Write the results!

Consolidate results

The end result of the above workflow produces a single .csv file for every raster in every time step with the extent of tidal wetland in every OHI region. We also know that each raster only covers a 1/108 chunk of the globe, which means there are a lot of 0 values in each of the files. These can be further condensed and summarized with a simple for loop.

### Create an empty output folder
dir.create("output")

### list csv files with extracted tidal flat values
files <- here::here("int", "tidal_flat") %>% 
  list.files(full.names = T)

### make an empty tibble to fill through iteration
output <- tibble::tibble()

### loop through files
for (file in files) {
  
  ### read in files, suppress messages with col_types argument
  tmp <- readr::read_csv(file, col_types = cols()) 
  
  ### bind temporary output to complete output
  output <- rbind(output, tmp) 
}

### summarize results and write final output
final <- output %>%
  dplyr::group_by(rgn_id, year, habitat) %>%
  dplyr::summarise(km2 = sum(km2, na.rm = T)) %>% 
  dplyr::filter(rgn_id != 213) %>% 
  readr::write_csv(here::here('output', "tidal_flat_extent.csv"))

Now we have a single .csv file with every OHI region listed a single time for each time step, and a corresponding tidal flat extent for that region. This data is then used as a new layer when calculating the OHI scores.

Check out the full data prep used in the 2022 OHI assessment here.

References

• Daniel Baston (2022). exactextractr: Fast Extraction from Raster Datasets using Polygons. R package version 0.8.2, https://CRAN.R-project.org/package=exactextractr.

• Hijmans R (2022). terra: Spatial Data Analysis. R package version 1.6-3, https://CRAN.R-project.org/package=terra.

• Murray, N.J., Phinn, S.R., DeWitt, M. et al. The global distribution and trajectory of tidal flats. Nature 565, 222–225 (2019). https://doi.org/10.1038/s41586-018-0805-8

• R Core Team (2022). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.

• Wickham H, Averick M, Bryan J, Chang W, McGowan LD, François R, Grolemund G, Hayes A, Henry L, Hester J, Kuhn M, Pedersen TL, Miller E, Bache SM, Müller K, Ooms J, Robinson D, Seidel DP, Spinu V, Takahashi K, Vaughan D, Wilke C, Woo K, Yutani H (2019). “Welcome to the tidyverse.” Journal of Open Source Software, 4(43), 1686. https://doi.org/10.21105/joss.01686.

Presntation YouTube Link

Abstract

High-quality, long-term environmental data sets are the foundation of long-range risk and climate modeling. However, producing such datasets is costly, logistically challenging, and resource-intensive. Due to limited agricultural data across sub-Saharan Africa, policy-makers, farmers, and researchers are currently unable to accurately forecast short-run food security risks posed by weather anomalies and long-run climate change projections. Recent machine learning approaches applied to high-resolution satellite imagery have successfully modeled various social and environmental variables. Here, we expand upon a recently developed machine learning approach to build a model that predicts maize yields over time using public satellite imagery. We developed a generalizable pipeline from survey data through a use case for predicting maize yields in Zambia. In 2020 and 2021, the Zambia Statistics Agency could not survey maize growers due to the COVID-19 pandemic. We use our model to fill in this data gap of maize yield predictions during these years. Through parameter optimization, we selected the model with the best ability to predict over space and time. Our model performed better overall relative to its predictive performance over time. The processed satellite imagery, predictions, and pipeline serve as a tool for the research community and users interested in analyzing Zambia’s current and future food security risks. This pipeline further enables users to explore global and region-specific questions at scale.

Acknowledgemnts

Bren School: Tamma Carleton, Assistant Professor; Brad Hill, IT Director; Allison Horst, Assistant Teaching Professor; Kat Le, Technical Applications Manager

Jonathan Proctor, postdoctoral fellow at the Harvard Data Science Initiative and the Center for the Environment

Baylis Lab, University of California, Santa Barbara

Zambia Statistics Agency

Microsoft Planetary Computer: Caleb Robinson, Tom Augsburger

An open-source pipleline for remote sensing of crop yields under environmental change in sub-Saharan Africa

Geographic Data

ca <- read_sf("CA.gpkg")
Site_Info <- read_csv("Site_Info.csv")

Griddap Query

lat_min <- 33.35
lat_max <- 34.5
lon_min <- -120.75
lon_max <- -118.95

lat <- c(lat_min, lat_max)
lon <- c(lon_min, lon_max)

tm <- c(
  "2009-01-02T12:00:00Z",
  '2009-12-30T12:00:00Z'
)

SST <- 'jplMURSST41'
field <- 'analysed_sst'
murSST_west <- griddap(
  x = SST,
  latitude = lat,
  longitude = lon,
  time = tm,
  fields = field
)
sst <- tibble(murSST_west$data) %>%
  group_by(lat, lon) %>%
  summarise(sst = mean(analysed_sst))

Bathymetry Querry

ca_bath <- marmap::getNOAA.bathy(
  lon1 = lon_min - 1,
  lon2 = lon_max + 1,
  lat1 = lat_min - 1,
  lat2 = lat_max + 1,
  resolution = 1
) %>% 
  marmap::as.raster() %>% 
  raster::rasterToPoints() %>% 
  base::as.data.frame() 

Make California Map for Inset

box <- sf::st_polygon(
  x = list(
    rbind(
      c(lon_min, lat_max), 
      c(lon_max, lat_max), 
      c(lon_max, lat_min), 
      c(lon_min, lat_min),
      c(lon_min, lat_max)
    )
  )
) %>% st_sfc(crs = 4326)

C <- ggplot() +
  geom_sf(data = ca, fill = "white", size = 1) +
  geom_sf(data = box, fill = NA, size = 1, color = 'red') +
  theme_void() +
  theme(panel.border = element_rect(fill = NA),
        panel.background = element_rect(fill = alpha("white", .5)))

Plot Static Map

main.plot <- ggplot() +
  geom_raster(data = sst, aes(x = lon, y = lat, fill = sst), interpolate = T) +
  scale_fill_viridis_c(option = 'viridis', guide = guide_colorbar(
    direction = "horizontal",frame.colour = "black",
    title.position = "top", barheight = unit(.25, 'cm'))) +
  geom_sf(data = ca, fill = "grey70", color = "grey40", size = .1) +
  geom_contour(data = ca_bath, aes(x = x, y = y, z = layer),
    breaks = seq(min(ca_bath$layer), max(ca_bath$layer), by = 5),
    color = "black", alpha = .01, size = 1) +
  scale_x_continuous(limits = lon, expand = c(0,0), breaks = c(-120, -119.5)) +
  scale_y_continuous(limits = lat, expand = c(0,0), breaks = c(33.75, 34.25)) +
  geom_point(data = Site_Info, aes(x = Longitude, y = Latitude),
             color = '#d55b23', show.legend = F, inherit.aes = F) +
  scale_color_viridis_d(option = 'magma', begin = .2, end = .8, limits = force) +
  labs(fill = "SST (\u00B0C)", x = NULL, y = NULL) +
  annotation_scale(location = "bl") +
  annotation_north_arrow(which_north = TRUE, location = "tr", pad_x = unit(2.75, "cm"),
                         height = unit(1, "cm"), width = unit(1, "cm")) +
  theme_classic() +
  theme(legend.position = c(0.125, 0.12),
        legend.title = element_text(face = 'bold'),
        legend.text = element_text(face = 'bold'),
        legend.background = element_rect(fill = alpha("white", .25), colour = 'black'),
        axis.ticks.length = unit(-0.25, "cm"),
        axis.ticks = element_line(color = "black", size = 2),
        axis.text.y = element_text(hjust = .5, margin = margin(0,-.7,0,-.5, unit = 'cm'),
                                   face = 'bold', color = "white", angle = 270),
        axis.text.x = element_text(vjust = 5, margin = margin(-0.5,0,0.5,0, unit = 'cm'),
                                   face = 'bold', color = "white"),
        panel.border = element_rect(color = "black", size = 2, fill = NA)
  )

ggdraw() +
  draw_plot(main.plot) +
  draw_plot(C, x = 0.72, y = .77, width = .2, height = .2)

Plot Animated Map

Showing 2014-2016 to highlight the 2015-2016 El Nino.

redo <- FALSE

if (!file.exists("sst.gif") | redo){
  tm <- c(
    "2014-01-01T12:00:00Z",
    '2016-12-30T12:00:00Z'
  )
  
  murSST_west <- griddap(
    x = SST, 
    latitude = lat, 
    longitude = lon,
    time = tm, 
    fields = field
  )$data %>% 
    mutate(date_time = lubridate::as_datetime(time),
           date = lubridate::date(date_time)) %>% 
    group_by(date, lon, lat) %>% 
    summarise(sst = analysed_sst)
  
  p1 <- ggplot() +
    geom_raster(data = murSST_west, aes(x = lon, y = lat, fill = sst), interpolate = T) +
    scale_fill_viridis_c(option = 'viridis', guide = guide_colorbar(
      direction = "horizontal",frame.colour = "black",
      title.position = "top", barheight = unit(.25, 'cm'))) +
    geom_sf(data = ca, fill = "grey70", color = "grey40", size = .1) +
    geom_contour(data = ca_bath, aes(x = x, y = y, z = layer), 
                 breaks = seq(min(ca_bath$layer), max(ca_bath$layer), by = 5), 
                 color = "black", alpha = .01, size = 1) +
    scale_x_continuous(limits = lon, expand = c(0,0), breaks = c(-120, -119.5)) +
    scale_y_continuous(limits = lat, expand = c(0,0), breaks = c(33.75, 34.25)) +
    scale_color_viridis_d(option = 'magma', begin = .2, end = .8, limits = force) +
    labs(fill = "SST (\u00B0C)", 
         title = "{frame_time}",
         x = NULL, y = NULL) +
    annotation_scale(location = "bl") +
    annotation_north_arrow(which_north = TRUE, location = "tr", #pad_x = unit(2.75, "cm"),
                           height = unit(1, "cm"), width = unit(1, "cm")) +
    theme_classic() +
    theme(legend.position = c(0.125, 0.12),
          legend.title = element_text(face = 'bold'),
          legend.text = element_text(face = 'bold'),
          legend.background = element_rect(fill = alpha("white", .25), colour = 'black'),
          axis.ticks.length = unit(-0.25, "cm"),
          axis.ticks = element_line(color = "black", size = 2),
          axis.text.y = element_text(hjust = .5, margin = margin(0,-.7,0,-.5, unit = 'cm'),
                                     face = 'bold', color = "white", angle = 270),
          axis.text.x = element_text(vjust = 5, margin = margin(-0.5,0,0.5,0, unit = 'cm'),
                                     face = 'bold', color = "white"),
          panel.border = element_rect(color = "black", size = 2, fill = NA)) +
    gganimate::transition_time(date)
  
  gganimate::animate(p1, width = 720, height = 480,
                     # renderer = av_renderer(),
                     nframes = 100, fps = 10)
  
  anim_save(filename = "sst.gif", animation = last_animation())
}

Data

The Kelp Forest Monitoring (KFM) program at Channel Islands National Park has been collecting abundance and size distribution data of more than 170 species since 1982 (sampled annually). The park currently samples 33 sites at the five islands in the National Park. This data is publicly available and was requested and issued under a scientific research and collecting permit (permit #: CHIS-2020-SCI-0006). These data are collected using scuba surveys where the biologists attempt to minimize their impact on the reef by using non-invasive sampling methods. This means that animals are counted in situ and no rocks are overturned or species removed. This inevitably biases the data towards adult populations of certain invertebrates that utilize crevice habitat during development as they will be hidden from direct observation.

The fish data is collected in (#\(/m^3\)). In order to assure that all data are in the same units, only measurements of invertebrate and algae density (#\(/m^2\)) are retained. This takes the total number of species with density data from 151 down to 35. Using species density, we can identify trends in abundance observed over multiple El Niño (warm-water) and La Niña (cold-water) events. Using a dynamic linear model with lag independent variables we can see the effect of sea surface temperature anomalies during and in the years following these events on species density.

Below we read in ENSO data and calculate yearly mean anomalies before making 5 new columns with corresponding lag values. We then load in the species density data and filter out fish and 2 species which are exceedingly rare and do not have enough data to model. This leaves us with 33 species to model, all with the same units.

# Load libraries
library(tidyverse)
library(here)
library(lubridate)
library(broom)
library(arrow)
library(plotly)

# Load and Tidy Data
oni_yearly <-  # Read in Oceanic Nino Index region 3.4 data
  read.table(
    "https://origin.cpc.ncep.noaa.gov/products/analysis_monitoring/ensostuff/detrend.nino34.ascii.txt",
    header = T) %>%
  # rename YR for joining tables
  dplyr::rename(SurveyYear = YR) %>% 
  dplyr::group_by(SurveyYear) %>% 
  # Calculate yearly SST Anom
  dplyr::summarise(SST_Anom = mean(ANOM)) %>% 
  # Create lagged SST
  dplyr::mutate(SST_Anom_1 = lag(SST_Anom, n = 1),
                SST_Anom_2 = lag(SST_Anom, n = 2),
                SST_Anom_3 = lag(SST_Anom, n = 3),
                SST_Anom_4 = lag(SST_Anom, n = 4),
                SST_Anom_5 = lag(SST_Anom, n = 5))


density <-  # Read in Density data
  arrow::read_feather("Density.feather") %>%
  dplyr::filter(Classification != "Fish",
                !CommonName %in% c("wakame, adult", 
                                   "wakame, juvenile", 
                                   "white abalone")) %>% 
  dplyr::left_join(oni_yearly)

Analysis

This analysis will use a general model formula of lm(Mean_Density ~ SST_Anom + SST_Anom_1 + SST_Anom_2 + SST_Anom_3 + SST_Anom_4 + SST_Anom_5) applied to density data grouped by each species scientific name. These five lag periods will show how a species is affected within the same year, and for the next five years following anomalous warm or cold water. We expect recruitment of certain species will either increases or decreases following warmer than usual or colder than usual ocean temperatures. Given what we know about the life cycle of many marine species, it is reasonable to assume these effects would not be detected by non-invasive sampling techniques for 1-5 years following anomalous temperatures.

This analysis is simplified to detect trends in a large number of species and does not take into account the effect of biogeography. This also does not consider the impact of marine protected areas (MPAs) which potentially buffer the ecological community from the effects of abiotic factors such as SST. MPAs could also have an effect from increased predation to some of these species, potentially limiting their abundance.

The cumulative effect on all species will be plotted. Then the results will be filtered to only include significant affects and sorted by the estimated slope of their relationship. The two species with the most positive slope and the two with the most negative slope will have their coefficients plotted over the lag periods.

Results_lag <- density %>% 
  dplyr::group_by(ScientificName) %>%
  dplyr::summarise(
    generics::tidy(
      stats::lm(
        Mean_Density ~ SST_Anom + SST_Anom_1 + SST_Anom_2 + SST_Anom_3 + SST_Anom_4 + SST_Anom_5
        ))) %>% 
  dplyr::filter(term != "(Intercept)") %>% 
  dplyr::mutate(significant = ifelse(p.value <= .05, "yes", "no"))

Results

Results_filtered <- Results_lag %>%
  dplyr::filter(p.value <= .05) %>% 
  dplyr::arrange(estimate) %>%
  dplyr::mutate(statistic = round(statistic, 3),
                p.value = round(p.value, 3),
                p.value = ifelse(p.value < 0.001, "< 0.001", as.character(p.value))) 
cold_sp <- Results_filtered %>% 
  arrange(estimate) %>% 
  distinct(ScientificName) %>% 
  head(3) %>% 
  pull()

warm_sp <- Results_filtered %>% 
  arrange(desc(estimate)) %>% 
  distinct(ScientificName) %>% 
  head(3) %>% 
  pull()

cold <- Results_lag %>% 
  group_by(ScientificName) %>% 
  mutate(cum_est = cumsum(estimate)) %>% 
  filter(ScientificName %in% cold_sp)

warm <- Results_lag %>% 
  group_by(ScientificName) %>% 
  mutate(cum_est = cumsum(estimate)) %>% 
  filter(ScientificName %in% warm_sp)

plt <- function(.data = cold) {
  ggplot(data = .data, aes(x = term, y = cum_est)) +
    geom_line(aes(color = ScientificName, group = ScientificName), size = 1) +
    geom_point(aes(shape = significant), size = 4) +
    scale_y_continuous(expand = c(0, 1)) +
    scale_x_discrete(labels = c("Current Year", "+1", "+2", "+3", "+4", "+5")) +
    scale_color_viridis_d(option = "D", end = .75, direction = -1) +
    labs(x = "Years relative to SST anomaly exposure", y = "Cumulative effect (sum of coefficients)",
         shape = "P-Val < .05?", color = "Species") +
    theme_classic() 
}

plt()

plt(.data = warm)

Future Work

Code Availability

GitHub Repository with all code and data available at this link.

Literature Cited

Costello, M.J., Tsai, P., Wong, P.S. et al. Marine biogeographic realms and species endemicity. Nat Commun 8, 1057 (2017). https://doi.org/10.1038/s41467-017-01121-2

Day, P. B., Stuart-Smith, R. D., Edgar, G. J. & Bates, A. E. Species’ thermal ranges predict changes in reef fish community structure during 8 years of extreme temperature variation. Divers. Distrib. 24, 1036–1046 (2018).

Freedman, R.M., Brown, J.A., Caldow, C. et al. Marine protected areas do not prevent marine heatwave-induced fish community structure changes in a temperate transition zone. Sci Rep 10, 21081 (2020). https://doi.org/10.1038/s41598-020-77885-3

Horta e Costa, B. Tropicalization of fish assemblages in temperate biogeographic transition zones. Mar. Ecol. Prog. Ser. 504, 241–252 (2014).

Miller, K. A., Engle, J. M., Uwai, S., & Kawai, H. (2007). First report of the asian seaweed sargassum filicinum harvey (fucales) in california, usa. Biological Invasions, (9), 609-613.

Wernberg, T. S. et al. Climate-driven regime shift of a temperate marine ecosystem. Science 353, 169–172 (2016).

Zacharias, Mark, and David J. Kushner. 2006. “Sea temperature and wave height as predictors of population size structure and density of Megastraea (Lithopoma) undosa: Implications for fishery management.” Bulletin of Marine Science 79.1: 71-82.

HW3 Making Waves: CDIP Dataset Tutorial and Use Case Examples

import netCDF4
import numpy as np
import matplotlib.pyplot as plt
import datetime
import time
import calendar
import pandas as pd
from matplotlib import gridspec
from matplotlib import cm
import matplotlib as mpl

# Type
stn = '071'

# CDIP Archived Dataset URL
data_url = 'http://thredds.cdip.ucsd.edu/thredds/dodsC/cdip/archive/' + stn + 'p1/' + stn + 'p1_historic.nc'

data = netCDF4.Dataset(data_url)

# return the file type
type(data)

netCDF4._netCDF4.Dataset

# return a summary of the dataset
data.summary

'Directional wave and sea surface temperature measurements collected in situ by Datawell Waverider buoys located near HARVEST, CA from 1991/10/22 to 2019/06/17. This dataset includes publicly-released data only, excluding all records flagged bad by quality control procedures. A total of 372110 wave samples were analyzed for this area, where the water depth is approximately 183 to 549 meters.'

# return all variables included in the dataset
print(data.variables.keys())

dict_keys(['sourceFilename', 'waveTime', 'waveTimeBounds', 'waveFlagPrimary', 'waveFlagSecondary', 'waveHs', 'waveTp', 'waveTa', 'waveDp', 'wavePeakPSD', 'waveTz', 'waveSourceIndex', 'waveFrequency', 'waveFrequencyBounds', 'waveFrequencyFlagPrimary', 'waveFrequencyFlagSecondary', 'waveBandwidth', 'sstTime', 'sstTimeBounds', 'sstFlagPrimary', 'sstFlagSecondary', 'sstSeaSurfaceTemperature', 'sstSourceIndex', 'sstReferenceTemp', 'gpsTime', 'gpsTimeBounds', 'gpsStatusFlags', 'gpsLatitude', 'gpsLongitude', 'gpsSourceIndex', 'dwrTime', 'dwrTimeBounds', 'dwrSourceIndex', 'dwrBatteryLevel', 'dwrZAccelerometerOffset', 'dwrXAccelerometerOffset', 'dwrYAccelerometerOffset', 'dwrOrientation', 'dwrInclination', 'dwrBatteryWeeksOfLife', 'metaDeployLatitude', 'metaDeployLongitude', 'metaWaterDepth', 'metaDeclination', 'metaStationName', 'metaStationLatitude', 'metaStationLongitude', 'metaPlatform', 'metaInstrumentation', 'metaGridMapping', 'waveEnergyDensity', 'waveMeanDirection', 'waveA1Value', 'waveB1Value', 'waveA2Value', 'waveB2Value', 'waveCheckFactor', 'waveSpread', 'waveM2Value', 'waveN2Value'])

# learn more about a variable including long name, units, valid min/max values
print(data['sstSeaSurfaceTemperature'])

<class 'netCDF4._netCDF4.Variable'>
float32 sstSeaSurfaceTemperature(sstTime)
    long_name: sea surface temperature
    units: Celsius
    _FillValue: -999.99
    standard_name: sea_surface_temperature
    coordinates: metaStationLatitude metaStationLongitude
    grid_mapping: metaGridMapping
    valid_min: -5.0
    valid_max: 46.15
    ancillary_variables: sstFlagPrimary sstFlagSecondary
    ncei_name: SEA SURFACE TEMPERATURE
    cell_methods: sstTime: point
unlimited dimensions: 
current shape = (372015,)
filling off

# Other Variables
# data.variables
# Hs = data.variables['waveHs']
# Tp = data.variables['waveTp']
# Dp = data.variables['waveDp'] 

# Get SST timestamp variable 
sst_time_var = data.variables['sstTime']

# Get SST variable 
sst = data.variables['sstSeaSurfaceTemperature'][:]

# Get wave height timestamp variable
wave_time_var = data.variables['waveTime']

# Get wave height variable 
wave = data.variables['waveHs'][:]

# Use num2date on sst_time_var
sst_time = netCDF4.num2date(sst_time_var[:], sst_time_var.units, only_use_cftime_datetimes=False)

# Make an empty pandas dataframe
sst_df = pd.DataFrame()

# Fill it with SST and the date time it was collected
sst_df['sst'] = sst
sst_df['date_time'] = sst_time

# Make date_time column a pandas date_time
sst_df['date_time'] = pd.to_datetime(sst_df['date_time']) 

# Pull out date from datetime
sst_df['date'] = sst_df['date_time'].dt.date

# Pull out month from datetime
sst_df['month'] = sst_df['date_time'].dt.month

# Pull out year from datetime
sst_df['year'] = sst_df['date_time'].dt.year

# Use num2date on wave_time_var
wave_time = netCDF4.num2date(wave_time_var[:], wave_time_var.units, only_use_cftime_datetimes=False)

# Make an empty pandas dataframe
wave_df = pd.DataFrame()

# Fill it with SST and the date time it was collected
wave_df['wave'] = wave
wave_df['date_time'] = wave_time

# Make date_time column a pandas date_time
wave_df['date_time'] = pd.to_datetime(wave_df['date_time']) 

# Pull out date from datetime
wave_df['date'] = wave_df['date_time'].dt.date

# Pull out month from datetime
wave_df['month'] = wave_df['date_time'].dt.month

# Pull out year from datetime
wave_df['year'] = wave_df['date_time'].dt.year

# Inspect data
sst_df.head()

wave_df.head()

path = "https://www.cpc.ncep.noaa.gov/data/indices/ersst5.nino.mth.91-20.ascii"
enso = pd.read_csv(path, sep = '\s{2,}', engine = 'python')
enso.head()

# drop unused columns from ENSO data
enso = enso.drop(enso.columns[[2, 3, 4, 5, 6, 7, 8]], axis=1)

# rename columns
enso = enso.rename(columns={"YR":"year", "MON":"month", "ANOM.3": "enso_anom"})
enso.head()

# Plot here to see what the data looks like
f, (pHs, pSst) = plt.subplots(2, 1, sharex=True, figsize=(15,10)) 
pSst.plot(sst_df.date, sst_df.sst, linewidth = 0.5)
pHs.plot(wave_df.date, wave_df.wave, linewidth = 0.5)
plt.title("Harvest Buoy", fontsize=30, y = 2.3)
pHs.set_ylabel('Wave Height, m', fontsize=18)
pSst.set_ylabel('SST, C', fontsize=18)

Text(0, 0.5, 'SST, C')

enso = enso.assign(day = 1)
enso['date'] = pd.to_datetime(enso[['year', 'month', 'day']])

# Choose color gradient here: https://matplotlib.org/stable/tutorials/colors/colormaps.html 

colourmap = cm.get_cmap('magma')

xx = enso.date
yy =  enso.enso_anom

plt.figure(figsize = (15, 5))
plt.plot(xx,yy, color = 'none')

normalize = mpl.colors.Normalize(vmin=yy.min(), vmax=yy.max())
npts = len(enso)
for i in range(npts - 1):
    plt.fill_between([xx[i], xx[i+1]],
                     [yy[i], yy[i+1]],
                     color=colourmap(normalize(yy[i]))
                     ,alpha=0.6)
plt.show()

# Filter data to be greater than 1997 due to missing values before that time
sst_df = sst_df[sst_df['year'] > 1997]

wave_df = wave_df[wave_df['year'] > 1997]

# Group by date and summarise with mean SST and Wave Height
sst_monthly = sst_df.groupby(['month', 'year']).agg({'sst': 'mean'})

wave_monthly = wave_df.groupby(['month', 'year']).agg({'wave': 'mean'})

# Inspect Data
print(sst_monthly.head())
print(wave_monthly.head())

                  sst
month year           
1     1999  13.194914
      2000  13.023686
      2001  13.454234
      2002  12.896236
      2003  14.313378
                wave
month year          
1     1999  2.467315
      2000  2.126410
      2001  2.971848
      2002  2.609128
      2003  2.432630

# join monthly sst and wave data into a buoy dataframe
buoy_df = sst_monthly.join(wave_monthly)
buoy_df.head()

buoy_df = buoy_df.reset_index()
buoy_df.head()

# calculate the anomalies
buoy_df = buoy_df.groupby(['month', 'year']).agg({'sst': 'mean', 'wave': 'mean'}) - \
    buoy_df.groupby(['month']).agg({'sst': 'mean', 'wave': 'mean'}) 
buoy_df.head()

# since this line of code was so long, use used a `\` to break up the line. You can also split up lines at commas

buoy_df = buoy_df.reset_index()
buoy_df.head()

# rename columns
buoy_df = buoy_df.rename(columns = {'sst':'buoy_sst_anom', 'wave':'buoy_wave_anom'})

# Assign arbitrary day value
buoy_df = buoy_df.assign(day = 1) 

# set datetime 
buoy_df['date'] = pd.to_datetime(buoy_df[['year', 'month', 'day']])

# sort values
buoy_df = buoy_df.sort_values(by=['date'])

# set the index for plotting
buoy_df = buoy_df.set_index('date')

# Inspect
buoy_df.head()

buoy_df = buoy_df.drop(["month", "year", "day"], axis=1).reset_index()
enso = enso.drop(["year", "month", "day"], axis = 1)

anom_df = buoy_df.set_index('date').join(enso.set_index('date')).reset_index()

# Plot sst and wave height anomaly from buoy along with ENSO sst anomaly
f, (bwa, bsa, esa ) = plt.subplots(3, 1, sharex=True, figsize=(15,10))

bwa.plot(anom_df.date, anom_df.buoy_wave_anom)
bwa.fill_between(anom_df.date, anom_df.buoy_wave_anom, 0, alpha=0.30)
bwa.axhline(0,color='red')
bwa.set_ylabel('Buoy Wave Height Anomaly')

bsa.plot(anom_df.date, anom_df.buoy_sst_anom)
bsa.fill_between(anom_df.date, anom_df.buoy_sst_anom,  0, alpha=0.30)
bsa.axhline(0,color='red')
bsa.set_ylabel('Buoy SST Anomaly')

esa.plot(anom_df.date, anom_df.enso_anom)
esa.fill_between(anom_df.date, anom_df.enso_anom,  0, alpha=0.30)
esa.axhline(0,color='red')
esa.set_ylabel('ENSO Anomaly')

Text(0, 0.5, 'ENSO Anomaly')

import statsmodels.api as sm

# Simple linear model: buoy sst anomaly vs enso sst anomaly
model = sm.OLS(anom_df.buoy_sst_anom, anom_df.enso_anom)

# Model results
results = model.fit()

# Model summary
print(results.summary())

                                 OLS Regression Results                                
=======================================================================================
Dep. Variable:          buoy_sst_anom   R-squared (uncentered):                   0.282
Model:                            OLS   Adj. R-squared (uncentered):              0.279
Method:                 Least Squares   F-statistic:                              98.58
Date:                Tue, 07 Dec 2021   Prob (F-statistic):                    8.24e-20
Time:                        18:09:44   Log-Likelihood:                         -312.83
No. Observations:                 252   AIC:                                      627.7
Df Residuals:                     251   BIC:                                      631.2
Df Model:                           1                                                  
Covariance Type:            nonrobust                                                  
==============================================================================
                 coef    std err          t      P>|t|      [0.025      0.975]
------------------------------------------------------------------------------
enso_anom      0.5964      0.060      9.929      0.000       0.478       0.715
==============================================================================
Omnibus:                       11.182   Durbin-Watson:                   0.808
Prob(Omnibus):                  0.004   Jarque-Bera (JB):               12.718
Skew:                           0.402   Prob(JB):                      0.00173
Kurtosis:                       3.751   Cond. No.                         1.00
==============================================================================

Notes:
[1] R² is computed without centering (uncentered) since the model does not contain a constant.
[2] Standard Errors assume that the covariance matrix of the errors is correctly specified.

# Simple linear model: buoy wave anomaly vs enso sst anomaly
model = sm.OLS(anom_df.buoy_wave_anom, anom_df.enso_anom)

# Model results
results = model.fit()

# Model summary
print(results.summary())

                                 OLS Regression Results                                
=======================================================================================
Dep. Variable:         buoy_wave_anom   R-squared (uncentered):                   0.000
Model:                            OLS   Adj. R-squared (uncentered):             -0.004
Method:                 Least Squares   F-statistic:                           0.006389
Date:                Tue, 07 Dec 2021   Prob (F-statistic):                       0.936
Time:                        18:09:44   Log-Likelihood:                         -11.128
No. Observations:                 252   AIC:                                      24.26
Df Residuals:                     251   BIC:                                      27.79
Df Model:                           1                                                  
Covariance Type:            nonrobust                                                  
==============================================================================
                 coef    std err          t      P>|t|      [0.025      0.975]
------------------------------------------------------------------------------
enso_anom      0.0015      0.018      0.080      0.936      -0.034       0.037
==============================================================================
Omnibus:                        1.416   Durbin-Watson:                   1.619
Prob(Omnibus):                  0.493   Jarque-Bera (JB):                1.162
Skew:                           0.011   Prob(JB):                        0.559
Kurtosis:                       3.332   Cond. No.                         1.00
==============================================================================

Notes:
[1] R² is computed without centering (uncentered) since the model does not contain a constant.
[2] Standard Errors assume that the covariance matrix of the errors is correctly specified.

# Simple linear model: buoy wave anomaly vs buoy sst anomaly
model = sm.OLS(anom_df.buoy_wave_anom, anom_df.buoy_sst_anom)

# Model results
results = model.fit()

# Model summary
print(results.summary())

                                 OLS Regression Results                                
=======================================================================================
Dep. Variable:         buoy_wave_anom   R-squared (uncentered):                   0.035
Model:                            OLS   Adj. R-squared (uncentered):              0.031
Method:                 Least Squares   F-statistic:                              9.167
Date:                Tue, 07 Dec 2021   Prob (F-statistic):                     0.00272
Time:                        18:09:44   Log-Likelihood:                         -6.6118
No. Observations:                 252   AIC:                                      15.22
Df Residuals:                     251   BIC:                                      18.75
Df Model:                           1                                                  
Covariance Type:            nonrobust                                                  
=================================================================================
                    coef    std err          t      P>|t|      [0.025      0.975]
---------------------------------------------------------------------------------
buoy_sst_anom    -0.0480      0.016     -3.028      0.003      -0.079      -0.017
==============================================================================
Omnibus:                        2.296   Durbin-Watson:                   1.645
Prob(Omnibus):                  0.317   Jarque-Bera (JB):                2.133
Skew:                           0.093   Prob(JB):                        0.344
Kurtosis:                       3.410   Cond. No.                         1.00
==============================================================================

Notes:
[1] R² is computed without centering (uncentered) since the model does not contain a constant.
[2] Standard Errors assume that the covariance matrix of the errors is correctly specified.

m, b = np.polyfit(anom_df.enso_anom, anom_df.buoy_sst_anom, 1)
plt.figure(figsize = (10, 5))
plt.scatter(anom_df.enso_anom, anom_df.buoy_sst_anom)
plt.plot(anom_df.enso_anom, m * anom_df.enso_anom + b, color = 'red')
plt.title('Buoy SST Anomaly ~ ENSO SST Anomaly')
plt.ylabel('Buoy SST Anomaly')
plt.xlabel('ENSO SST Anomaly')

Text(0.5, 0, 'ENSO SST Anomaly')

m, b = np.polyfit(anom_df.enso_anom, anom_df.buoy_wave_anom, 1)
plt.figure(figsize = (10, 5))
plt.scatter(anom_df.enso_anom, anom_df.buoy_wave_anom)
plt.plot(anom_df.enso_anom, m * anom_df.enso_anom + b, color = 'red')
plt.title('Buoy Wave Anomaly ~ ENSO SST Anomaly')
plt.ylabel('Buoy Wave Anomaly')
plt.xlabel('ENSO SST Anomaly')

Text(0.5, 0, 'ENSO SST Anomaly')

m, b = np.polyfit(anom_df.buoy_sst_anom, anom_df.buoy_wave_anom, 1)
plt.figure(figsize = (10, 5))
plt.scatter(anom_df.buoy_sst_anom, anom_df.buoy_wave_anom)
plt.plot(anom_df.buoy_sst_anom, m * anom_df.buoy_sst_anom + b, color = 'red')
plt.title('Buoy Wave Anomaly ~ Buoy SST Anomaly')
plt.ylabel('Buoy Wave Anomaly')
plt.xlabel('Buoy SST Anomaly')

Text(0.5, 0, 'Buoy SST Anomaly')

EDS 213 Group Project

Our group discovered the Scott Reef and Rowley Shoals Coral Bleaching Data dataset while searching the DataOne repository for “coral bleaching.” This particular dataset focuses on long-term monitoring data from 1994 to 2017 at reef slope habitats off the coast of northwestern Australia. Data Source: https://search.dataone.org/view/https%3A%2F%2Fpasta.lternet.edu%2Fpackage%2Fmetadata%2Feml%2Fedi%2F952%2F1. The metadata includes the reef system, date range, taxonomy, habitat type, coral coverage, and dataset methods.

# assign data url to access coral data from DataOne then download
data_url <- "https://cn.dataone.org/cn/v2/resolve/https%3A%2F%2Fpasta.lternet.edu%2Fpackage%2Fdata%2Feml%2Fedi%2F952%2F1%2Ff6212784c45d0a077f2c863868d22c4b"
# If data is akready up to date, this will throw an error
# error=T in header will move past this issue
download_d1_data(data_url, dir_name = "data", path = ".")

[1] "./data"

# assign data path
data_path <- "data"
# Read in data with metajam
coral_list <- read_d1_files(data_path)
# Pick out the data read in above and clean it up
corals <- coral_list$data %>% 
  janitor::clean_names() %>% 
  dplyr::mutate(year_decimal = format(date_decimal(year_decimal), "%Y-%m-%d"),
                month = month(year_decimal),
                year = year(year_decimal)) %>% 
  dplyr::rename(date = year_decimal)
# Read in  ONI to be joined to coral data
oni <- read.table(
  "https://origin.cpc.ncep.noaa.gov/products/analysis_monitoring/ensostuff/detrend.nino34.ascii.txt",
  header = T) %>%
  dplyr::mutate(date = as.Date(ISOdate(YR, MON, 1)),
                date_start = as.Date(ISOdate(YR, MON, 1)),
                date_end = lubridate::ceiling_date(date_start, "month")) %>%
  dplyr::rename(oni_anomaly = ANOM,
                month = MON,
                year = YR) %>% 
  dplyr::select(year, month, oni_anomaly, date_start, date_end) %>% 
  dplyr::mutate(roll_3_month_mean = zoo::rollmean(x = oni_anomaly, k = 3, fill = NA, align = "right")) %>% 
  dplyr::filter(date_start > lubridate::ymd("1994-09-01"))
# Calculate the Simpson's diversity index 
# join corals and ONI data
coral_oni <- corals %>% 
  tidyr::pivot_longer(cols = 5:18, names_to = "species", values_to = "cover") %>% 
  dplyr::group_by(system, reef, year, month, location) %>% 
  dplyr::summarise(simpson_index = vegan::diversity(cover, index = "simpson")) %>% 
  dplyr::left_join(oni %>% dplyr::select(-date_start, -date_end)) %>% 
  dplyr::mutate(date = lubridate::make_date(year = year, month = month, day = 1))

# Plot the coral diversity data with ONI color bar
ggplot2::ggplot() +
  ggplot2::geom_rect(
    data = oni,
    aes(xmin = date_start, xmax = date_end, ymin = -Inf, ymax = .3, fill = oni_anomaly)) +
  ggplot2::scale_fill_viridis_c(
    option = "plasma",
    guide = guide_colorbar(direction = "horizontal", title.position = "top",
                           order = 2, barheight = unit(.2, "cm"))) +
  ggplot2::scale_x_date(date_breaks = "2 year", date_labels = "%Y", expand = expansion(mult = c(0,0))) +
  ggplot2::geom_line(data = coral_oni, size = 1,
                     aes(x = date, y = simpson_index, color = location)) +
  ggplot2::scale_color_viridis_d() +
  ggplot2::guides(color = guide_legend(order = 1)) +
  ggplot2::labs(fill = "Oceanic Ni\u00f1o Index", color = "Sites", 
                x = "Date", y = "Simpsons Diversity Index") +
  ggplot2::theme_minimal()

1. Choose A Study Region

For this project I am choosing Arcata California. This is where I attended college, and I chose to go there for it’s rural location and its proximity to a variety of outdoor recreation areas. Arcata is a situated along the northern coast of California. The coastal zone surrounding the town includes beautiful coast redwoods (Sequoia sempervirens), Humboldt Bay, and low-lying areas around Humboldt Bay. Going east from the coastal zone, you quickly gain elevation and enter the southern Cascade mountain range and the Trinity Alps. This region contains the volcanoes Mt. Shasta and Mt Lassen, formed by the Cascadia subduction zone. Arcata’s climate falls into the temperate rainforest category, and is dominated by a rainy season and a dry season. Arcata’s population is also somewhat seasonal thanks to the college population leaving for the summer months.

2. Locate A Precipitation Dataset

Take a look through the Google Earth Engine data catalog.

I chose the the ERA5 Daily Aggregates dataset because my other choice Global Precipitation Measurement (GPM) v6 kept exceeding my user memory limit. I also investigated many other datasets (test_1 to test_5 files) but I did not really like how a few of them looked in comparison. I think the ERA5 Daily Aggregates suited my needs quite well and showed the scope of the storm event I was looking at quite well. It feels a bit like cheating, but I really did try to use other datasets. This dataset also gives reasonable spatial resolution.

# Import packages
import ee
import geemap
import pandas as pd
import matplotlib.pyplot as plt
import numpy as np
from IPython.display import Image
ee.Initialize()

gdat = ee.ImageCollection('ECMWF/ERA5/DAILY')
gdat_prop = gdat.propertyNames().getInfo()
pr = gdat.select('total_precipitation')
prdflt = pr.filter(ee.Filter.date('2019-02-24', '2019-02-28')).sum();
prdflt.getInfo()

{'type': 'Image',
 'bands': [{'id': 'total_precipitation',
   'data_type': {'type': 'PixelType', 'precision': 'double'},
   'crs': 'EPSG:4326',
   'crs_transform': [1, 0, 0, 0, 1, 0]}]}

3. Plot a Time Series of Precipitation

Let’s do a new type of analysis on the data: the creation of a time series.

ar_lon = -124
ar_lat = 40.8
ar_poi = ee.Geometry.Point(ar_lon, ar_lat)
scale = 1000   # scale in m
ar_pr_ts = pr.getRegion(ar_poi, scale).getInfo()
df = pd.DataFrame(ar_pr_ts)
print(df)

              0          1          2              3                    4
0            id  longitude   latitude           time  total_precipitation
1      19790102 -123.99895  40.796989   284083200000                    0
2      19790103 -123.99895  40.796989   284169600000                    0
3      19790104 -123.99895  40.796989   284256000000             0.002583
4      19790105 -123.99895  40.796989   284342400000                    0
...         ...        ...        ...            ...                  ...
15161  20200705 -123.99895  40.796989  1593907200000             0.000057
15162  20200706 -123.99895  40.796989  1593993600000             0.000298
15163  20200707 -123.99895  40.796989  1594080000000             0.000005
15164  20200708 -123.99895  40.796989  1594166400000              0.00015
15165  20200709 -123.99895  40.796989  1594252800000             0.000015

[15166 rows x 5 columns]

headers = df.loc[0]     # Assign the first entry in the data frame to a variable called "headers"
print(headers) 

0                     id
1              longitude
2               latitude
3                   time
4    total_precipitation
Name: 0, dtype: object

df = pd.DataFrame(df.values[1:], columns=headers)      
# Make a new data frame out of the old one, but assigning the names we just retrieved as actual column headers
print(df)  

0            id  longitude   latitude           time total_precipitation
0      19790102 -123.99895  40.796989   284083200000                   0
1      19790103 -123.99895  40.796989   284169600000                   0
2      19790104 -123.99895  40.796989   284256000000            0.002583
3      19790105 -123.99895  40.796989   284342400000                   0
4      19790106 -123.99895  40.796989   284428800000                   0
...         ...        ...        ...            ...                 ...
15160  20200705 -123.99895  40.796989  1593907200000            0.000057
15161  20200706 -123.99895  40.796989  1593993600000            0.000298
15162  20200707 -123.99895  40.796989  1594080000000            0.000005
15163  20200708 -123.99895  40.796989  1594166400000             0.00015
15164  20200709 -123.99895  40.796989  1594252800000            0.000015

[15165 rows x 5 columns]

df['datetime'] = pd.to_datetime(df['time'], unit = 'ms')
df

15165 rows × 6 columns

plt.figure(figsize = (10, 6), dpi = 300)    # create a new figure, set size and resolution (dpi)
plt.plot(df['datetime'],df['total_precipitation'])   # add data to the plot
plt.title('Arcata Rainfall', fontsize=16)
plt.xlabel('Date', fontsize=14)
plt.ylabel('Precip (m)', fontsize=14)
plt.ylim(0, 0.12)

(0.0, 0.12)

4. Make Some Maps of Interesting Times

I chose to take the sum of the time period I examined in order to look at how much precipitation there was over the Mad River watershed. The sum of the values also lets you see the total amount of precipitation over the entire time period of the storm event. My map shows heavy precipitation over the Pacific, making landfall in northern California and Oregon, while staying to the north and largely avoiding Nevada.

# Base map
Map = geemap.Map(center=[40.8,-124], zoom=6)
# Min and Max
VIS_PREC = {
    'min':0,
    'max':.02,
    'palette': ['#FFFFFF', '#00FFFF', '#0080FF', '#DA00FF', '#FFA400', '#FF0000']
}
# Add layer
Map.addLayer(prdflt, VIS_PREC,'total precipitation',opacity=0.3)
# Plot map
Map

Map(center=[40.8, -124], controls=(WidgetControl(options=['position', 'transparent_bg'], widget=HBox(children=…

pt = ee.Geometry.Point([-124.3652, 40.2922])
roi = pt.buffer(1600000)
# Create a URL to the styled image for a region around Mendocino County CA.
url = prdflt.getThumbUrl({
    'min': 0, 'max': .02, 'dimensions': 512, 'region': roi, 'opacity': 0.3,
    'palette': ['#FFFFFF', '#00FFFF', '#0080FF', '#DA00FF', '#FFA400', '#FF0000']})
Image(url=url, embed=True, format = 'png')

5. Plot Landsat NDVI for the Region

The precipitation analysis discussed above provides useful context for identifying interesting weather events for a particular region. Now let’s see what (if any!) effect changes in weather patterns have had on the landscape, using Landsat imagery.

I was able to see a slight difference in the two images. It is unclear to me if the long term average includes more cloud cover and is therefore less bright/vivid, or if the rain increased the vegetation. If I had to guess I would say that there was not a very noticeable change because I chose an area that is already very wet and productive.

land_8 = ee.ImageCollection('LANDSAT/LC08/C01/T1_TOA')
pt = ee.Geometry.Point([-124, 40.8])   # Point corresponding to Arcata, CA
land_8_pt = land_8.filterBounds(pt)
land_8_least_cld = land_8_pt.filter('CLOUD_COVER < 20').mean();
red = land_8_least_cld.select('B4')
nir = land_8_least_cld.select('B5')
ndvi=(nir.subtract(red)).divide((nir.add(red))).rename('NDVI')
ndvi

<ee.image.Image at 0x22d22b1b280>

ndviParams = {'min': -1, 
              'max': 1, 
              'palette': ['blue', 'white', 'green']
             }

#  Interactive only, no saved output
Map_NDVI = geemap.Map(center=[40.8, -124], zoom=8)
Map_NDVI.addLayer(ndvi, ndviParams,'NDVI')
Map_NDVI

Map(center=[40.8, -124], controls=(WidgetControl(options=['position', 'transparent_bg'], widget=HBox(children=…

pt = ee.Geometry.Point([-124.3652, 40.2922])
roi = pt.buffer(120000)
# Create a URL to the styled image for a region around Mendocino County CA.
url = ndvi.getThumbUrl({
    'min': -1, 'max': 1, 'dimensions': 512, 'region': roi,
    'palette': ['blue', 'white', 'green']})
Image(url=url, embed=True, format = 'png')

land_8_least_cld_flt = land_8_pt.filter('CLOUD_COVER < 20')
land_8_least_cld_flt_dt = land_8_least_cld_flt.filter(ee.Filter.date('2019-01-01', '2019-04-28')).mean();
red_2 = land_8_least_cld_flt_dt.select('B4')
nir_2 = land_8_least_cld_flt_dt.select('B5')
ndvi_2 = (nir_2.subtract(red_2)).divide((nir_2.add(red_2))).rename('NDVI')
ndvi_2

<ee.image.Image at 0x22d220f6820>

#  Interactive only, no saved output
Map_NDVI_flt = geemap.Map(center=[40.8, -124], zoom=8)
Map_NDVI_flt.addLayer(ndvi_2, ndviParams,'NDVI')
Map_NDVI_flt

Map(center=[40.8, -124], controls=(WidgetControl(options=['position', 'transparent_bg'], widget=HBox(children=…

pt = ee.Geometry.Point([-124.3652, 40.2922])
roi = pt.buffer(120000)
# Create a URL to the styled image for a region around Mendocino County CA.
url = ndvi_2.getThumbUrl({
    'min': -1, 'max': 1, 'dimensions': 512, 'region': roi,
    'palette': ['blue', 'white', 'green']})
Image(url=url, embed=True, format = 'png')

Load Data

Dominica Shape File

dominica_shp = gpd.read_file(shoreline_shapefile)
dominica_shp.head()

Set CRS to EPSG 2002

dominica_shp = dominica_shp.to_crs(projected_EPSG)
dominica_shp.crs

<Projected CRS: EPSG:2002>
Name: Dominica 1945 / British West Indies Grid
Axis Info [cartesian]:
- E[east]: Easting (metre)
- N[north]: Northing (metre)
Area of Use:
- name: Dominica - onshore.
- bounds: (-61.55, 15.14, -61.2, 15.69)
Coordinate Operation:
- name: British West Indies Grid
- method: Transverse Mercator
Datum: Dominica 1945
- Ellipsoid: Clarke 1880 (RGS)
- Prime Meridian: Greenwich

Plot Dominica

fig, ax = plt.subplots(figsize=(5, 5))
ax.grid(True, color = 'dimgray')
ax.set(ylim=(1.67e6,1.74e6), xlim=(445000, 490000))
ax.ticklabel_format(scilimits =  [-5, 5])
dominica_shp.plot(ax = ax, edgecolor = "k", facecolor="None")
ctx.add_basemap(ax, crs=projected_EPSG)

Load Data

Whale Sightings

whales = gpd.read_file(whales_CSV)
whales

4893 rows × 5 columns

Create GeoDataFrame

points = gpd.points_from_xy(whales['Long'], whales['Lat'], crs = geodetic_EPSG)
whales_gdf = gpd.GeoDataFrame(whales, geometry = points)
whales_gdf = whales_gdf.to_crs(projected_EPSG)

Plot Whale Sightings

fig, ax = plt.subplots(figsize = (10, 10))
ax.set_aspect('equal')
ax.grid(True, color = 'dimgray')
ax.set(xlim=(4e5, 5e5), ylim=(1.5e6, 1.8e6))
dominica_shp.plot(ax = ax, color='None', edgecolor = "k")
whales_gdf.plot(ax = ax, markersize = .1, color = "purple", alpha = .25)
ax.set_title('Whale Sightings', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs = projected_EPSG)

Create Grid

xmin, ymin, xmax, ymax = whales_gdf.total_bounds
cell_size = 2000
xs = list(np.arange(xmin, xmax + cell_size, cell_size))
ys = list(np.arange(ymin, ymax + cell_size, cell_size))
def make_cell(x, y, cell_size):
    ring = [
        (x, y),
        (x + cell_size, y),
        (x + cell_size, y + cell_size),
        (x, y + cell_size)
    ]
    cell = shapely.geometry.Polygon(ring)
    return cell
cells = []
for x in xs:
    for y in ys:
        cell = make_cell(x, y, cell_size)
        cells.append(cell)
grid = gpd.GeoDataFrame({'geometry': cells}, crs = geodetic_EPSG)
grid = grid.set_geometry(crs = projected_EPSG, col = grid['geometry'])

Plot Grid

grid.plot(facecolor = "none", figsize = (10, 10), linewidth = 1)

<AxesSubplot:>

Extract Whale Habitat

whale_grid = grid.sjoin(whales_gdf, how="inner")

Plot whale sighting grid cells

whale_grid.plot(facecolor = "none", figsize = (10, 10), linewidth = .75)

<AxesSubplot:>

grid['count'] = whale_grid.groupby(whale_grid.index).count()['index_right']
grid = grid[grid['count'] > 20]

grid.plot(facecolor = "none", figsize = (10, 10), linewidth = .75)

<AxesSubplot:>

grid_union = grid.unary_union
grid_union

Create Vessel Speed Reduction Zone

The vessel speed reduction zone is determined by the whale habitat areas in which more than 20 whales were observed per 2,000 m².

grid_convex = grid_union.convex_hull
grid_convex

Make GeoDataFrame

whale_habitat = gpd.GeoDataFrame(index = [0], geometry = [grid_convex], crs = projected_EPSG)

Plot

fig, ax = plt.subplots(figsize = (10, 10))
ax.grid(True, color = 'dimgray')
ax.set(xlim=(4.4e5, 4.85e5), ylim=(1.675e6, 1.73e6))
dominica_shp.plot(ax = ax, color='None', edgecolor = "k")
whale_habitat.plot(ax = ax, edgecolor = "purple", facecolor = 'none')
ax.set_title('Whale Habitat', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs = projected_EPSG)

whale_habitat_diff = whale_habitat.difference(dominica_shp)
whale_habitat = gpd.GeoDataFrame(geometry = whale_habitat_diff)
whale_habitat

fig, ax = plt.subplots(figsize = (10, 10))
ax.grid(True, color = 'dimgray')
ax.set(xlim=(4.4e5, 4.85e5), ylim=(1.675e6, 1.73e6))
dominica_shp.plot(ax = ax, color='None', edgecolor = "k")
whale_habitat.plot(ax = ax, edgecolor = "purple", facecolor = 'none')
ax.set_title('Whale Habitat', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs = projected_EPSG)

whale_habitat

Load AIS Vessel Data

vessels = gpd.read_file(vessels_CSV)
points = gpd.points_from_xy(vessels['LON'], vessels['LAT'], crs = geodetic_EPSG)
vessels_gdf = gpd.GeoDataFrame(vessels, geometry = points)
vessels_gdf = vessels_gdf.to_crs(projected_EPSG)
vessels_gdf['TIMESTAMP'] = pd.to_datetime(vessels_gdf['TIMESTAMP'])
vessels_gdf

617262 rows × 6 columns

vessels_whale = vessels_gdf.sjoin(whale_habitat, how = 'inner')
vessels_whale

fig, ax = plt.subplots(figsize = (10, 10))
ax.grid(True, color = 'dimgray')
ax.set(xlim=(4.4e5, 4.85e5), ylim=(1.675e6, 1.73e6))
dominica_shp.plot(ax = ax, color='None', edgecolor = "k")
vessels_whale.plot(ax = ax, markersize = .1, color = "purple", alpha = .1)
ax.set_title('Vessel Data Inside Whale Habitat', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs = projected_EPSG)

Calculate Vessel Speeds

vessels_whale_sorted = vessels_whale.sort_values(['MMSI', 'TIMESTAMP'])
vessels_whale_shifted = vessels_whale_sorted.shift(periods = 1)
vw_sorted_shifted = vessels_whale_sorted.join(vessels_whale_shifted, lsuffix = "_original", rsuffix = "_copy")
vw_matched = vw_sorted_shifted[vw_sorted_shifted['MMSI_original'] == vw_sorted_shifted['MMSI_copy']]
vw_matched = vw_matched.set_geometry(col = vw_matched['geometry_original'], crs = projected_EPSG)
vw_matched['distance_m'] = vw_matched['geometry_original'].distance(vw_matched['geometry_copy']) 
vw_matched['time_s'] = vw_matched['TIMESTAMP_original'] - vw_matched['TIMESTAMP_copy']
vw_matched['time_s'] = vw_matched['time_s'].dt.total_seconds() 
vw_matched['speed_ms'] = vw_matched['distance_m'] / vw_matched['time_s']
vw_matched['10_kn_time'] = vw_matched['distance_m'] / ten_kn_in_ms
vw_matched['time_diff'] = vw_matched['10_kn_time'].sub(vw_matched['time_s'])
vw_matched = vw_matched[vw_matched['time_diff'] > 0]

fig, ax = plt.subplots(figsize = (10, 10))
ax.grid(True, color = 'dimgray')
ax.set(xlim=(4.4e5, 4.85e5), ylim=(1.675e6, 1.73e6))
dominica_shp.plot(ax = ax, color='None', edgecolor = "k")
vw_matched.plot(ax = ax, markersize = .1, color = "purple", alpha = .25)
ax.set_title('Vessel Data Inside Whale Habitat', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs = projected_EPSG)

Impact of a 10 knot Speed Reduction Zone

We calculated that ship vessel traffic would be slowed by 2 minutes per mile on average. Over the course of the year, this equated to approximately 28 days of increased shipping time.

num_days = vw_matched['time_diff'].sum() / 60 / 60 /24

num_days

27.9423247732646

mean_time_lost = vw_matched['time_diff'].mean() / 60

mean_time_lost

1.8906563139508044

Function to load the DNB dataset from VNP46A1 granules

read_dnb <- function(file_name) {
  # Reads the "DNB_At_Sensor_Radiance_500m" dataset from a VNP46A1 granule into a STARS object.
  # Then read the sinolsoidal tile x/y positions and adjust the STARS dimensions (extent+delta)

  # The name of the dataset holding the nightlight band in the granule
  dataset_name <- "//HDFEOS/GRIDS/VNP_Grid_DNB/Data_Fields/DNB_At_Sensor_Radiance_500m"

  # From the metadata, we pull out a string containing the horizontal and vertical tile index
  h_string <- gdal_metadata(file_name)[199]
  v_string <- gdal_metadata(file_name)[219]
  
  # We parse the h/v string to pull out the integer number of h and v
  tile_h <- as.integer(str_split(h_string, "=", simplify = TRUE)[[2]])
  tile_v <- as.integer(str_split(v_string, "=", simplify = TRUE)[[2]])

  # From the h/v tile grid position, we get the offset and the extent
  west <- (10 * tile_h) - 180
  north <- 90 - (10 * tile_v)
  east <- west + 10
  south <- north - 10

  # A tile is 10 degrees and has 2400x2400 grid cells
  delta <- 10 / 2400

  # Reading the dataset
  dnb <- read_stars(file_name, sub = dataset_name)

  # Setting the CRS and applying offsets and deltas
  st_crs(dnb) <- st_crs(4326)
  st_dimensions(dnb)$x$delta <- delta
  st_dimensions(dnb)$x$offset <- west
  st_dimensions(dnb)$y$delta <- -delta
  st_dimensions(dnb)$y$offset <- north
  
  return(dnb)
}

Read in day night band (DNB) data

Feb_07_v5 <- read_dnb(file_name = "data/VNP46A1.A2021038.h08v05.001.2021039064328.h5")

//HDFEOS/GRIDS/VNP_Grid_DNB/Data_Fields/DNB_At_Sensor_Radiance_500m, 

Feb_07_v6 <- read_dnb(file_name = "data/VNP46A1.A2021038.h08v06.001.2021039064329.h5")

//HDFEOS/GRIDS/VNP_Grid_DNB/Data_Fields/DNB_At_Sensor_Radiance_500m, 

Feb_16_v5 <- read_dnb(file_name = "data/VNP46A1.A2021047.h08v05.001.2021048091106.h5")

//HDFEOS/GRIDS/VNP_Grid_DNB/Data_Fields/DNB_At_Sensor_Radiance_500m, 

Feb_16_v6 <- read_dnb(file_name = "data/VNP46A1.A2021047.h08v06.001.2021048091105.h5")

//HDFEOS/GRIDS/VNP_Grid_DNB/Data_Fields/DNB_At_Sensor_Radiance_500m, 

Combine adjacent tiles for each date

Feb_07_v5_v6 <- st_mosaic(Feb_07_v5, Feb_07_v6)
Feb_16_v5_v6 <- st_mosaic(Feb_16_v5, Feb_16_v6)

Create blackout Mask

## Take the difference of light data from before the storm and after the storm to make a mask of values with a difference greater than 200 nW cm-2 sr-1
diff <- (Feb_07_v5_v6 - Feb_16_v5_v6) > 200

## Convert values with a difference of less than 200 to NA
diff[diff == F] <- NA

Vectorize blackout mask

blackout_mask <- st_as_sf(diff)

## Fix invalid geometries 
blackout_mask_fixed <- st_make_valid(blackout_mask)

rm(diff, blackout_mask)
gc()

           used  (Mb) gc trigger   (Mb)  max used   (Mb)
Ncells  3047944 162.8    4503170  240.5   4503170  240.5
Vcells 27482570 209.7  132454492 1010.6 156217946 1191.9

Crop the vectorized blackout mask to the region of interest

## Set region of interest
houston <- st_polygon(
  list(
    rbind(
      c(-96.5, 29), 
      c(-96.5, 30.5), 
      c(-94.5, 30.5), 
      c(-94.5, 29), 
      c(-96.5, 29)
    )
  )
) %>% 
  st_sfc(crs = 4326)

## Crop night lights data
intersects <- st_intersects(blackout_mask_fixed, houston, sparse = FALSE)
blackout_cropped <- blackout_mask_fixed[intersects,]

## Transform cropped blackout mask back to EPSG:3083 (NAD83 / Texas Centric Albers Equal Area)
blackout_cropped_NAD83 <- st_transform(blackout_cropped, 3083)

rm(blackout_cropped)
gc()

           used  (Mb) gc trigger  (Mb)  max used   (Mb)
Ncells  3020703 161.4    4503170 240.5   4503170  240.5
Vcells 27554636 210.3  105963594 808.5 156217946 1191.9

Sanity check plot

ggplot() +
  geom_sf(data = blackout_cropped_NAD83) +
  theme_classic()

Roads data

query <- 
  "SELECT * 
   FROM gis_osm_roads_free_1 
   WHERE fclass='motorway'"

highways <- 
  st_read(
    "data/gis_osm_roads_free_1.gpkg", 
    query = query) %>% 
  st_transform(crs = 3083) %>% 
  st_buffer(dist = 200) %>% 
  st_union()

Reading query `SELECT * 
   FROM gis_osm_roads_free_1 
   WHERE fclass='motorway'' from data source `C:\Users\Cullen\OneDrive\Documents\MEDS\cullen-molitor.github.io\_posts\2021-12-03-houston-blackout-analysis-2021\data\gis_osm_roads_free_1.gpkg' 
  using driver `GPKG'
Simple feature collection with 6085 features and 10 fields
Geometry type: LINESTRING
Dimension:     XY
Bounding box:  xmin: -96.50429 ymin: 29.00174 xmax: -94.39619 ymax: 30.50886
Geodetic CRS:  WGS 84

cat("\n\n\nAfter Transforming\n\n")

After Transforming

highways

Geometry set for 1 feature 
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 1837420 ymin: 7218299 xmax: 2040621 ymax: 7387049
Projected CRS: NAD83 / Texas Centric Albers Equal Area

Basic highways plot

ggplot() +
  geom_sf(data = highways) +
  theme_classic()

Buildings data

query <- 
  "SELECT * 
   FROM gis_osm_buildings_a_free_1
   WHERE (type IS NULL AND name IS NULL)
   OR type in ('residential', 'apartments', 'house', 'static_caravan', 'detached')"

buildings <- 
  st_read(
    "data/gis_osm_buildings_a_free_1.gpkg", 
    query = query) %>% 
  st_transform(crs = 3083) 

Reading query `SELECT * 
   FROM gis_osm_buildings_a_free_1
   WHERE (type IS NULL AND name IS NULL)
   OR type in ('residential', 'apartments', 'house', 'static_caravan', 'detached')' from data source `C:\Users\Cullen\OneDrive\Documents\MEDS\cullen-molitor.github.io\_posts\2021-12-03-houston-blackout-analysis-2021\data\gis_osm_buildings_a_free_1.gpkg' 
  using driver `GPKG'
Simple feature collection with 475941 features and 5 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -96.50055 ymin: 29.00344 xmax: -94.53285 ymax: 30.50393
Geodetic CRS:  WGS 84

cat("\n\n\nAfter Transforming\n\n")

After Transforming

buildings

Simple feature collection with 475941 features and 5 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: 1838180 ymin: 7216470 xmax: 2027040 ymax: 7386914
Projected CRS: NAD83 / Texas Centric Albers Equal Area
First 10 features:
     osm_id code   fclass name       type
1  15289727 1500 building <NA>       <NA>
2  15289869 1500 building <NA>       <NA>
3  15299261 1500 building <NA> apartments
4  15331425 1500 building <NA>       <NA>
5  15349970 1500 building <NA>       <NA>
6  20868178 1500 building <NA>       <NA>
7  20871848 1500 building <NA>       <NA>
8  20871948 1500 building <NA>       <NA>
9  20876080 1500 building <NA>       <NA>
10 20877241 1500 building <NA>       <NA>
                             geom
1  MULTIPOLYGON (((1948074 728...
2  MULTIPOLYGON (((1927251 732...
3  MULTIPOLYGON (((1984491 730...
4  MULTIPOLYGON (((1932443 731...
5  MULTIPOLYGON (((1925238 732...
6  MULTIPOLYGON (((1922763 727...
7  MULTIPOLYGON (((1922899 727...
8  MULTIPOLYGON (((1922788 727...
9  MULTIPOLYGON (((1922699 727...
10 MULTIPOLYGON (((1922807 727...

Census data

# st_layers("ACS_2019_5YR_TRACT_48_TEXAS.gdb"))

acs_geoms <- 
  st_read(
    "data/ACS_2019_5YR_TRACT_48_TEXAS.gdb",
    layer = "ACS_2019_5YR_TRACT_48_TEXAS"
  )

Reading layer `ACS_2019_5YR_TRACT_48_TEXAS' from data source 
  `C:\Users\Cullen\OneDrive\Documents\MEDS\cullen-molitor.github.io\_posts\2021-12-03-houston-blackout-analysis-2021\data\ACS_2019_5YR_TRACT_48_TEXAS.gdb' 
  using driver `OpenFileGDB'
Simple feature collection with 5265 features and 15 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -106.6456 ymin: 25.83716 xmax: -93.50804 ymax: 36.5007
Geodetic CRS:  NAD83

acs_income <- 
  st_read(
    "data/ACS_2019_5YR_TRACT_48_TEXAS.gdb",
    layer = "X19_INCOME"
  ) %>% 
  select(GEOID, B19013e1) %>% 
  rename(GEOID_Data = GEOID,
         median_income = B19013e1)

Reading layer `X19_INCOME' from data source 
  `C:\Users\Cullen\OneDrive\Documents\MEDS\cullen-molitor.github.io\_posts\2021-12-03-houston-blackout-analysis-2021\data\ACS_2019_5YR_TRACT_48_TEXAS.gdb' 
  using driver `OpenFileGDB'

acs_geoms_med <- left_join(acs_geoms, acs_income)  %>% 
  st_transform(crs = 3083) 

Merge datasets

blackout_no_hwy <- st_difference(blackout_cropped_NAD83, highways)
rm(highways)
gc()

           used  (Mb) gc trigger   (Mb)  max used   (Mb)
Ncells  7126649 380.7   20004878 1068.4  20004878 1068.4
Vcells 56415877 430.5  105963594  808.5 156217946 1191.9

houston_res_wo_power <- buildings[blackout_no_hwy, op = st_intersects]
number_houses_wo_power <- length(houston_res_wo_power$osm_id)

The number of buildings that were left without power is 157411.

acs_building <- st_join(houston_res_wo_power, acs_geoms_med, join = st_intersects)

acs_polygon <- st_join(blackout_no_hwy, acs_geoms_med, join = st_intersects)

houston_bbox <- st_bbox(houston)
houston_map <- osm.raster(houston_bbox)

Area and Median Incomes of Residences Affected by Houston Blackout in February, 2021

tm_shape(houston_map) +
  tm_rgb(alpha = .75) +
  # tm_shape(acs_geoms_med,
  #          border.alpha = 0) +
  # tm_polygons(col = "median_income") +
  tm_shape(blackout_no_hwy) +
  tm_polygons(border.alpha = 1) +
  tm_shape(acs_polygon) + 
  tm_fill("median_income", 
          n = 5, 
          style = "pretty",
          title = "Median Income ($)") +
  tm_compass()+
  tm_scale_bar()

This map was created by Amber McEldowney and Cullen Molitor 2021-10-24.
Sources: Socioeconomic data: U.S. Census Bureau’s American Community Survey for Texas census tracts in 2019
Light data: NASA’s Level-1 and Atmosphere Archive & Distribution System Distributed Active Archive Center (LAADS DAAC)
Spatial & Buildings Data: OpenStreetMap

rm(blackout_cropped_NAD83, acs_geoms, acs_income, buildings)
gc()

           used  (Mb) gc trigger   (Mb)  max used   (Mb)
Ncells  4929805 263.3   16003903  854.8  20004878 1068.4
Vcells 46664452 356.1  152763574 1165.5 156217946 1191.9

Histogram of Median Income for Houses Affected by Blackout

Median_Income <- acs_polygon$median_income
hist(Median_Income,
main="Median Income in Regions Affected by Blackout",
xlab="Median Income ($)",
ylab="Number of Households",
col="grey",
freq=FALSE
)

Histogram of Median Income in Houston

houston_nad <- houston %>%
  st_as_sf() %>%
  st_transform(houston, crs = 3083)

# acs_geoms_med_bb <- st_join(acs_geoms_med, houston_nad, join = st_intersects)

intersects <- st_intersects(acs_geoms_med, houston_nad, sparse = FALSE)
acs_geoms_med_bb <- acs_geoms_med[intersects,]

Median_Income_Houston <- acs_geoms_med_bb$median_income
hist(Median_Income_Houston,
main="Median Income in Houston",
xlab="Median Income ($)",
ylab="Number of Households",
col="grey",
freq=FALSE
)

We thought it would be interesting to compare the median incomes of households affected by the blackout, to median incomes in Houston in general, but because the blackouts seem to have occured in a more metropolitan area, it is likely the incomes are skewed higher for that area, and it does not give a clear indication of whether median income had an effect on whether or not a household experienced a blackout.

Database Connection

pg_uri_template = 'postgresql+psycopg2://{user}:{pwd}@{host}/{db_name}'
db_uri = pg_uri_template.format(
    drivername='postgresql+psycopg2',
    host = '{ip address}',
    user = '{username}',
    pwd = '{pwd}',
    db_name = 'osmiowa'
)
engine = sa.create_engine(db_uri)

Data Details

Database Name: - osmiowa

Database Tables: - planet_osm_line - planet_osm_point - planet_osm_polygon - planet_osm_roads - spatial_ref_sys - wind - wind_cells

Geometry: - Projected in EPSG:26975 - Geodetic CRS: NAD83 - Units: meters - Coordinate system: Cartesian 2D CS - Axes: easting, northing (X,Y) - Orientations: east, north

Query Database

Residential Scenario 1 (3H)

sql_buildings_residential_1 = \
"""
SELECT 
    ST_BUFFER(way, 450) as way
FROM 
    planet_osm_polygon 
WHERE 
    building IN ('yes', 'residential', 'apartments', 'house', 'static_caravan', 'detached')
OR 
    landuse = 'residential'
OR 
    place = 'town'
"""

Residential Scenario 2 (10H)

sql_buildings_residential_2 = \
"""
SELECT 
    ST_BUFFER(way, 1500) as way 
FROM 
    planet_osm_polygon 
WHERE 
    building 
IN 
    ('yes', 'residential', 'apartments', 'house', 'static_caravan', 'detached')
OR 
    landuse = 'residential'
OR
    place = 'town'
"""

Non-residential (3H)

sql_buildings_nonresidential = \
"""
SELECT 
    ST_BUFFER(way, 450) as way
FROM 
    planet_osm_polygon 
WHERE 
    building 
NOT IN 
    ('yes', 'residential', 'apartments', 'house', 'static_caravan', 'detached')
"""

Airports

sql_airports = \
"""
SELECT 
    ST_BUFFER(way, 7500) as way
FROM 
    planet_osm_polygon 
WHERE 
    aeroway IS NOT NULL
"""

Military Bases

sql_military = \
"""
SELECT 
    ST_BUFFER(way, 0) as way 
FROM 
    planet_osm_polygon 
WHERE 
    military IS NOT NULL
OR 
    landuse = 'military'
"""

Railways and Roads

sql_railways_n_roads = \
"""
SELECT 
    ST_BUFFER(way, 300) as way
FROM 
    planet_osm_line 
WHERE 
    (railway IS NOT NULL
     AND railway 
     NOT IN ('abandoned', 'disused', 'razed', 'dismantled'))
OR 
    (highway IS NOT NULL
AND 
    highway 
IN 
    ('motorway', 'motorway_link', 'trunk', 'trunk_link', 'road',
    'primary', 'primary_link', 'secondary', 'secondary_link'))
"""

Nature Reserves, Parks, and Wetlands

sql_nature = \
"""
SELECT 
    way 
FROM 
    planet_osm_polygon 
WHERE 
    leisure 
IN 
    ('nature_reserve', 'park')
OR
    "natural" 
IN 
    ('wetland')
"""

Rivers

sql_rivers = \
"""
SELECT 
    ST_BUFFER(way, 150) as way 
FROM 
    planet_osm_line 
WHERE 
    waterway 
IN 
    ('river')
"""

Lakes

sql_lakes = \
"""
SELECT
    way
FROM 
    planet_osm_polygon
WHERE 
    water 
IN 
    ('lake', 'reservoir', 'pond')
"""

Power Lines

sql_powerlines = \
"""
SELECT 
    ST_BUFFER(way, 300) as way
FROM 
    planet_osm_line 
WHERE 
    power IS NOT NULL
"""

Power Plants

sql_powerplants = \
"""
SELECT 
    ST_BUFFER(way, 150) as way
FROM 
    planet_osm_polygon 
WHERE 
    power IS NOT NULL
"""

Wind Turbines

sql_turbines = \
"""
SELECT
    ST_BUFFER(way, 680) as way
FROM 
    planet_osm_point 
WHERE 
    "generator:source" IS NOT NULL
AND 
    "generator:source" IN ('wind')
"""

sql_siting_constraints = \
f"""
{sql_buildings_residential_1} 
UNION
{sql_buildings_nonresidential} 
UNION
{sql_airports} 
UNION
{sql_military} 
UNION
{sql_railways_n_roads} 
UNION
{sql_nature} 
UNION
{sql_rivers} 
UNION
{sql_lakes} 
UNION
{sql_powerlines}
UNION
{sql_powerplants}
UNION
{sql_turbines}
"""
siting_constraints = gpd.read_postgis(sql_siting_constraints, con = engine, geom_col = 'way')

sql_siting_constraints_2 = \
f"""
{sql_buildings_residential_2} 
UNION
{sql_buildings_nonresidential} 
UNION
{sql_airports} 
UNION
{sql_military} 
UNION
{sql_railways_n_roads} 
UNION
{sql_nature} 
UNION
{sql_rivers} 
UNION
{sql_lakes} 
UNION
{sql_powerlines}
UNION
{sql_powerplants}
UNION
{sql_turbines}
"""
siting_constraints_2 = gpd.read_postgis(sql_siting_constraints_2, con = engine, geom_col = 'way')

fig, ax = plt.subplots(figsize=(8, 8))
siting_constraints.plot(ax = ax, markersize = .1, color = "purple", alpha = .5)
ax.grid(True, color = 'dimgray')
ax.set_title('Siting Constraints (Scenario 1)', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs="EPSG:26975")

fig, ax = plt.subplots(figsize=(8, 8))
siting_constraints_2.plot(ax = ax, markersize = .1, color = "purple", alpha = .5)
ax.grid(True, color = 'dimgray')
ax.set_title('Siting Constraints (Scenario 2)', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs="EPSG:26975")

sql_wind_speeds = \
"""
SELECT * 
FROM 
    wind_cells_10000 
WHERE 
    wind_speed IS NOT NULL
"""
wind_speeds = gpd.read_postgis(sql_wind_speeds, con = engine, geom_col = 'geom')

Results

suitable_cells = wind_speeds.overlay(siting_constraints, how = 'difference', keep_geom_type = False)

fig, ax = plt.subplots(figsize=(8, 8))
suitable_cells.plot(ax = ax, markersize = .1, color = "purple", alpha = .5)
ax.grid(True, color = 'dimgray')
ax.set_title('Suitable Areas (Scenario 1)', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs="EPSG:26975")

rotor_5x = math.pi * (136 * 5) ** 2
suitable_cells["area"] = suitable_cells['geom'].area
suitable_cells["number_wind_turbines"] = suitable_cells['geom'].area / rotor_5x

total_wind_turbines = suitable_cells["number_wind_turbines"].sum()
print("The total number of turbines in scenario 1 is:", round(total_wind_turbines))

The total number of turbines in scenario 1 is: 57286

suitable_cells['energy_per_turbine'] = 2.6 * suitable_cells['wind_speed'] - 5
suitable_cells['power_per_cell'] = suitable_cells['energy_per_turbine'] * suitable_cells['number_wind_turbines']

total_scenario_1 = suitable_cells['power_per_cell'].sum()
print("The total power produced in scenario 1 is:", round(total_scenario_1), "GWH/year")

The total power produced in scenario 1 is: 1064159 GWH/year

suitable_cells_2 = wind_speeds.overlay(siting_constraints_2, how = 'difference', keep_geom_type = False)

fig, ax = plt.subplots(figsize=(8, 8))
suitable_cells_2.plot(ax = ax, markersize = .1, color = "purple", alpha = .5)
ax.grid(True, color = 'dimgray')
ax.set_title('Suitable Areas (Scenario 2)', fontsize=12)
ax.ticklabel_format(scilimits =  [-5, 5])
ctx.add_basemap(ax, crs="EPSG:26975")

rotor_5x = math.pi * (136 * 5) ** 2
suitable_cells_2["area"] = suitable_cells_2['geom'].area
suitable_cells_2["number_wind_turbines"] = suitable_cells_2['geom'].area / rotor_5x

total_wind_turbines_2 = suitable_cells_2["number_wind_turbines"].sum()
print("The total number of turbines in scenario 2 is:", round(total_wind_turbines_2))

The total number of turbines in scenario 2 is: 52055

suitable_cells_2['energy_per_turbine'] = 2.6 * suitable_cells_2['wind_speed'] - 5
suitable_cells_2['power_per_cell'] = suitable_cells_2['energy_per_turbine'] * suitable_cells_2['number_wind_turbines']
wind_speeds