In this lab, we are going to work with vector and raster data, spatially joining point data to vector data

The objectives of this guide are to teach you:

  1. Introduce raster data
  2. Import our dataset with simulated geocoded addresses and mortality data from an ovarian cancer cohort
  3. Import a dataset with greenspace across the Bay Area
  4. Compare projections of datasets and re-project if needed
  5. Make maps
  6. Spatially join the two datasets
  7. Run a quick statistical analysis on the two datasets combined

Enough talk–let’s get coding!


# Load packages

library(terra)
## terra 1.8.29
library(sf)
## Linking to GEOS 3.13.0, GDAL 3.8.5, PROJ 9.5.1; sf_use_s2() is TRUE
library(tmap)
library(MapGAM)
## Loading required package: sp
## Loading required package: gam
## Loading required package: splines
## Loading required package: foreach
## Loaded gam 1.22-5
## Loading required package: survival

Rasters

Raster datasets are simply an array of pixels/cells organized into rows and columns (or a grid) where each cell contains a value representing information, such as temperature, vegetation, land use, air pollution, etc. Raster maps usually represent continuous phenomena such as elevation, temperature, or population density. Discrete features such as soil type or land-cover classes can also be represented in the raster data model. Rasters are aerial photographs, imagery from satellites, Google Street View images, etc. A few things to note.

  • Raster datasets are always rectangular (rows x col) similar to matrices. Irregular boundaries are created by using NAs.
  • Rasters have to contain values of the same type (int, float, boolean) throughout the raster, just like matrices and unlike data frames.
  • The size of the raster depends on the resolution and the extent of the raster. As such many rasters are large and often cannot be held in memory completely.

The workhorse package for working with rasters in R is the terra package by Robert Hijmans. terra has functions for creating, reading, manipulating, and writing raster data. The package also implements raster algebra and many other functions for raster data manipulation. The package works with SpatRaster objects. The rast() function is used to create these objects.

Typically you will bring in a raster dataset directly from a file. These files come in many different forms, typically .tif, .img, and .grd.


We’ll bring in the file NDVI_rast.tif. The file contains normalized difference vegetation index (NDVI) data for the Bay Area. These data are taken from Landsat satellite data that I downloaded from Google Earth Engine. We use the function rast() to bring in data in raster form, then take a look at the dataset.

url <- "https://github.com/pjames-ucdavis/SPH215/raw/main/NDVI_rast2.tif"
download.file(url, destfile = "NDVI_rast2.tif", mode = "wb")
NDVI_raster = rast("NDVI_rast2.tif")

## Get summary of raster data
NDVI_raster
## class       : SpatRaster 
## dimensions  : 1856, 1485, 1  (nrow, ncol, nlyr)
## resolution  : 0.0002694946, 0.0002694946  (x, y)
## extent      : -122.6001, -122.1999, 37.59988, 38.10007  (xmin, xmax, ymin, ymax)
## coord. ref. : lon/lat WGS 84 (EPSG:4326) 
## source      : NDVI_rast2.tif 
## name        : NDVI_BayArea 
## min value   :   -1.0000000 
## max value   :    0.8533574


Does it have a CRS?

## Check CRS
st_crs(NDVI_raster)
## Coordinate Reference System:
##   User input: WGS 84 
##   wkt:
## GEOGCRS["WGS 84",
##     ENSEMBLE["World Geodetic System 1984 ensemble",
##         MEMBER["World Geodetic System 1984 (Transit)"],
##         MEMBER["World Geodetic System 1984 (G730)"],
##         MEMBER["World Geodetic System 1984 (G873)"],
##         MEMBER["World Geodetic System 1984 (G1150)"],
##         MEMBER["World Geodetic System 1984 (G1674)"],
##         MEMBER["World Geodetic System 1984 (G1762)"],
##         MEMBER["World Geodetic System 1984 (G2139)"],
##         MEMBER["World Geodetic System 1984 (G2296)"],
##         ELLIPSOID["WGS 84",6378137,298.257223563,
##             LENGTHUNIT["metre",1]],
##         ENSEMBLEACCURACY[2.0]],
##     PRIMEM["Greenwich",0,
##         ANGLEUNIT["degree",0.0174532925199433]],
##     CS[ellipsoidal,2],
##         AXIS["geodetic latitude (Lat)",north,
##             ORDER[1],
##             ANGLEUNIT["degree",0.0174532925199433]],
##         AXIS["geodetic longitude (Lon)",east,
##             ORDER[2],
##             ANGLEUNIT["degree",0.0174532925199433]],
##     USAGE[
##         SCOPE["Horizontal component of 3D system."],
##         AREA["World."],
##         BBOX[-90,-180,90,180]],
##     ID["EPSG",4326]]


OK we have what looks like a raster. We see our resolution and our extent, and we have a CRS. Nice! Shall we plot this?

## Plot the raster on a map
tmap_mode("plot")
## ℹ tmap modes "plot" - "view"
## ℹ toggle with `tmap::ttm()`
NDVI_map = tm_shape(NDVI_raster) +
  tm_raster(style = "cont") +
  tm_legend(outside = TRUE)
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.
NDVI_map
## [v3->v4] `tm_legend()`: use 'tm_legend()' inside a layer function, e.g.
## 'tm_polygons(..., fill.legend = tm_legend())'
## Variable(s) "col" contains positive and negative values, so midpoint is set to 0. Set midpoint = NA to show the full range of visual values.
## 
## This message is displayed once every 8 hours.


Looks pretty cool! Seems to be the Bay Area, and we have some nice variability. But we let’s see if we can make this fancier.

# palette for plotting
breaks_ndvi <- c(-1,-0.2,-0.1,0,0.025 ,0.05,0.075,0.1,0.125,0.15,0.175,0.2 ,0.25 ,0.3 ,0.35,0.4,0.45,0.5,0.55,0.6,1)
palette_ndvi <- c("#BFBFBF","#DBDBDB","#FFFFE0","#FFFACC","#EDE8B5","#DED99C","#CCC782","#BDB86B","#B0C261","#A3CC59","#91BF52","#80B347","#70A340","#619636","#4F8A2E","#407D24","#306E1C","#216112","#0F540A","#004500")

NDVI_map = tm_shape(NDVI_raster) +
  tm_raster(title = "NDVI",
             style="cont",
             palette = palette_ndvi
            ) +
  tm_legend(outside = TRUE)
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.
## ℹ Migrate the argument(s) 'palette' (rename to 'values') to
##   'tm_scale_continuous(<HERE>)'
## [v3->v4] `tm_raster()`: migrate the argument(s) related to the legend of the
## visual variable `col` namely 'title' to 'col.legend = tm_legend(<HERE>)'
NDVI_map


Crop

OK, let’s see if we can crop this to focus on San Francisco. I’ve googled the lat and long for the area around San Francisco, and I’ll put these right into my crop() function. I can use the tmap_mode("view") now because the raster is small enough for R to make interactive.

sf_rast<-crop(NDVI_raster, ext(-122.55, -122.35, 37.7, 37.83))

tmap_mode("plot")
## ℹ tmap modes "plot" - "view"
NDVI_sf_map = tm_shape(sf_rast) +
  tm_raster(title = "NDVI",
             style="cont",
            ) +
  tm_legend(outside = TRUE)
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.[v3->v4] `tm_raster()`: migrate the argument(s) related to the legend of the
## visual variable `col` namely 'title' to 'col.legend = tm_legend(<HERE>)'
NDVI_sf_map
## Variable(s) "col" contains positive and negative values, so midpoint is set to 0. Set midpoint = NA to show the full range of visual values.


Classify

So negative values of NDVI represent water. Let’s set all negative values to -1, and that will help us to distinguish water from land easier.

sf_rast_neg <- app(sf_rast, fun=function(x){ x[x <= 0] <- -1; return(x)} )

NDVI_sf_map_neg = tm_shape(sf_rast_neg) +
  tm_raster(title = "NDVI",
             style="cont",
            ) +
  tm_legend(outside = TRUE)
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.
## [v3->v4] `tm_raster()`: migrate the argument(s) related to the legend of the
## visual variable `col` namely 'title' to 'col.legend = tm_legend(<HERE>)'
NDVI_sf_map_neg
## Variable(s) "col" contains positive and negative values, so midpoint is set to 0. Set midpoint = NA to show the full range of visual values.


Nice. What do we notice? The coast of San Francisco might have some cloud cover errors! Satellite data isn’t perfect! But the good news is, we’ve learned how to bring in raster data! I think we need a badge!!!!


terra Badge
terra Badge


One last step. Let’s put all our knowledge together and map our old friend CAdata on top of the NDVI data in San Francisco. First, let’s bring in the CAdata dataset on ovarian cancer cases again.

data(CAdata)
ca_pts <- CAdata
ca_proj <- "+proj=lcc +lat_1=40 +lat_2=41.66666666666666 
             +lat_0=39.33333333333334 +lon_0=-122 +x_0=2000000 
             +y_0=500000.0000000002 +ellps=GRS80 
             +datum=NAD83 +units=m +no_defs"

ca_pts <- st_as_sf(CAdata, coords=c("X","Y"), crs=ca_proj)


Let’s check the CRS and compare it to our NDVI dataset.

st_crs(ca_pts)
## Coordinate Reference System:
##   User input: +proj=lcc +lat_1=40 +lat_2=41.66666666666666 
##              +lat_0=39.33333333333334 +lon_0=-122 +x_0=2000000 
##              +y_0=500000.0000000002 +ellps=GRS80 
##              +datum=NAD83 +units=m +no_defs 
##   wkt:
## PROJCRS["unknown",
##     BASEGEOGCRS["unknown",
##         DATUM["North American Datum 1983",
##             ELLIPSOID["GRS 1980",6378137,298.257222101,
##                 LENGTHUNIT["metre",1]],
##             ID["EPSG",6269]],
##         PRIMEM["Greenwich",0,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8901]]],
##     CONVERSION["unknown",
##         METHOD["Lambert Conic Conformal (2SP)",
##             ID["EPSG",9802]],
##         PARAMETER["Latitude of false origin",39.3333333333333,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8821]],
##         PARAMETER["Longitude of false origin",-122,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8822]],
##         PARAMETER["Latitude of 1st standard parallel",40,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8823]],
##         PARAMETER["Latitude of 2nd standard parallel",41.6666666666667,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8824]],
##         PARAMETER["Easting at false origin",2000000,
##             LENGTHUNIT["metre",1],
##             ID["EPSG",8826]],
##         PARAMETER["Northing at false origin",500000,
##             LENGTHUNIT["metre",1],
##             ID["EPSG",8827]]],
##     CS[Cartesian,2],
##         AXIS["(E)",east,
##             ORDER[1],
##             LENGTHUNIT["metre",1,
##                 ID["EPSG",9001]]],
##         AXIS["(N)",north,
##             ORDER[2],
##             LENGTHUNIT["metre",1,
##                 ID["EPSG",9001]]]]
st_crs(sf_rast_neg)
## Coordinate Reference System:
##   User input: WGS 84 
##   wkt:
## GEOGCRS["WGS 84",
##     ENSEMBLE["World Geodetic System 1984 ensemble",
##         MEMBER["World Geodetic System 1984 (Transit)"],
##         MEMBER["World Geodetic System 1984 (G730)"],
##         MEMBER["World Geodetic System 1984 (G873)"],
##         MEMBER["World Geodetic System 1984 (G1150)"],
##         MEMBER["World Geodetic System 1984 (G1674)"],
##         MEMBER["World Geodetic System 1984 (G1762)"],
##         MEMBER["World Geodetic System 1984 (G2139)"],
##         MEMBER["World Geodetic System 1984 (G2296)"],
##         ELLIPSOID["WGS 84",6378137,298.257223563,
##             LENGTHUNIT["metre",1]],
##         ENSEMBLEACCURACY[2.0]],
##     PRIMEM["Greenwich",0,
##         ANGLEUNIT["degree",0.0174532925199433]],
##     CS[ellipsoidal,2],
##         AXIS["geodetic latitude (Lat)",north,
##             ORDER[1],
##             ANGLEUNIT["degree",0.0174532925199433]],
##         AXIS["geodetic longitude (Lon)",east,
##             ORDER[2],
##             ANGLEUNIT["degree",0.0174532925199433]],
##     USAGE[
##         SCOPE["Horizontal component of 3D system."],
##         AREA["World."],
##         BBOX[-90,-180,90,180]],
##     ID["EPSG",4326]]


Hmmm, let’s make sure they are the same projection.

ca_pts_proj<-st_transform(ca_pts,st_crs(sf_rast_neg))
st_crs(ca_pts_proj)
## Coordinate Reference System:
##   User input: WGS 84 
##   wkt:
## GEOGCRS["WGS 84",
##     ENSEMBLE["World Geodetic System 1984 ensemble",
##         MEMBER["World Geodetic System 1984 (Transit)"],
##         MEMBER["World Geodetic System 1984 (G730)"],
##         MEMBER["World Geodetic System 1984 (G873)"],
##         MEMBER["World Geodetic System 1984 (G1150)"],
##         MEMBER["World Geodetic System 1984 (G1674)"],
##         MEMBER["World Geodetic System 1984 (G1762)"],
##         MEMBER["World Geodetic System 1984 (G2139)"],
##         MEMBER["World Geodetic System 1984 (G2296)"],
##         ELLIPSOID["WGS 84",6378137,298.257223563,
##             LENGTHUNIT["metre",1]],
##         ENSEMBLEACCURACY[2.0]],
##     PRIMEM["Greenwich",0,
##         ANGLEUNIT["degree",0.0174532925199433]],
##     CS[ellipsoidal,2],
##         AXIS["geodetic latitude (Lat)",north,
##             ORDER[1],
##             ANGLEUNIT["degree",0.0174532925199433]],
##         AXIS["geodetic longitude (Lon)",east,
##             ORDER[2],
##             ANGLEUNIT["degree",0.0174532925199433]],
##     USAGE[
##         SCOPE["Horizontal component of 3D system."],
##         AREA["World."],
##         BBOX[-90,-180,90,180]],
##     ID["EPSG",4326]]


They should be good to go now. Let’s map these addresses on top of the raster data!

tmap_mode("plot")
## ℹ tmap modes "plot" - "view"
NDVI_cancer_map = tm_shape(sf_rast_neg) +
  tm_raster(style = "cont", title = "NDVI") +
  tm_legend(outside = TRUE) +
  tm_shape(ca_pts_proj) + 
  tm_dots(size=0.3, alpha=0.5, col = "blue")
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.[v3->v4] `tm_raster()`: migrate the argument(s) related to the legend of the
## visual variable `col` namely 'title' to 'col.legend = tm_legend(<HERE>)'[v3->v4] `tm_dots()`: use 'fill' for the fill color of polygons/symbols
## (instead of 'col'), and 'col' for the outlines (instead of 'border.col').[v3->v4] `tm_dots()`: use `fill_alpha` instead of `alpha`.
NDVI_cancer_map
## Variable(s) "col" contains positive and negative values, so midpoint is set to 0. Set midpoint = NA to show the full range of visual values.


That is one fine looking map.


Install packages

First, let’s install our packages.

library(sf)
library(MapGAM)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ purrr::accumulate() masks foreach::accumulate()
## ✖ tidyr::extract()    masks terra::extract()
## ✖ dplyr::filter()     masks stats::filter()
## ✖ dplyr::lag()        masks stats::lag()
## ✖ purrr::when()       masks foreach::when()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(flextable)
## 
## Attaching package: 'flextable'
## 
## The following object is masked from 'package:purrr':
## 
##     compose
## 
## The following objects are masked from 'package:terra':
## 
##     align, colorize, rotate, width
library(RColorBrewer)
library(tmap)
library(terra)


Bring in Cancer dataset

We will be using data included in the MapGAM package. As a reminder: While they are based on real patterns expected in observational epidemiologic studies, these data have been simulated and are for teaching purposes only. The data contain 5000 simulated ovarian cancer cases. While this is a cohort with time to mortality, for the purposes of our class, we will conduct simple tabular analyses looking at associations between different spatial exposures with mortality at end of follow-up.

As another reminder, the CAdata dataset contains the following variables:

  • time (follow-up time)
  • event (1=dead, 0=censored)
  • X (Latitude)
  • Y (Longitude)
  • AGE (age in years)
  • INS (insurance status, categorical)


Read in Cancer Dataset

Next, we want to read in all of our spatial data. First, we read in the CAdata dataset from the MapGAM package, and then convert it to a spatial dataset.

data(CAdata)
ca_pts <- CAdata
ca_proj <- "+proj=lcc +lat_1=40 +lat_2=41.66666666666666 
             +lat_0=39.33333333333334 +lon_0=-122 +x_0=2000000 
             +y_0=500000.0000000002 +ellps=GRS80 
             +datum=NAD83 +units=m +no_defs"

ca_pts <- st_as_sf(CAdata, coords=c("X","Y"), crs=ca_proj)


Read in Greenspace Data

We then read in the raster for greenspace data across the Bay Area. Finally, we check the file to make sure it was read correctly. Does it have a coordinate reference system?

url <- "https://github.com/pjames-ucdavis/SPH215/raw/main/NDVI_rast2.tif"
download.file(url, destfile = "NDVI_rast2.tif", mode = "wb")
ndvi_rast = rast("NDVI_rast2.tif")

ndvi_rast
## class       : SpatRaster 
## dimensions  : 1856, 1485, 1  (nrow, ncol, nlyr)
## resolution  : 0.0002694946, 0.0002694946  (x, y)
## extent      : -122.6001, -122.1999, 37.59988, 38.10007  (xmin, xmax, ymin, ymax)
## coord. ref. : lon/lat WGS 84 (EPSG:4326) 
## source      : NDVI_rast2.tif 
## name        : NDVI_BayArea 
## min value   :   -1.0000000 
## max value   :    0.8533574


Check Projections for all Spatial Data

Finally, we check the projections. This is the most important step and is guaranteed to make life easier with your geospatial analysis! When you have files in different projections, this can be a major problem because when we try to overlay the two files they may not overlap. First we check the coordinate reference systems for each dataset using st_crs(). We then use the st_transform() function to convert the projection for our point data to match that of our polygon data. When we are done, do the projections of the two datasets match?

## Look at the coordinate reference system for the cancer data, and for greenspace data
st_crs(ca_pts)
## Coordinate Reference System:
##   User input: +proj=lcc +lat_1=40 +lat_2=41.66666666666666 
##              +lat_0=39.33333333333334 +lon_0=-122 +x_0=2000000 
##              +y_0=500000.0000000002 +ellps=GRS80 
##              +datum=NAD83 +units=m +no_defs 
##   wkt:
## PROJCRS["unknown",
##     BASEGEOGCRS["unknown",
##         DATUM["North American Datum 1983",
##             ELLIPSOID["GRS 1980",6378137,298.257222101,
##                 LENGTHUNIT["metre",1]],
##             ID["EPSG",6269]],
##         PRIMEM["Greenwich",0,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8901]]],
##     CONVERSION["unknown",
##         METHOD["Lambert Conic Conformal (2SP)",
##             ID["EPSG",9802]],
##         PARAMETER["Latitude of false origin",39.3333333333333,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8821]],
##         PARAMETER["Longitude of false origin",-122,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8822]],
##         PARAMETER["Latitude of 1st standard parallel",40,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8823]],
##         PARAMETER["Latitude of 2nd standard parallel",41.6666666666667,
##             ANGLEUNIT["degree",0.0174532925199433],
##             ID["EPSG",8824]],
##         PARAMETER["Easting at false origin",2000000,
##             LENGTHUNIT["metre",1],
##             ID["EPSG",8826]],
##         PARAMETER["Northing at false origin",500000,
##             LENGTHUNIT["metre",1],
##             ID["EPSG",8827]]],
##     CS[Cartesian,2],
##         AXIS["(E)",east,
##             ORDER[1],
##             LENGTHUNIT["metre",1,
##                 ID["EPSG",9001]]],
##         AXIS["(N)",north,
##             ORDER[2],
##             LENGTHUNIT["metre",1,
##                 ID["EPSG",9001]]]]
st_crs(ndvi_rast)
## Coordinate Reference System:
##   User input: WGS 84 
##   wkt:
## GEOGCRS["WGS 84",
##     ENSEMBLE["World Geodetic System 1984 ensemble",
##         MEMBER["World Geodetic System 1984 (Transit)"],
##         MEMBER["World Geodetic System 1984 (G730)"],
##         MEMBER["World Geodetic System 1984 (G873)"],
##         MEMBER["World Geodetic System 1984 (G1150)"],
##         MEMBER["World Geodetic System 1984 (G1674)"],
##         MEMBER["World Geodetic System 1984 (G1762)"],
##         MEMBER["World Geodetic System 1984 (G2139)"],
##         MEMBER["World Geodetic System 1984 (G2296)"],
##         ELLIPSOID["WGS 84",6378137,298.257223563,
##             LENGTHUNIT["metre",1]],
##         ENSEMBLEACCURACY[2.0]],
##     PRIMEM["Greenwich",0,
##         ANGLEUNIT["degree",0.0174532925199433]],
##     CS[ellipsoidal,2],
##         AXIS["geodetic latitude (Lat)",north,
##             ORDER[1],
##             ANGLEUNIT["degree",0.0174532925199433]],
##         AXIS["geodetic longitude (Lon)",east,
##             ORDER[2],
##             ANGLEUNIT["degree",0.0174532925199433]],
##     USAGE[
##         SCOPE["Horizontal component of 3D system."],
##         AREA["World."],
##         BBOX[-90,-180,90,180]],
##     ID["EPSG",4326]]
## Transform the coordinate reference system of the cancer data to match that 
## of the greenspace  data
ca_transformed <-st_transform(ca_pts, st_crs(ndvi_rast))  

## Check projections
st_crs(ndvi_rast)==st_crs(ca_transformed)
## [1] TRUE


Map The Data

Now, we will visualize our spatial data using tmap. We will overlay the greenspace maps with the ovarian cancer data. Do any patterns jump out, or are there any participants living in the middle of the Bay?

ca.ndvi.map <- tm_shape(ndvi_rast) +
  tm_raster(style = "cont") +
      tm_shape(ca_transformed) +
        tm_dots(size=0.25, alpha=0.8, col="blue")
## 
## ── tmap v3 code detected ───────────────────────────────────────────────────────
## [v3->v4] `tm_raster()`: instead of `style = "cont"`, use col.scale =
## `tm_scale_continuous()`.
## [v3->v4] `tm_dots()`: use `fill_alpha` instead of `alpha`.
ca.ndvi.map
## Variable(s) "col" contains positive and negative values, so midpoint is set to 0. Set midpoint = NA to show the full range of visual values.


We find that the most least green areas are in the downtown areas of San Francisco and Oakland, which makes sense. Our cancer cohort data overlaps with the greenspace map, which is reassuring.


Extract Raster Values to Points

Now that we have visualized our data, let’s see if there is an association between greenspace exposure and mortality among ovarian cancer cases. We will first extract the values for greenspace to the cancer dataset (merge the two datasets based on location of cases and the greenspace pixel that they are in) using terra::extract. Then we will check the distribution of greenspace exposure in our cancer cases. We will use a two-sided chi-squared test to test our hypothesis of the association between greenspace exposure and mortality among ovarian cancer cases. What do we find?

## Spatially join the cancer point data to the walkability polygon data
ndvi_cancer = data.frame(ca_transformed,terra::extract(ndvi_rast, ca_transformed))
glimpse(ndvi_cancer) 
## Rows: 5,000
## Columns: 7
## $ time         <dbl> 1.2759763, 4.2121775, 0.2074870, 3.5099074, 10.2977017, 4…
## $ event        <dbl> 1, 1, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, …
## $ AGE          <int> 67, 56, 67, 69, 75, 59, 62, 39, 68, 72, 78, 79, 46, 77, 6…
## $ INS          <fct> Mcr, Mcd, Mng, Mcr, Mng, Mcr, Oth, Uni, Uni, Uni, Mcr, Mn…
## $ geometry     <POINT [°]> POINT (-122.3492 38.3025), POINT (-118.0174 34.1437…
## $ ID           <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17…
## $ NDVI_BayArea <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.2483448…
## Take a look at a summary of the values
summary(ndvi_cancer$NDVI_BayArea)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##  -0.311   0.123   0.239   0.267   0.376   0.757    4688


Looks like we have lots of NA values. That is because some of our participants live outside of the area of our greenspace data. Let’s drop those missing values using drop_na(), which is slightly different from how we’ve done this before.

ndvi_cancer_nomiss <- ndvi_cancer %>% drop_na(NDVI_BayArea) 

## Take a look at a summary of the values
summary(ndvi_cancer_nomiss$NDVI_BayArea)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.3107  0.1228  0.2385  0.2666  0.3759  0.7572
glimpse(ndvi_cancer_nomiss)
## Rows: 312
## Columns: 7
## $ time         <dbl> 7.0125318, 0.9644371, 15.0007229, 2.9063815, 16.7471545, …
## $ event        <dbl> 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, …
## $ AGE          <int> 46, 69, 45, 78, 72, 73, 77, 72, 46, 61, 79, 54, 78, 60, 7…
## $ INS          <fct> Mcr, Unk, Mcd, Mcr, Mng, Mcr, Mng, Mcr, Oth, Uni, Mcr, Un…
## $ geometry     <POINT [°]> POINT (-122.2031 38.09592), POINT (-122.416 37.7678…
## $ ID           <dbl> 13, 42, 48, 49, 64, 74, 100, 124, 141, 173, 178, 219, 223…
## $ NDVI_BayArea <dbl> 0.24834478, 0.03120242, 0.21596712, 0.09975440, 0.5120553…


Analyze our Joined Dataset

OK, we have a dataset with no missingness. Can we look at the distribution of greenspace exposure among participants?

ndvi_cancer_nomiss %>%
  ggplot() + 
  geom_histogram(mapping = aes(x=NDVI_BayArea)) 
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.


For the purposes of our analysis, let’s divide up our greenspace data into quartiles. We will do this using the mutate() function combined with the ntile() function. Then we will take a glimpse at our new dataset.

ndvi_cancer_nomiss <- ndvi_cancer_nomiss %>%
  mutate(ndvi_quartile = ntile(NDVI_BayArea, 4))

glimpse(ndvi_cancer_nomiss)
## Rows: 312
## Columns: 8
## $ time          <dbl> 7.0125318, 0.9644371, 15.0007229, 2.9063815, 16.7471545,…
## $ event         <dbl> 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1,…
## $ AGE           <int> 46, 69, 45, 78, 72, 73, 77, 72, 46, 61, 79, 54, 78, 60, …
## $ INS           <fct> Mcr, Unk, Mcd, Mcr, Mng, Mcr, Mng, Mcr, Oth, Uni, Mcr, U…
## $ geometry      <POINT [°]> POINT (-122.2031 38.09592), POINT (-122.416 37.767…
## $ ID            <dbl> 13, 42, 48, 49, 64, 74, 100, 124, 141, 173, 178, 219, 22…
## $ NDVI_BayArea  <dbl> 0.24834478, 0.03120242, 0.21596712, 0.09975440, 0.512055…
## $ ndvi_quartile <int> 3, 1, 2, 1, 4, 1, 3, 1, 4, 1, 1, 3, 3, 1, 3, 3, 1, 3, 4,…


OK that looks good. We have created a new variable ndvi_quartile that tells us what quartile of greenspace a participant lives in. Let’s do a two by two table of greenspace quartiles by event, which is whether a participant died over followup.

## Create a contingency table of event by walk_quartile
tab <- table(ndvi_cancer_nomiss$ndvi_quartile, ndvi_cancer_nomiss$event)
tab
##    
##      0  1
##   1 36 42
##   2 37 41
##   3 32 46
##   4 31 47


Hmmm, that’s interesting, but let’s look at this by percentages instead.

## Convert to percentages by column
tab_col_perc <- prop.table(tab, margin = 2) * 100
round(tab_col_perc, 1)
##    
##        0    1
##   1 26.5 23.9
##   2 27.2 23.3
##   3 23.5 26.1
##   4 22.8 26.7


Do you think the percentages are different by quartile of greenspace? We can run a chi-squared test to be sure. This is a statistical test to see whether there is a difference in the probability of event, or whether a participant died over follow-up, by the quartiles of greenspace We do this with the chisq.test() function.

## Chi-squared test
chisq.test(tab)
## 
##  Pearson's Chi-squared test
## 
## data:  tab
## X-squared = 1.3556, df = 3, p-value = 0.716


OK, how do we interpret this? Our null hypothesis is that there is no association between mortality at end of follow-up and increasing quartile of greenspace. Our alternative hypothesis is that there is an association between mortality at end of follow-up and increasing quartile of greenspace. We use a two-sided chi-squared test with alpha=0.05. Assuming no sources of bias and that the null hypothesis is true, the probability of observing increases in mortality at end of follow-up with increasing quartiles of greenspace as or more extreme as those produced in these data is 0.716. Since p>0.05, we fail to reject the null hypothesis and conclude that greenspace is not associated with mortality at end of follow-up (under the assumptions stated above). In other words, we don’t see a relationship between greenspace exposure and our outcome (dying over followup).

LS0tCnRpdGxlOiAnTGFiIDU6IFdvcmtpbmcgd2l0aCBSYXN0ZXIgZGF0YSwgSm9pbiBnZW9jb2RlZCBhZGRyZXNzZXMgdG8gcG9seWdvbiBkYXRhIHRvIGNyZWF0ZSBleHBvc3VyZSBtZXRyaWNzJwotLS0KCkluIHRoaXMgbGFiLCB3ZSBhcmUgZ29pbmcgdG8gd29yayB3aXRoIHZlY3RvciBhbmQgcmFzdGVyIGRhdGEsIHNwYXRpYWxseSBqb2luaW5nIHBvaW50IGRhdGEgdG8gdmVjdG9yIGRhdGEgCgpUaGUgb2JqZWN0aXZlcyBvZiB0aGlzIGd1aWRlIGFyZSB0byB0ZWFjaCB5b3U6CgogICAxLiBJbnRyb2R1Y2UgcmFzdGVyIGRhdGEgCiAgIDIuIEltcG9ydCBvdXIgZGF0YXNldCB3aXRoIHNpbXVsYXRlZCBnZW9jb2RlZCBhZGRyZXNzZXMgYW5kIG1vcnRhbGl0eSBkYXRhIGZyb20gYW4gb3ZhcmlhbiBjYW5jZXIgY29ob3J0CiAgIDMuIEltcG9ydCBhIGRhdGFzZXQgd2l0aCBncmVlbnNwYWNlIGFjcm9zcyB0aGUgQmF5IEFyZWEKICAgNC4gQ29tcGFyZSBwcm9qZWN0aW9ucyBvZiBkYXRhc2V0cyBhbmQgcmUtcHJvamVjdCBpZiBuZWVkZWQKICAgNS4gTWFrZSBtYXBzCiAgIDYuIFNwYXRpYWxseSBqb2luIHRoZSB0d28gZGF0YXNldHMKICAgNy4gUnVuIGEgcXVpY2sgc3RhdGlzdGljYWwgYW5hbHlzaXMgb24gdGhlIHR3byBkYXRhc2V0cyBjb21iaW5lZAoKRW5vdWdoIHRhbGstLWxldCdzIGdldCBjb2RpbmchCgpcCiMgTG9hZCBwYWNrYWdlcwpgYGB7cn0KbGlicmFyeSh0ZXJyYSkKbGlicmFyeShzZikKbGlicmFyeSh0bWFwKQpsaWJyYXJ5KE1hcEdBTSkKYGBgCiAgICAgICAgCiMgUmFzdGVycwoKUmFzdGVyIGRhdGFzZXRzIGFyZSBzaW1wbHkgYW4gYXJyYXkgb2YgcGl4ZWxzL2NlbGxzIG9yZ2FuaXplZCBpbnRvIHJvd3MgYW5kIGNvbHVtbnMgKG9yIGEgZ3JpZCkgd2hlcmUgZWFjaCBjZWxsIGNvbnRhaW5zIGEgdmFsdWUgcmVwcmVzZW50aW5nIGluZm9ybWF0aW9uLCBzdWNoIGFzIHRlbXBlcmF0dXJlLCB2ZWdldGF0aW9uLCBsYW5kIHVzZSwgYWlyIHBvbGx1dGlvbiwgZXRjLiBSYXN0ZXIgbWFwcyB1c3VhbGx5IHJlcHJlc2VudCBjb250aW51b3VzIHBoZW5vbWVuYSBzdWNoIGFzIGVsZXZhdGlvbiwgdGVtcGVyYXR1cmUsIG9yIHBvcHVsYXRpb24gZGVuc2l0eS4gRGlzY3JldGUgZmVhdHVyZXMgc3VjaCBhcyBzb2lsIHR5cGUgb3IgbGFuZC1jb3ZlciBjbGFzc2VzIGNhbiBhbHNvIGJlIHJlcHJlc2VudGVkIGluIHRoZSByYXN0ZXIgZGF0YSBtb2RlbC4gUmFzdGVycyBhcmUgYWVyaWFsIHBob3RvZ3JhcGhzLCBpbWFnZXJ5IGZyb20gc2F0ZWxsaXRlcywgR29vZ2xlIFN0cmVldCBWaWV3IGltYWdlcywgZXRjLiBBIGZldyB0aGluZ3MgdG8gbm90ZS4KCiAtIFJhc3RlciBkYXRhc2V0cyBhcmUgYWx3YXlzIHJlY3Rhbmd1bGFyIChyb3dzIHggY29sKSBzaW1pbGFyIHRvIG1hdHJpY2VzLiBJcnJlZ3VsYXIgYm91bmRhcmllcyBhcmUgY3JlYXRlZCBieSB1c2luZyBgTkFzYC4KIC0gUmFzdGVycyBoYXZlIHRvIGNvbnRhaW4gdmFsdWVzIG9mIHRoZSBzYW1lIHR5cGUgKGludCwgZmxvYXQsIGJvb2xlYW4pIHRocm91Z2hvdXQgdGhlIHJhc3RlciwganVzdCBsaWtlIG1hdHJpY2VzIGFuZCB1bmxpa2UgZGF0YSBmcmFtZXMuCiAtIFRoZSBzaXplIG9mIHRoZSByYXN0ZXIgZGVwZW5kcyBvbiB0aGUgKipyZXNvbHV0aW9uKiogYW5kIHRoZSAqKmV4dGVudCoqIG9mIHRoZSByYXN0ZXIuIEFzIHN1Y2ggbWFueSByYXN0ZXJzIGFyZSBsYXJnZSBhbmQgb2Z0ZW4gY2Fubm90IGJlIGhlbGQgaW4gbWVtb3J5IGNvbXBsZXRlbHkuCiAKIApUaGUgd29ya2hvcnNlIHBhY2thZ2UgZm9yIHdvcmtpbmcgd2l0aCByYXN0ZXJzIGluIFIgaXMgdGhlICoqdGVycmEqKiBwYWNrYWdlIGJ5IFJvYmVydCBIaWptYW5zLiAqKnRlcnJhKiogaGFzIGZ1bmN0aW9ucyBmb3IgY3JlYXRpbmcsIHJlYWRpbmcsIG1hbmlwdWxhdGluZywgYW5kIHdyaXRpbmcgcmFzdGVyIGRhdGEuIFRoZSBwYWNrYWdlIGFsc28gaW1wbGVtZW50cyByYXN0ZXIgYWxnZWJyYSBhbmQgbWFueSBvdGhlciBmdW5jdGlvbnMgZm9yIHJhc3RlciBkYXRhIG1hbmlwdWxhdGlvbi4gVGhlIHBhY2thZ2Ugd29ya3Mgd2l0aCBgU3BhdFJhc3RlcmAgb2JqZWN0cy4gVGhlIGByYXN0KClgIGZ1bmN0aW9uIGlzIHVzZWQgdG8gY3JlYXRlIHRoZXNlIG9iamVjdHMuIAoKVHlwaWNhbGx5IHlvdSB3aWxsIGJyaW5nIGluIGEgcmFzdGVyIGRhdGFzZXQgZGlyZWN0bHkgZnJvbSBhIGZpbGUuIFRoZXNlIGZpbGVzIGNvbWUgaW4gbWFueSBkaWZmZXJlbnQgZm9ybXMsIHR5cGljYWxseSAudGlmLCAuaW1nLCBhbmQgLmdyZC4KClwKCldl4oCZbGwgYnJpbmcgaW4gdGhlIGZpbGUgTkRWSV9yYXN0LnRpZi4gVGhlIGZpbGUgY29udGFpbnMgbm9ybWFsaXplZCBkaWZmZXJlbmNlIHZlZ2V0YXRpb24gaW5kZXggKE5EVkkpIGRhdGEgZm9yIHRoZSBCYXkgQXJlYS4gVGhlc2UgZGF0YSBhcmUgdGFrZW4gZnJvbSBMYW5kc2F0IHNhdGVsbGl0ZSBkYXRhIHRoYXQgSSBkb3dubG9hZGVkIGZyb20gR29vZ2xlIEVhcnRoIEVuZ2luZS4gV2UgdXNlIHRoZSBmdW5jdGlvbiBgcmFzdCgpYCB0byBicmluZyBpbiBkYXRhIGluIHJhc3RlciBmb3JtLCB0aGVuIHRha2UgYSBsb29rIGF0IHRoZSBkYXRhc2V0LgoKYGBge3J9CgoKdXJsIDwtICJodHRwczovL2dpdGh1Yi5jb20vcGphbWVzLXVjZGF2aXMvU1BIMjE1L3Jhdy9tYWluL05EVklfcmFzdDIudGlmIgpkb3dubG9hZC5maWxlKHVybCwgZGVzdGZpbGUgPSAiTkRWSV9yYXN0Mi50aWYiLCBtb2RlID0gIndiIikKTkRWSV9yYXN0ZXIgPSByYXN0KCJORFZJX3Jhc3QyLnRpZiIpCgojIyBHZXQgc3VtbWFyeSBvZiByYXN0ZXIgZGF0YQpORFZJX3Jhc3RlcgpgYGAKClwKCkRvZXMgaXQgaGF2ZSBhIENSUz8KYGBge3J9CgojIyBDaGVjayBDUlMKc3RfY3JzKE5EVklfcmFzdGVyKQoKYGBgCgpcCgpPSyB3ZSBoYXZlIHdoYXQgbG9va3MgbGlrZSBhIHJhc3Rlci4gV2Ugc2VlIG91ciByZXNvbHV0aW9uIGFuZCBvdXIgZXh0ZW50LCBhbmQgd2UgaGF2ZSBhIENSUy4gTmljZSEgU2hhbGwgd2UgcGxvdCB0aGlzPwoKYGBge3J9CiMjIFBsb3QgdGhlIHJhc3RlciBvbiBhIG1hcAp0bWFwX21vZGUoInBsb3QiKQpORFZJX21hcCA9IHRtX3NoYXBlKE5EVklfcmFzdGVyKSArCiAgdG1fcmFzdGVyKHN0eWxlID0gImNvbnQiKSArCiAgdG1fbGVnZW5kKG91dHNpZGUgPSBUUlVFKQpORFZJX21hcApgYGAKClwKCkxvb2tzIHByZXR0eSBjb29sISBTZWVtcyB0byBiZSB0aGUgQmF5IEFyZWEsIGFuZCB3ZSBoYXZlIHNvbWUgbmljZSB2YXJpYWJpbGl0eS4gQnV0IHdlIGxldCdzIHNlZSBpZiB3ZSBjYW4gbWFrZSB0aGlzIGZhbmNpZXIuCgpgYGB7cn0KIyBwYWxldHRlIGZvciBwbG90dGluZwpicmVha3NfbmR2aSA8LSBjKC0xLC0wLjIsLTAuMSwwLDAuMDI1ICwwLjA1LDAuMDc1LDAuMSwwLjEyNSwwLjE1LDAuMTc1LDAuMiAsMC4yNSAsMC4zICwwLjM1LDAuNCwwLjQ1LDAuNSwwLjU1LDAuNiwxKQpwYWxldHRlX25kdmkgPC0gYygiI0JGQkZCRiIsIiNEQkRCREIiLCIjRkZGRkUwIiwiI0ZGRkFDQyIsIiNFREU4QjUiLCIjREVEOTlDIiwiI0NDQzc4MiIsIiNCREI4NkIiLCIjQjBDMjYxIiwiI0EzQ0M1OSIsIiM5MUJGNTIiLCIjODBCMzQ3IiwiIzcwQTM0MCIsIiM2MTk2MzYiLCIjNEY4QTJFIiwiIzQwN0QyNCIsIiMzMDZFMUMiLCIjMjE2MTEyIiwiIzBGNTQwQSIsIiMwMDQ1MDAiKQoKTkRWSV9tYXAgPSB0bV9zaGFwZShORFZJX3Jhc3RlcikgKwogIHRtX3Jhc3Rlcih0aXRsZSA9ICJORFZJIiwKICAgICAgICAgICAgIHN0eWxlPSJjb250IiwKICAgICAgICAgICAgIHBhbGV0dGUgPSBwYWxldHRlX25kdmkKICAgICAgICAgICAgKSArCiAgdG1fbGVnZW5kKG91dHNpZGUgPSBUUlVFKQpORFZJX21hcApgYGAKClwKCiMjIENyb3AKCk9LLCBsZXQncyBzZWUgaWYgd2UgY2FuIGNyb3AgdGhpcyB0byBmb2N1cyBvbiBTYW4gRnJhbmNpc2NvLiBJJ3ZlIGdvb2dsZWQgdGhlIGxhdCBhbmQgbG9uZyBmb3IgdGhlIGFyZWEgYXJvdW5kIFNhbiBGcmFuY2lzY28sIGFuZCBJJ2xsIHB1dCB0aGVzZSByaWdodCBpbnRvIG15IGBjcm9wKClgIGZ1bmN0aW9uLiBJIGNhbiB1c2UgdGhlIGB0bWFwX21vZGUoInZpZXciKWAgbm93IGJlY2F1c2UgdGhlIHJhc3RlciBpcyBzbWFsbCBlbm91Z2ggZm9yIFIgdG8gbWFrZSBpbnRlcmFjdGl2ZS4KCmBgYHtyfQpzZl9yYXN0PC1jcm9wKE5EVklfcmFzdGVyLCBleHQoLTEyMi41NSwgLTEyMi4zNSwgMzcuNywgMzcuODMpKQoKdG1hcF9tb2RlKCJwbG90IikKTkRWSV9zZl9tYXAgPSB0bV9zaGFwZShzZl9yYXN0KSArCiAgdG1fcmFzdGVyKHRpdGxlID0gIk5EVkkiLAogICAgICAgICAgICAgc3R5bGU9ImNvbnQiLAogICAgICAgICAgICApICsKICB0bV9sZWdlbmQob3V0c2lkZSA9IFRSVUUpCgpORFZJX3NmX21hcApgYGAKClwKCiMjIENsYXNzaWZ5CgpTbyBuZWdhdGl2ZSB2YWx1ZXMgb2YgTkRWSSByZXByZXNlbnQgd2F0ZXIuIExldCdzIHNldCBhbGwgbmVnYXRpdmUgdmFsdWVzIHRvIC0xLCBhbmQgdGhhdCB3aWxsIGhlbHAgdXMgdG8gZGlzdGluZ3Vpc2ggd2F0ZXIgZnJvbSBsYW5kIGVhc2llci4KCmBgYHtyfQpzZl9yYXN0X25lZyA8LSBhcHAoc2ZfcmFzdCwgZnVuPWZ1bmN0aW9uKHgpeyB4W3ggPD0gMF0gPC0gLTE7IHJldHVybih4KX0gKQoKTkRWSV9zZl9tYXBfbmVnID0gdG1fc2hhcGUoc2ZfcmFzdF9uZWcpICsKICB0bV9yYXN0ZXIodGl0bGUgPSAiTkRWSSIsCiAgICAgICAgICAgICBzdHlsZT0iY29udCIsCiAgICAgICAgICAgICkgKwogIHRtX2xlZ2VuZChvdXRzaWRlID0gVFJVRSkKCk5EVklfc2ZfbWFwX25lZwpgYGAKClwKCk5pY2UuIFdoYXQgZG8gd2Ugbm90aWNlPyBUaGUgY29hc3Qgb2YgU2FuIEZyYW5jaXNjbyBtaWdodCBoYXZlIHNvbWUgY2xvdWQgY292ZXIgZXJyb3JzISBTYXRlbGxpdGUgZGF0YSBpc24ndCBwZXJmZWN0ISBCdXQgdGhlIGdvb2QgbmV3cyBpcywgd2UndmUgbGVhcm5lZCBob3cgdG8gYnJpbmcgaW4gcmFzdGVyIGRhdGEhIEkgdGhpbmsgd2UgbmVlZCBhIGJhZGdlISEhIQoKXAoKIVt0ZXJyYSBCYWRnZV0odGVycmEucG5nKQoKXAoKT25lIGxhc3Qgc3RlcC4gTGV0J3MgcHV0IGFsbCBvdXIga25vd2xlZGdlIHRvZ2V0aGVyIGFuZCBtYXAgb3VyIG9sZCBmcmllbmQgQ0FkYXRhIG9uIHRvcCBvZiB0aGUgTkRWSSBkYXRhIGluIFNhbiBGcmFuY2lzY28uIEZpcnN0LCBsZXQncyBicmluZyBpbiB0aGUgQ0FkYXRhIGRhdGFzZXQgb24gb3ZhcmlhbiBjYW5jZXIgY2FzZXMgYWdhaW4uIAoKYGBge3J9CgpkYXRhKENBZGF0YSkKY2FfcHRzIDwtIENBZGF0YQpjYV9wcm9qIDwtICIrcHJvaj1sY2MgK2xhdF8xPTQwICtsYXRfMj00MS42NjY2NjY2NjY2NjY2NiAKICAgICAgICAgICAgICtsYXRfMD0zOS4zMzMzMzMzMzMzMzMzNCArbG9uXzA9LTEyMiAreF8wPTIwMDAwMDAgCiAgICAgICAgICAgICAreV8wPTUwMDAwMC4wMDAwMDAwMDAyICtlbGxwcz1HUlM4MCAKICAgICAgICAgICAgICtkYXR1bT1OQUQ4MyArdW5pdHM9bSArbm9fZGVmcyIKCmNhX3B0cyA8LSBzdF9hc19zZihDQWRhdGEsIGNvb3Jkcz1jKCJYIiwiWSIpLCBjcnM9Y2FfcHJvaikKYGBgCgpcCgpMZXQncyBjaGVjayB0aGUgQ1JTIGFuZCBjb21wYXJlIGl0IHRvIG91ciBORFZJIGRhdGFzZXQuCgpgYGB7cn0Kc3RfY3JzKGNhX3B0cykKc3RfY3JzKHNmX3Jhc3RfbmVnKQpgYGAKClwKCkhtbW0sIGxldCdzIG1ha2Ugc3VyZSB0aGV5IGFyZSB0aGUgc2FtZSBwcm9qZWN0aW9uLgoKYGBge3J9CmNhX3B0c19wcm9qPC1zdF90cmFuc2Zvcm0oY2FfcHRzLHN0X2NycyhzZl9yYXN0X25lZykpCnN0X2NycyhjYV9wdHNfcHJvaikKYGBgCgpcCgpUaGV5IHNob3VsZCBiZSBnb29kIHRvIGdvIG5vdy4gTGV0J3MgbWFwIHRoZXNlIGFkZHJlc3NlcyBvbiB0b3Agb2YgdGhlIHJhc3RlciBkYXRhIQoKYGBge3J9CnRtYXBfbW9kZSgicGxvdCIpCk5EVklfY2FuY2VyX21hcCA9IHRtX3NoYXBlKHNmX3Jhc3RfbmVnKSArCiAgdG1fcmFzdGVyKHN0eWxlID0gImNvbnQiLCB0aXRsZSA9ICJORFZJIikgKwogIHRtX2xlZ2VuZChvdXRzaWRlID0gVFJVRSkgKwogIHRtX3NoYXBlKGNhX3B0c19wcm9qKSArIAogIHRtX2RvdHMoc2l6ZT0wLjMsIGFscGhhPTAuNSwgY29sID0gImJsdWUiKQpORFZJX2NhbmNlcl9tYXAKYGBgCgpcCgpUaGF0IGlzIG9uZSBmaW5lIGxvb2tpbmcgbWFwLgoKXAoKIyBJbnN0YWxsIHBhY2thZ2VzCgpGaXJzdCwgbGV0J3MgaW5zdGFsbCBvdXIgcGFja2FnZXMuCmBgYHtyfQpsaWJyYXJ5KHNmKQpsaWJyYXJ5KE1hcEdBTSkKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkoZmxleHRhYmxlKQpsaWJyYXJ5KFJDb2xvckJyZXdlcikKbGlicmFyeSh0bWFwKQpsaWJyYXJ5KHRlcnJhKQpgYGAKClwKCiMgQnJpbmcgaW4gQ2FuY2VyIGRhdGFzZXQKCldlIHdpbGwgYmUgdXNpbmcgZGF0YSBpbmNsdWRlZCBpbiB0aGUgKipNYXBHQU0qKiBbcGFja2FnZV0oaHR0cHM6Ly9jcmFuLnItcHJvamVjdC5vcmcvd2ViL3BhY2thZ2VzL01hcEdBTS9NYXBHQU0ucGRmKS4gQXMgYSByZW1pbmRlcjogV2hpbGUgdGhleSBhcmUgYmFzZWQgb24gcmVhbCBwYXR0ZXJucyBleHBlY3RlZCBpbiBvYnNlcnZhdGlvbmFsIGVwaWRlbWlvbG9naWMgc3R1ZGllcywgdGhlc2UgZGF0YSBoYXZlIGJlZW4gc2ltdWxhdGVkIGFuZCBhcmUgZm9yIHRlYWNoaW5nIHB1cnBvc2VzIG9ubHkuIFRoZSBkYXRhIGNvbnRhaW4gNTAwMCBzaW11bGF0ZWQgb3ZhcmlhbiBjYW5jZXIgY2FzZXMuIFdoaWxlIHRoaXMgaXMgYSBjb2hvcnQgd2l0aCB0aW1lIHRvIG1vcnRhbGl0eSwgZm9yIHRoZSBwdXJwb3NlcyBvZiBvdXIgY2xhc3MsIHdlIHdpbGwgY29uZHVjdCBzaW1wbGUgdGFidWxhciBhbmFseXNlcyBsb29raW5nIGF0IGFzc29jaWF0aW9ucyBiZXR3ZWVuIGRpZmZlcmVudCBzcGF0aWFsIGV4cG9zdXJlcyB3aXRoIG1vcnRhbGl0eSBhdCBlbmQgb2YgZm9sbG93LXVwLiAKCkFzIGFub3RoZXIgcmVtaW5kZXIsIHRoZSAqQ0FkYXRhKiBkYXRhc2V0IGNvbnRhaW5zIHRoZSBmb2xsb3dpbmcgdmFyaWFibGVzOgoKKiB0aW1lIChmb2xsb3ctdXAgdGltZSkKKiBldmVudCAoMT1kZWFkLCAwPWNlbnNvcmVkKQoqIFggKExhdGl0dWRlKQoqIFkgKExvbmdpdHVkZSkKKiBBR0UgKGFnZSBpbiB5ZWFycykKKiBJTlMgKGluc3VyYW5jZSBzdGF0dXMsIGNhdGVnb3JpY2FsKQoKXAoKIyMgUmVhZCBpbiBDYW5jZXIgRGF0YXNldAoKTmV4dCwgd2Ugd2FudCB0byByZWFkIGluIGFsbCBvZiBvdXIgc3BhdGlhbCBkYXRhLiBGaXJzdCwgd2UgcmVhZCBpbiB0aGUgKkNBZGF0YSogZGF0YXNldCBmcm9tIHRoZSAqKk1hcEdBTSoqIHBhY2thZ2UsIGFuZCB0aGVuIGNvbnZlcnQgaXQgdG8gYSBzcGF0aWFsIGRhdGFzZXQuIAoKYGBge3J9CmRhdGEoQ0FkYXRhKQpjYV9wdHMgPC0gQ0FkYXRhCmNhX3Byb2ogPC0gIitwcm9qPWxjYyArbGF0XzE9NDAgK2xhdF8yPTQxLjY2NjY2NjY2NjY2NjY2IAogICAgICAgICAgICAgK2xhdF8wPTM5LjMzMzMzMzMzMzMzMzM0ICtsb25fMD0tMTIyICt4XzA9MjAwMDAwMCAKICAgICAgICAgICAgICt5XzA9NTAwMDAwLjAwMDAwMDAwMDIgK2VsbHBzPUdSUzgwIAogICAgICAgICAgICAgK2RhdHVtPU5BRDgzICt1bml0cz1tICtub19kZWZzIgoKY2FfcHRzIDwtIHN0X2FzX3NmKENBZGF0YSwgY29vcmRzPWMoIlgiLCJZIiksIGNycz1jYV9wcm9qKQpgYGAKClwKCiMjIFJlYWQgaW4gR3JlZW5zcGFjZSBEYXRhCgpXZSB0aGVuIHJlYWQgaW4gdGhlIHJhc3RlciBmb3IgZ3JlZW5zcGFjZSBkYXRhIGFjcm9zcyB0aGUgQmF5IEFyZWEuIEZpbmFsbHksIHdlIGNoZWNrIHRoZSBmaWxlIHRvIG1ha2Ugc3VyZSBpdCB3YXMgcmVhZCBjb3JyZWN0bHkuIERvZXMgaXQgaGF2ZSBhIGNvb3JkaW5hdGUgcmVmZXJlbmNlIHN5c3RlbT8KCgpgYGB7cn0KdXJsIDwtICJodHRwczovL2dpdGh1Yi5jb20vcGphbWVzLXVjZGF2aXMvU1BIMjE1L3Jhdy9tYWluL05EVklfcmFzdDIudGlmIgpkb3dubG9hZC5maWxlKHVybCwgZGVzdGZpbGUgPSAiTkRWSV9yYXN0Mi50aWYiLCBtb2RlID0gIndiIikKbmR2aV9yYXN0ID0gcmFzdCgiTkRWSV9yYXN0Mi50aWYiKQoKbmR2aV9yYXN0CmBgYAoKXAoKIyBDaGVjayBQcm9qZWN0aW9ucyBmb3IgYWxsIFNwYXRpYWwgRGF0YQoKRmluYWxseSwgd2UgY2hlY2sgdGhlIHByb2plY3Rpb25zLiAqKlRoaXMgaXMgdGhlIG1vc3QgaW1wb3J0YW50IHN0ZXAgYW5kIGlzIGd1YXJhbnRlZWQgdG8gbWFrZSBsaWZlIGVhc2llciB3aXRoIHlvdXIgZ2Vvc3BhdGlhbCBhbmFseXNpcyEqKiBXaGVuIHlvdSBoYXZlIGZpbGVzIGluIGRpZmZlcmVudCBwcm9qZWN0aW9ucywgdGhpcyBjYW4gYmUgYSBtYWpvciBwcm9ibGVtIGJlY2F1c2Ugd2hlbiB3ZSB0cnkgdG8gb3ZlcmxheSB0aGUgdHdvIGZpbGVzIHRoZXkgbWF5IG5vdCBvdmVybGFwLiBGaXJzdCB3ZSBjaGVjayB0aGUgY29vcmRpbmF0ZSByZWZlcmVuY2Ugc3lzdGVtcyBmb3IgZWFjaCBkYXRhc2V0IHVzaW5nIGBzdF9jcnMoKWAuIFdlIHRoZW4gdXNlIHRoZSBgc3RfdHJhbnNmb3JtKClgIGZ1bmN0aW9uIHRvIGNvbnZlcnQgdGhlIHByb2plY3Rpb24gZm9yIG91ciBwb2ludCBkYXRhIHRvIG1hdGNoIHRoYXQgb2Ygb3VyIHBvbHlnb24gZGF0YS4gV2hlbiB3ZSBhcmUgZG9uZSwgZG8gdGhlIHByb2plY3Rpb25zIG9mIHRoZSB0d28gZGF0YXNldHMgbWF0Y2g/CgoKYGBge3J9CiMjIExvb2sgYXQgdGhlIGNvb3JkaW5hdGUgcmVmZXJlbmNlIHN5c3RlbSBmb3IgdGhlIGNhbmNlciBkYXRhLCBhbmQgZm9yIGdyZWVuc3BhY2UgZGF0YQpzdF9jcnMoY2FfcHRzKQpzdF9jcnMobmR2aV9yYXN0KQoKIyMgVHJhbnNmb3JtIHRoZSBjb29yZGluYXRlIHJlZmVyZW5jZSBzeXN0ZW0gb2YgdGhlIGNhbmNlciBkYXRhIHRvIG1hdGNoIHRoYXQgCiMjIG9mIHRoZSBncmVlbnNwYWNlICBkYXRhCmNhX3RyYW5zZm9ybWVkIDwtc3RfdHJhbnNmb3JtKGNhX3B0cywgc3RfY3JzKG5kdmlfcmFzdCkpICAKCiMjIENoZWNrIHByb2plY3Rpb25zCnN0X2NycyhuZHZpX3Jhc3QpPT1zdF9jcnMoY2FfdHJhbnNmb3JtZWQpCmBgYAoKXAoKIyBNYXAgVGhlIERhdGEKCk5vdywgd2Ugd2lsbCB2aXN1YWxpemUgb3VyIHNwYXRpYWwgZGF0YSB1c2luZyAqKnRtYXAqKi4gV2Ugd2lsbCBvdmVybGF5IHRoZSBncmVlbnNwYWNlIG1hcHMgd2l0aCB0aGUgb3ZhcmlhbiBjYW5jZXIgZGF0YS4gRG8gYW55IHBhdHRlcm5zIGp1bXAgb3V0LCBvciBhcmUgdGhlcmUgYW55IHBhcnRpY2lwYW50cyBsaXZpbmcgaW4gdGhlIG1pZGRsZSBvZiB0aGUgQmF5PwoKYGBge3J9CmNhLm5kdmkubWFwIDwtIHRtX3NoYXBlKG5kdmlfcmFzdCkgKwogIHRtX3Jhc3RlcihzdHlsZSA9ICJjb250IikgKwogICAgICB0bV9zaGFwZShjYV90cmFuc2Zvcm1lZCkgKwogICAgICAgIHRtX2RvdHMoc2l6ZT0wLjI1LCBhbHBoYT0wLjgsIGNvbD0iYmx1ZSIpCmNhLm5kdmkubWFwCmBgYAoKXAoKV2UgZmluZCB0aGF0IHRoZSBtb3N0IGxlYXN0IGdyZWVuIGFyZWFzIGFyZSBpbiB0aGUgZG93bnRvd24gYXJlYXMgb2YgU2FuIEZyYW5jaXNjbyBhbmQgT2FrbGFuZCwgd2hpY2ggbWFrZXMgc2Vuc2UuIE91ciBjYW5jZXIgY29ob3J0IGRhdGEgb3ZlcmxhcHMgd2l0aCB0aGUgZ3JlZW5zcGFjZSBtYXAsIHdoaWNoIGlzIHJlYXNzdXJpbmcuIAoKXAoKIyBFeHRyYWN0IFJhc3RlciBWYWx1ZXMgdG8gUG9pbnRzCgpOb3cgdGhhdCB3ZSBoYXZlIHZpc3VhbGl6ZWQgb3VyIGRhdGEsIGxldCdzIHNlZSBpZiB0aGVyZSBpcyBhbiBhc3NvY2lhdGlvbiBiZXR3ZWVuIGdyZWVuc3BhY2UgZXhwb3N1cmUgYW5kIG1vcnRhbGl0eSBhbW9uZyBvdmFyaWFuIGNhbmNlciBjYXNlcy4gV2Ugd2lsbCBmaXJzdCBleHRyYWN0IHRoZSB2YWx1ZXMgZm9yIGdyZWVuc3BhY2UgdG8gdGhlIGNhbmNlciBkYXRhc2V0IChtZXJnZSB0aGUgdHdvIGRhdGFzZXRzIGJhc2VkIG9uIGxvY2F0aW9uIG9mIGNhc2VzIGFuZCB0aGUgZ3JlZW5zcGFjZSBwaXhlbCB0aGF0IHRoZXkgYXJlIGluKSB1c2luZyBgdGVycmE6OmV4dHJhY3RgLiBUaGVuIHdlIHdpbGwgY2hlY2sgdGhlIGRpc3RyaWJ1dGlvbiBvZiBncmVlbnNwYWNlIGV4cG9zdXJlIGluIG91ciBjYW5jZXIgY2FzZXMuIFdlIHdpbGwgdXNlIGEgdHdvLXNpZGVkIGNoaS1zcXVhcmVkIHRlc3QgdG8gdGVzdCBvdXIgaHlwb3RoZXNpcyBvZiB0aGUgYXNzb2NpYXRpb24gYmV0d2VlbiBncmVlbnNwYWNlIGV4cG9zdXJlIGFuZCBtb3J0YWxpdHkgYW1vbmcgb3ZhcmlhbiBjYW5jZXIgY2FzZXMuIFdoYXQgZG8gd2UgZmluZD8KCmBgYHtyfQojIyBTcGF0aWFsbHkgam9pbiB0aGUgY2FuY2VyIHBvaW50IGRhdGEgdG8gdGhlIHdhbGthYmlsaXR5IHBvbHlnb24gZGF0YQpuZHZpX2NhbmNlciA9IGRhdGEuZnJhbWUoY2FfdHJhbnNmb3JtZWQsdGVycmE6OmV4dHJhY3QobmR2aV9yYXN0LCBjYV90cmFuc2Zvcm1lZCkpCmdsaW1wc2UobmR2aV9jYW5jZXIpIAojIyBUYWtlIGEgbG9vayBhdCBhIHN1bW1hcnkgb2YgdGhlIHZhbHVlcwpzdW1tYXJ5KG5kdmlfY2FuY2VyJE5EVklfQmF5QXJlYSkKYGBgCgpcCgpMb29rcyBsaWtlIHdlIGhhdmUgbG90cyBvZiBOQSB2YWx1ZXMuIFRoYXQgaXMgYmVjYXVzZSBzb21lIG9mIG91ciBwYXJ0aWNpcGFudHMgbGl2ZSBvdXRzaWRlIG9mIHRoZSBhcmVhIG9mIG91ciBncmVlbnNwYWNlIGRhdGEuIExldCdzIGRyb3AgdGhvc2UgbWlzc2luZyB2YWx1ZXMgdXNpbmcgYGRyb3BfbmEoKWAsIHdoaWNoIGlzIHNsaWdodGx5IGRpZmZlcmVudCBmcm9tIGhvdyB3ZSd2ZSBkb25lIHRoaXMgYmVmb3JlLgoKYGBge3J9Cm5kdmlfY2FuY2VyX25vbWlzcyA8LSBuZHZpX2NhbmNlciAlPiUgZHJvcF9uYShORFZJX0JheUFyZWEpIAoKIyMgVGFrZSBhIGxvb2sgYXQgYSBzdW1tYXJ5IG9mIHRoZSB2YWx1ZXMKc3VtbWFyeShuZHZpX2NhbmNlcl9ub21pc3MkTkRWSV9CYXlBcmVhKQpnbGltcHNlKG5kdmlfY2FuY2VyX25vbWlzcykKYGBgCgpcCgojIEFuYWx5emUgb3VyIEpvaW5lZCBEYXRhc2V0Ck9LLCB3ZSBoYXZlIGEgZGF0YXNldCB3aXRoIG5vIG1pc3NpbmduZXNzLiBDYW4gd2UgbG9vayBhdCB0aGUgZGlzdHJpYnV0aW9uIG9mIGdyZWVuc3BhY2UgZXhwb3N1cmUgYW1vbmcgcGFydGljaXBhbnRzPwpgYGB7cn0KbmR2aV9jYW5jZXJfbm9taXNzICU+JQogIGdncGxvdCgpICsgCiAgZ2VvbV9oaXN0b2dyYW0obWFwcGluZyA9IGFlcyh4PU5EVklfQmF5QXJlYSkpIAoKYGBgCgpcCgpGb3IgdGhlIHB1cnBvc2VzIG9mIG91ciBhbmFseXNpcywgbGV0J3MgZGl2aWRlIHVwIG91ciBncmVlbnNwYWNlIGRhdGEgaW50byBxdWFydGlsZXMuIFdlIHdpbGwgZG8gdGhpcyB1c2luZyB0aGUgYG11dGF0ZSgpYCBmdW5jdGlvbiBjb21iaW5lZCB3aXRoIHRoZSBgbnRpbGUoKWAgZnVuY3Rpb24uIFRoZW4gd2Ugd2lsbCB0YWtlIGEgZ2xpbXBzZSBhdCBvdXIgbmV3IGRhdGFzZXQuCgpgYGB7cn0KbmR2aV9jYW5jZXJfbm9taXNzIDwtIG5kdmlfY2FuY2VyX25vbWlzcyAlPiUKICBtdXRhdGUobmR2aV9xdWFydGlsZSA9IG50aWxlKE5EVklfQmF5QXJlYSwgNCkpCgpnbGltcHNlKG5kdmlfY2FuY2VyX25vbWlzcykKYGBgCgpcCgpPSyB0aGF0IGxvb2tzIGdvb2QuIFdlIGhhdmUgY3JlYXRlZCBhIG5ldyB2YXJpYWJsZSAqbmR2aV9xdWFydGlsZSogdGhhdCB0ZWxscyB1cyB3aGF0IHF1YXJ0aWxlIG9mIGdyZWVuc3BhY2UgYSBwYXJ0aWNpcGFudCBsaXZlcyBpbi4gTGV0J3MgZG8gYSB0d28gYnkgdHdvIHRhYmxlIG9mIGdyZWVuc3BhY2UgcXVhcnRpbGVzIGJ5ICpldmVudCosIHdoaWNoIGlzIHdoZXRoZXIgYSBwYXJ0aWNpcGFudCBkaWVkIG92ZXIgZm9sbG93dXAuCmBgYHtyfQojIyBDcmVhdGUgYSBjb250aW5nZW5jeSB0YWJsZSBvZiBldmVudCBieSB3YWxrX3F1YXJ0aWxlCnRhYiA8LSB0YWJsZShuZHZpX2NhbmNlcl9ub21pc3MkbmR2aV9xdWFydGlsZSwgbmR2aV9jYW5jZXJfbm9taXNzJGV2ZW50KQp0YWIKYGBgCgpcCgpIbW1tLCB0aGF0J3MgaW50ZXJlc3RpbmcsIGJ1dCBsZXQncyBsb29rIGF0IHRoaXMgYnkgcGVyY2VudGFnZXMgaW5zdGVhZC4KYGBge3J9CiMjIENvbnZlcnQgdG8gcGVyY2VudGFnZXMgYnkgY29sdW1uCnRhYl9jb2xfcGVyYyA8LSBwcm9wLnRhYmxlKHRhYiwgbWFyZ2luID0gMikgKiAxMDAKcm91bmQodGFiX2NvbF9wZXJjLCAxKQpgYGAKClwKCkRvIHlvdSB0aGluayB0aGUgcGVyY2VudGFnZXMgYXJlIGRpZmZlcmVudCBieSBxdWFydGlsZSBvZiBncmVlbnNwYWNlPyBXZSBjYW4gcnVuIGEgY2hpLXNxdWFyZWQgdGVzdCB0byBiZSBzdXJlLiBUaGlzIGlzIGEgc3RhdGlzdGljYWwgdGVzdCB0byBzZWUgd2hldGhlciB0aGVyZSBpcyBhIGRpZmZlcmVuY2UgaW4gdGhlIHByb2JhYmlsaXR5IG9mICpldmVudCosIG9yIHdoZXRoZXIgYSBwYXJ0aWNpcGFudCBkaWVkIG92ZXIgZm9sbG93LXVwLCBieSB0aGUgcXVhcnRpbGVzIG9mIGdyZWVuc3BhY2UgV2UgZG8gdGhpcyB3aXRoIHRoZSBgY2hpc3EudGVzdCgpYCBmdW5jdGlvbi4KYGBge3J9CiMjIENoaS1zcXVhcmVkIHRlc3QKY2hpc3EudGVzdCh0YWIpCmBgYAoKXAoKT0ssIGhvdyBkbyB3ZSBpbnRlcnByZXQgdGhpcz8gT3VyIG51bGwgaHlwb3RoZXNpcyBpcyB0aGF0IHRoZXJlIGlzIG5vIGFzc29jaWF0aW9uIGJldHdlZW4gbW9ydGFsaXR5IGF0IGVuZCBvZiBmb2xsb3ctdXAgYW5kIGluY3JlYXNpbmcgcXVhcnRpbGUgb2YgZ3JlZW5zcGFjZS4gT3VyIGFsdGVybmF0aXZlIGh5cG90aGVzaXMgaXMgdGhhdCB0aGVyZSBpcyBhbiBhc3NvY2lhdGlvbiBiZXR3ZWVuIG1vcnRhbGl0eSBhdCBlbmQgb2YgZm9sbG93LXVwIGFuZCBpbmNyZWFzaW5nIHF1YXJ0aWxlIG9mIGdyZWVuc3BhY2UuIFdlIHVzZSBhIHR3by1zaWRlZCBjaGktc3F1YXJlZCB0ZXN0IHdpdGggYWxwaGE9MC4wNS4gQXNzdW1pbmcgbm8gc291cmNlcyBvZiBiaWFzIGFuZCB0aGF0IHRoZSBudWxsIGh5cG90aGVzaXMgaXMgdHJ1ZSwgdGhlIHByb2JhYmlsaXR5IG9mIG9ic2VydmluZyBpbmNyZWFzZXMgaW4gbW9ydGFsaXR5IGF0IGVuZCBvZiBmb2xsb3ctdXAgd2l0aCBpbmNyZWFzaW5nIHF1YXJ0aWxlcyBvZiBncmVlbnNwYWNlIGFzIG9yIG1vcmUgZXh0cmVtZSBhcyB0aG9zZSBwcm9kdWNlZCBpbiB0aGVzZSBkYXRhIGlzIDAuNzE2LiBTaW5jZSBwPjAuMDUsIHdlIGZhaWwgdG8gcmVqZWN0IHRoZSBudWxsIGh5cG90aGVzaXMgYW5kIGNvbmNsdWRlIHRoYXQgZ3JlZW5zcGFjZSBpcyBub3QgYXNzb2NpYXRlZCB3aXRoIG1vcnRhbGl0eSBhdCBlbmQgb2YgZm9sbG93LXVwICh1bmRlciB0aGUgYXNzdW1wdGlvbnMgc3RhdGVkIGFib3ZlKS4gSW4gb3RoZXIgd29yZHMsIHdlIGRvbid0IHNlZSBhIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIGdyZWVuc3BhY2UgZXhwb3N1cmUgYW5kIG91ciBvdXRjb21lIChkeWluZyBvdmVyIGZvbGxvd3VwKS4K