我想在动物轨迹的每个GPS位置周围15公里半径内创建20个随机位置(请参见示例).

animal track with behavioral classifications

我可以用st_bufferst_sample来做这件事,但是我在用曲目ID(总计ID~200)来注释随机采样的位置时遇到了麻烦.我需要注释随机采样的位置,以便我可以将该数据帧连接回观察到的轨道位置,其中20个随机位置中的每一个都与观察到的位置和ID相关联.

数据帧的一个简单示例如下所示,其中我有一个动物标识符(Id)、地理坐标(x,y)和时间戳(Time):

df <- data.frame(id = c("id1", "id1", "id1", "id2", "id2", "id2"),
           long = c(-80, -81, -82, -79, -70, -75),
           lat = c(36, 37, 38, 41, 40, 40.5),
           time = c(7, 8, 9, 6, 7, 8)
  
)

我想知道是否可以用id个列来命名缓冲区,然后用st_join个随机位置来命名缓冲区,这样随机采样的位置就可以拥有原始数据帧中的列标识符了.但这能满足用观测到的位置标注位置的要求吗?只是一个 idea .到目前为止,我的代码如下所示.

random_locs <- df %>% 
  st_as_sf(., coords = c("x","y"), crs = "epsg:4326") %>% 
  st_transform(., crs = "epsg:26915") %>%
  #filter(class == "stopover") %>% # don't worry about this
  group_by(id) %>%
  st_buffer(., dist = 15000) %>% 
  #st_dissolve(.) %>%
  mutate(BirdsID_season = BirdsID_season) %>% # can I add a name to the buffers?
  st_sample(., size = rep(20,nrow(.)), "random", exact = TRUE) %>% 
  st_as_sf(.) %>% 
  mutate(used = 0) %>% 
  ungroup()

就位置的数量而言,输出是正确的,但是我没有任何信息来注释原始标识符来连接数据帧.我们非常感谢您的任何建议.

EDIT个 我正在编辑问题以详细说明我想要的输出:最终目标是在一个整齐的框架中拥有观察到的位置(=1)和随机位置(=0).随机位置必须根据观察到的位置(时间、x、y)和动物ID有条件地生成,并进行相应的注释,以便生成单个二项响应(0/1,真/假,观察/随机).输出将类似于下面两个人的df.我简单地向原始df添加了3行,其中对于每个使用的位置,每个id都会生成一个随机位置:

final_df <- data.frame(id = c("id1", "id1", "id1", "id1", "id1", "id1",
                              "id2", "id2", "id2", "id2", "id2", "id2"),
                       long = c(-80, -81, -82, -82,-82.5, -81
                                -79, -70, -75, -82.5, -79.5, -79),
                       lat = c(36, 37, 38, 37, 36.5, 37,
                               41, 40, 40.5, 40, 42, 40.5), # these are all made up
                       time = c(7, 8, 9, 7, 8, 9,
                                6, 7, 8, 6, 7, 8), # time wouldn't change w/ addition of random locs
                       type = c("1", "1", "1", "0", "0", "0",
                                "1", "1", "1", "0", "0", "0") # or TRUE/FALSE, yes/no, observed/random
)

推荐答案

在创建缓冲区和采集样本时,我们可以使用rowwsie分组来处理每个单独的位置点.每个观察点被替换为20个随机点的MULTIPOINT个(st_union()的结果),然后产生的几何体列被强制转换为POINT.

当用bind_rows()堆叠这两个数据集时,我们可以使用.id参数来获得标识符列.

library(sf)
#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(dplyr)
library(mapview)

df <- tibble(
  id = c("id1", "id1", "id1", "id2", "id2", "id2"),
  long = c(-80, -81, -82, -79, -70, -75),
  lat = c(36, 37, 38, 41, 40, 40.5),
  time = c(7, 8, 9, 6, 7, 8)
)

### stacking observed and random points
# sf from input data:
locations_sf <- df %>% 
  st_as_sf(coords = c("long","lat"), crs = "epsg:4326") %>% 
  st_transform(crs = "epsg:26915")

# sampled points
sample_sf <- locations_sf %>% 
  rowwise() %>% 
  mutate(geometry = st_buffer(geometry, 15000) %>% st_sample(20) %>% st_union()) %>% 
  ungroup() %>% 
  st_cast("POINT")

# bind together, name ("observed" / "random") will be used for a type column
stacked_sf <- bind_rows(list(observed = locations_sf, random = sample_sf), .id = "type") 

stacked_sf
#> Simple feature collection with 126 features and 3 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1455288 ymin: 4050203 xmax: 2479757 ymax: 4702531
#> Projected CRS: NAD83 / UTM zone 15N
#> # A tibble: 126 × 4
#>    type     id     time          geometry
#>  * <chr>    <chr> <dbl>       <POINT [m]>
#>  1 observed id1       7 (1674746 4063075)
#>  2 observed id1       8 (1569850 4162867)
#>  3 observed id1       9 (1467197 4263375)
#>  4 observed id2       6 (1678983 4634280)
#>  5 observed id2       7 (2471421 4689820)
#>  6 observed id2       8 (2028860 4642061)
#>  7 random   id1       7 (1661987 4056629)
#>  8 random   id1       7 (1662872 4070261)
#>  9 random   id1       7 (1664411 4054672)
#> 10 random   id1       7 (1667414 4075791)
#> # ℹ 116 more rows


# back to data.frame / tibble with separate columns for lat/lon
final_df <- stacked_sf %>% 
  st_transform("WGS84") %>% 
  { bind_cols(st_drop_geometry(.), st_coordinates(.)) } %>% 
  select(id, long = X, lat = Y, time, type)

结果:

final_df
#> # A tibble: 126 × 5
#>    id     long   lat  time type    
#>    <chr> <dbl> <dbl> <dbl> <chr>   
#>  1 id1   -80    36       7 observed
#>  2 id1   -81    37       8 observed
#>  3 id1   -82    38       9 observed
#>  4 id2   -79    41       6 observed
#>  5 id2   -70    40       7 observed
#>  6 id2   -75    40.5     8 observed
#>  7 id1   -80.1  36.0     7 random  
#>  8 id1   -80.1  36.1     7 random  
#>  9 id1   -80.1  35.9     7 random  
#> 10 id1   -80.1  36.1     7 random  
#> # ℹ 116 more rows

# visualize points for one id/time:
stacked_sf %>% filter(id == "id1", time == 7) %>% 
  mapview(zcol = "type", map.type = "CartoDB.Positron")

创建于2023-07-21,共reprex v2.0.2

R相关问答推荐

替换收件箱的子集(行和列)

如何通过Exams2黑板对非整数字的问题进行评分

在交互式情节中从barplot中获取值时遇到问题,在shinly中的ggplotly

是否有R代码来判断一个组中的所有值是否与另一个组中的所有值相同?

更改网格的crs以匹配简单要素点对象的crs

通过绘图 Select 线串几何体并为其着色

R中具有gggplot 2的Likert图,具有不同的排名水平和显示百分比

在使用ggroove后,将图例合并在gplot中

使用case_match()和char数组重新编码值

如何编辑gMarginal背景以匹配绘图背景?

如何将一列中的值拆分到R中各自的列中

如何在R中使用hmm TMB提前一步预测观察到的状态?

将数据集旋转到长格式,用于遵循特定名称模式的所有变量对

如何计算增加10米(0.01公里)的行?

有没有办法一次粘贴所有列

创建在文本字符串中发现两个不同关键字的实例的数据框

按组和连续id计算日期差

随机 Select 的非NA列的行均数

为什么不能使用lApply在包装函数中调用子集

如何将图例文本添加到图例符号中