R 根据时间窗口计算多边形内的空间点概述_R_Gis_Temporal

R 根据时间窗口计算多边形内的空间点概述

r gis

R 根据时间窗口计算多边形内的空间点概述,r,gis,temporal,R,Gis,Temporal,使用R，我想根据特定的标准（时间窗口）计算多边形内的点数我有以下数据：地理位置调查数据，包括调查访谈日期。因此，我能够准确地指出每项调查是在何时何地进行的，并将其绘制在美国各地美国各地政治集会的地理定位数据。这些还包括日期使用QGIS，我在每个调查对象周围创建了一组50英里的圆形缓冲区。我的目标是统计在采访前的特定时间范围内每个受访者的“缓冲区”内的政治集会数量。QGIS中创建的50英里缓冲区保留了原始数据的所有变量，包括访谈日期资料使用QGIS，我创建了一些带有日期和位置的文件，以

使用R，我想根据特定的标准（时间窗口）计算多边形内的点数

我有以下数据：

地理位置调查数据，包括调查访谈日期。因此，我能够准确地指出每项调查是在何时何地进行的，并将其绘制在美国各地

美国各地政治集会的地理定位数据。这些还包括日期

使用QGIS，我在每个调查对象周围创建了一组50英里的圆形缓冲区。我的目标是统计在采访前的特定时间范围内每个受访者的“缓冲区”内的政治集会数量。QGIS中创建的50英里缓冲区保留了原始数据的所有变量，包括访谈日期

资料使用QGIS，我创建了一些带有日期和位置的文件，以帮助复制

方法我试图使用

GISTools:：poly.counts

计算不同时间窗口（30天、90天等）内的反弹次数

通常，要计算多边形内的点数，我只需使用：

count <- GISTools::poly.counts(rallies, buffer)

我得到以下错误：

Error in `[.data.frame`(x@data, i, j, ..., drop = FALSE) : 
  undefined columns selected
In addition: Warning messages:
1: In unclass(time1) - unclass(time2) :
  longer object length is not a multiple of shorter object length
2: In unclass(time1) - unclass(time2) :
  longer object length is not a multiple of shorter object length

实现这一点的正确方法是什么？

我使用

sf

包而不是

GISTools

以不同的方式处理您的问题。该算法非常简单，您可以轻松地将其应用于

GISTools:：poly.counts（）

方法：

读入形状文件（

st\u Read（）

）

使用

dplyr

按日期筛选形状文件（确保您有日期对象来创建窗口）

找到任意点数据与拉力缓冲区的交点（

st\u intersection（）

）

获取交叉点对象的大小（

nrow（）

）

您可能必须调整函数参数，以确保它对真实数据正确工作。下面是一个使用模拟数据的示例

设置并读取数据（注意

stringsAsFactors=F

只会使日期更容易创建；对于R版本4.x来说不是必需的）

require（tidyverse）
require（magritter）#添加%%运算符
要求（sf）
要求（润滑）
rally另一个答案是使用sf
，但这次使用空间连接和dplyr进行过滤等
library(tidyverse)
library(sf)


rallies <- read_sf('Downloads/stack_ex_q/rallies.shp')
# Here I don't use the supplied buffer, but make one according to the data
#fifty_buff <- read_sf('Downloads/stack_ex_q/rallies.shp') 
surveys <- read_sf('Downloads/stack_ex_q/surveys.shp')


# Transform to a crs using meters as a distance & make date col a proper date
rallies <- st_transform(rallies, crs = 2163) %>% 
  mutate(date = as.Date(date))
surveys <- st_transform(surveys, crs = 2163) %>%
  mutate(date = as.Date(date))

# make a buffer w/ 50 mile radius (80467 meters), not used but useful for visualization
buffer_50mi <- st_buffer(surveys, dist = 80467)


使用距离内的st_is_连接数据，使用80467m=50英里
joined <- surveys %>%
  st_join(rallies, join = st_is_within_distance, 80467)

head(joined)

Simple feature collection with 6 features and 4 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 1350401 ymin: -556609 xmax: 1438586 ymax: -455743.1
projected CRS:  NAD27 / US National Atlas Equal Area
# A tibble: 6 x 5
   id.x date.x                geometry  id.y date.y    
  <dbl> <date>             <POINT [m]> <dbl> <date>    
1     1 2020-04-26   (1350401 -556609)    16 2020-02-19
2     1 2020-04-26   (1350401 -556609)    17 2020-05-12
3     2 2020-03-27 (1438586 -455743.1)     7 2020-02-18
4     2 2020-03-27 (1438586 -455743.1)    15 2020-07-01
5     2 2020-03-27 (1438586 -455743.1)    15 2020-03-28
6     3 2020-06-12 (1352585 -479940.5)    15 2020-07-01

已加入%
st_连接（拉力赛，连接=st_在距离内，80467）
头部（连接）
具有6个功能和4个字段的简单功能集合
几何图形类型：点
尺寸：XY
bbox:xmin:1350401 ymin:-556609 xmax:1438586 ymax:-455743.1
预计CRS:NAD27/美国国家地图集等面积
#一个tibble:6x5
id.x日期.x几何体id.y日期.y
1     1 2020-04-26   (1350401 -556609)    16 2020-02-19
2     1 2020-04-26   (1350401 -556609)    17 2020-05-12
3     2 2020-03-27 (1438586 -455743.1)     7 2020-02-18
4     2 2020-03-27 (1438586 -455743.1)    15 2020-07-01
5     2 2020-03-27 (1438586 -455743.1)    15 2020-03-28
6     3 2020-06-12 (1352585 -479940.5)    15 2020-07-01

.x列来自测量sf对象，.y列来自拉力sf对象。几何图形将从测量sf中保留
使用dplyr的过滤器、分组和变异，找到您要查找的内容。以下代码以测量点为例计算50英里和+/-60天内的拉力
joined_60days <- joined %>% 
  group_by(id.x) %>%
  mutate(date_diff = as.numeric(date.x - date.y)) %>%
  filter(!is.na(date_diff)) %>%  ## remove survey points with no rallies in 50mi/60d
  filter(abs(date_diff) <= 60) %>%
  group_by(id.x) %>%
  count()

head(joined_60days)

Simple feature collection with 4 features and 2 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 1268816 ymin: -556609 xmax: 1438586 ymax: -322572.4
projected CRS:  NAD27 / US National Atlas Equal Area
# A tibble: 4 x 3
   id.x     n            geometry
  <dbl> <int>         <POINT [m]>
1     1     1   (1350401 -556609)
2     2     2 (1438586 -455743.1)
3     3     1 (1352585 -479940.5)
4     4     2 (1268816 -322572.4)

已加入\u 60天%
分组依据（id.x）%>%
变异（date_diff=as.numeric（date.x-date.y））%>%
过滤器（！is.na（date_diff））%>%##删除50mi/60d内无拉力的测量点
过滤器（abs（日期差异）%
分组依据（id.x）%>%
计数（）
头部（60天）
具有4个功能和2个字段的简单功能集合
几何图形类型：点
尺寸：XY
bbox:xmin:1268816 ymin:-556609 xmax:1438586 ymax:-322572.4
预计CRS:NAD27/美国国家地图集等面积
#一个tibble:4x3
id.x n几何体
1     1     1   (1350401 -556609)
2     2     2 (1438586 -455743.1)
3     3     1 (1352585 -479940.5)
4     4     2 (1268816 -322572.4)

快速目视检查：
library(mapview)
mapview(rallies, col.regions = 'purple') + 
  mapview(surveys, col.regions = 'black') + 
  mapview(buffer_50mi, col.regions = 'green')

“不幸的是，我无法共享数据以帮助再现性。”当然，你可以用假数据创建一个小的说明性示例？例如，2次集会，10次调查…我们不需要太多，但在没有数据的情况下调试代码是非常困难的。正如Gregor所说，你至少应该说明数据的结构-即数据帧、列表等。亲爱的@GregorThomas和dvd280，谢谢你的回答。我有c创建了一些带有日期的模拟数据形状文件。谢谢你，@J Thompson！这并没有完全解决问题，因为据我所知，这种方法有静态的日期范围（而不是适应每个调查）。但我真的很感谢你的帮助！
intersectObject <- st_intersection(rallySub, buffSub)
nrow(intersectObject)

daysDiff <- data.frame(t(sapply(rally$date, function(d) d-buff$date)))

rallyNew <- bind_cols(rally, daysDiff) %>%
  rename_with(~gsub('X', 'buff', .x))

WINDOW=20
for(i in 4:ncol(rallyNew)){
  rallySub <- rallyNew %>% 
    filter(get(unlist(names(rallyNew))[i])<WINDOW &
             get(unlist(names(rallyNew))[i])>-WINDOW)
  intersectObject <- st_intersection(rallySub, buffSub[i-3,])
  print(nrow(intersectObject))
}

library(tidyverse)
library(sf)


rallies <- read_sf('Downloads/stack_ex_q/rallies.shp')
# Here I don't use the supplied buffer, but make one according to the data
#fifty_buff <- read_sf('Downloads/stack_ex_q/rallies.shp') 
surveys <- read_sf('Downloads/stack_ex_q/surveys.shp')


# Transform to a crs using meters as a distance & make date col a proper date
rallies <- st_transform(rallies, crs = 2163) %>% 
  mutate(date = as.Date(date))
surveys <- st_transform(surveys, crs = 2163) %>%
  mutate(date = as.Date(date))

# make a buffer w/ 50 mile radius (80467 meters), not used but useful for visualization
buffer_50mi <- st_buffer(surveys, dist = 80467)

library(mapview)
mapview(rallies, col.regions = 'purple') + 
  mapview(surveys, col.regions = 'black') + 
  mapview(buffer_50mi, col.regions = 'green')

joined <- surveys %>%
  st_join(rallies, join = st_is_within_distance, 80467)

head(joined)

Simple feature collection with 6 features and 4 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 1350401 ymin: -556609 xmax: 1438586 ymax: -455743.1
projected CRS:  NAD27 / US National Atlas Equal Area
# A tibble: 6 x 5
   id.x date.x                geometry  id.y date.y    
  <dbl> <date>             <POINT [m]> <dbl> <date>    
1     1 2020-04-26   (1350401 -556609)    16 2020-02-19
2     1 2020-04-26   (1350401 -556609)    17 2020-05-12
3     2 2020-03-27 (1438586 -455743.1)     7 2020-02-18
4     2 2020-03-27 (1438586 -455743.1)    15 2020-07-01
5     2 2020-03-27 (1438586 -455743.1)    15 2020-03-28
6     3 2020-06-12 (1352585 -479940.5)    15 2020-07-01

joined_60days <- joined %>% 
  group_by(id.x) %>%
  mutate(date_diff = as.numeric(date.x - date.y)) %>%
  filter(!is.na(date_diff)) %>%  ## remove survey points with no rallies in 50mi/60d
  filter(abs(date_diff) <= 60) %>%
  group_by(id.x) %>%
  count()

head(joined_60days)

Simple feature collection with 4 features and 2 fields
geometry type:  POINT
dimension:      XY
bbox:           xmin: 1268816 ymin: -556609 xmax: 1438586 ymax: -322572.4
projected CRS:  NAD27 / US National Atlas Equal Area
# A tibble: 4 x 3
   id.x     n            geometry
  <dbl> <int>         <POINT [m]>
1     1     1   (1350401 -556609)
2     2     2 (1438586 -455743.1)
3     3     1 (1352585 -479940.5)
4     4     2 (1268816 -322572.4)