如何计算地图上半径范围内的度量平均值

Question

I am working on a problem that uses data that resembles the following snippet:

name = c('A', 'B', 'C', 'D', 'E','F','G','H','I','J')
lat = runif(10,min=37,max=39)
lon = runif(10,min=-91,max=-89)
metric = runif(10,min=0,250)

df = as.data.frame(cbind(name,lat,lon,metric))

I want to be able to choose a radius of X kilometers, let's say 15 for this example, and use that radius to first count the # of observations that fall within the range for each row of my data where each row gets a turn as the center of the radius. Then, I want to take an average of the metric for all the observations within the radius.

Ideally, the final dataset would look something like this:

name lat  lon    metric count avg_metric
A    37.1 -91.1  44     6     34.33    
B    37.2 -90.2  24     3     23.35 
C    37.3 -90.3  37     2     19.93

These numbers are made up, but something that looks like this is what I'm aiming for.

I found some code that kind of did what I was looking for below:

library(spatialrisk)

# Stores 
stores <- data.frame(store_id = 1:3,
                     lat = c(40.7505, 40.7502, 40.6045),
                     long = c(-73.8456, -73.8453, -73.8012))

# My location
me <- data.frame(lat = 40.7504, long = -73.8456)
spatialrisk::points_in_circle(stores, me$long[1], me$lat[1], radius = 100, lon = long)

However, this isn't exactly what I'm looking for. Can someone help point me in the right direction? Any help would be appreciated! Thank you!

Answer 1

Here's an example using the sf library. I converted to a coordinate system that understands metres and then used st_buffer to make circles, st_within to work out the overlaps and then sapply to calculate the count and average metric.

library(sf)
library(dplyr)

name <- c('A', 'B', 'C', 'D', 'E','F','G','H','I','J')
lat <- runif(10,min=37,max=39)
lon <- runif(10,min=-91,max=-89)
metric <- runif(10,min=0,250)

df <- as.data.frame(cbind(name,lat,lon,metric))

# make a spatial data frame
df_sf <- st_as_sf(df, coords = c('lon', 'lat'), crs=4326)

# transform to a coordinate system which understands metres 
# the original data is near St Louis, so UTM 15 is appropriate
df_sf_transformed <- st_transform(df_sf, crs = 32615)

# make circles of radius 15km around each point
df_sf_buffers <- st_buffer(df_sf_transformed, dist = 15000) %>% st_geometry()

# work out which point is within each circle
overlaps <- st_within(y = df_sf_buffers, x = df_sf_transformed)

# count the number of overlaps for each circle
# the sapply function is like a for loop that iterates over each 
# row in the overlaps object and calls the length function to 
# calculate the length of each row
counts <- data.frame(count = sapply(overlaps, length))

# a custom function to sum the metrics for selected points
find_avg_metric <- function(sf_df, indices) {
    entries <- sf_df[indices, ]
    result <- sum(as.numeric(entries$metric))
    result
}

# iterate over the overlaps object and use the indices found to access 
# the relevant rows of the original data frame to sum up the metric column
metrics <- data.frame(avg_metric = sapply(overlaps, function(index) find_avg_metric(df_sf_transformed, index)))

# The final answer
final_result <- df %>% bind_cols(counts) %>% bind_cols(metrics)
final_result
#name              lat               lon           metric count avg_metric
#1     A 37.9383664987981  -90.567177023273 30.6012906949036     1   30.60129
#2     B 37.8796539758332 -89.6363721224479 139.638845692389     1  139.63885
#3     C 37.9519012323581 -90.8471902268939 106.271727592684     1  106.27173
#4     D 38.3774091359228 -89.1159357768483 186.965031607542     1  186.96503
#5     E 37.3993454128504 -89.7444549454376 29.5921949436888     2  194.88581
#6     F 38.6436389596201 -89.0847784169018 150.506012840196     1  150.50601
#7     G 38.4185414239764 -90.1974869910628 162.634110951331     1  162.63411
#8     H 38.2770276684314 -90.4734013564885 69.9945208616555     1   69.99452
#9     I 37.3666391288862 -89.6443270738237 165.293618629221     2  194.88581
#10    J  38.659956720192 -89.7836953452788 123.549888376147     1  123.54989