Population density within polygons

Question

So, I have some questions regarding the raster package in R. I have a raster with estimated population in each grid point. I also have a shapefile with polygons of regions. I want to find out the coordinates of the neighborhood with the highest population density within each regions. Supose that each neighborhood is a homogeneous square of 5 by 5 grid points.

The following toy example mimics my problem.

library(raster)
library(maptools)

set.seed(123)

data(wrld_simpl)

wrld_simpl <- st_as_sf(wrld_simpl)
contr_c_am <- wrld_simpl %>%
  filter(SUBREGION ==13) %>%
  filter(FIPS != "MX") %>%
  select(NAME) 


# Create a raster of population (sorry for the bad example spatial distribution)
r <- raster(xmn=-180, xmx=180, ymn=-90, ymx=90, res=0.1)
values(r) <- runif(ncell(r), 0, 100)

# keep only raster around the region of interest
r_small <- crop(r, extent(contr_c_am))
plot(r_small)
plot(st_geometry(contr_c_am), add = T)

raster_contr_c_am <- rasterize(contr_c_am, r)

raster_contr_c_am is the population grid and the name of the region is saved as an attribute.

Somehow I need to filter only grid points from one region, and probably use some funcion like focal() to find total nearby population.

focal(raster_contr_c_am, matrix(1,5,5),sum, pad = T, padValue = 0)

Then, I need to find which grid point has the highest value within each region, and save it's coordinates.

I hope my explanation is not too confusing,

Thanks for any help!

Answer 1

Here's an example that iterates over the shape defining the region, then uses the raster values within the region and the focal() function to find the maximum.

library(raster)
library(maptools)
library(sf)
library(dplyr)

set.seed(123)

data(wrld_simpl)

wrld_simpl <- st_as_sf(wrld_simpl)
contr_c_am <- wrld_simpl %>%
    filter(SUBREGION ==13) %>%
    filter(FIPS != "MX") %>%
    select(NAME) 

# Create a raster of population (sorry for the bad example spatial distribution)
r <- raster(xmn=-180, xmx=180, ymn=-90, ymx=90, res=0.1)
values(r) <- runif(ncell(r), 0, 100)

# keep only raster around the region of interest
r_small <- crop(r, extent(contr_c_am))
raster_contr_c_am <- rasterize(contr_c_am, r_small)

# function to find the max raster value using focal
# in a region 
findMax <- function(region, raster) {
    tt <- trim((mask(raster, region))) # focus on the region
    ff <- focal(tt, w=matrix(1/25,nc=5,nr=5))
    maximumCell <- which.max(ff) # find the maximum cell id
    maximumvalue <- maxValue(ff) # find the maximum value
    maximumx <- xFromCell(ff, maximumCell) # get the coordinates
    maximumy <- yFromCell(ff, maximumCell)
    # return a data frame
    df <- data.frame(maximumx, maximumy, maximumvalue)
    df
}

numberOfShapes <- nrow(contr_c_am)
ll <- lapply(1:numberOfShapes, function(s) findMax(region = contr_c_am[s,], raster = r_small))
merged <- do.call(rbind, ll)
maxpoints <- st_as_sf(merged, coords=c('maximumx', 'maximumy'), crs=crs(contr_c_am))

library(mapview) # optional but nice visualization - select layers to see if things look right
mapview(maxpoints) + mapview(r_small) + mapview(contr_c_am)

I've made an sf object so that it can be plotted with the other spatial objects. Using the mapview package, I get this.