If/else if: 只在 R 中第一个条件不满足时才在设定距离内选择第一个匹配记录

If/else if: pick first matching record within set distance only after first condition is not met in R

我想仅在不满足第一个搜索条件后才选择设定距离内最近的前任所有者。这些位置称为 reflo(参考位置),并且它们具有相应的 x 和 y 坐标(分别称为 locxlocy)。

条件:

以前的所有者 (>20,000) 存储在名为 lifetime_census 的数据集中。这是数据示例:

id         previous_id  reflo  locx    locy   lifespan  
16161      5587         -310    -3     10     1810    
16848      5101         Q1      17.3   0.8    55    
21815      6077         M2      13     1.8    979
23938      6130         -49     -4     9      374
29615      7307         B.1     2.5    1      1130

然后我有一个 owners 数据集(这里是一个示例):

squirrel_id      spr_census reflo.x    spring_locx      spring_locy 
6391              2005       M3           13             2.5  
6130              2005       -310         -3             10    
23586             2019       B9           2              9

为了说明我正在努力实现的目标:

squirrel_id spr_census reflo.x spring_locx spring_locy previous_owner   
6391        2004       M3       13         2.5         6077            
6130        2005       -310     -3         10          5587   
23586       2019       B9       2          9           NA

目前我试过的是这样的:

n <- length(owners$squirrel_id)
distance <- 30 #This can be easily changed to bigger or smaller values

for(i in 1:n) {
  last_owner <- subset(lifetime_census,
    lifetime_census$reflo==owners$reflo.x[i] & #using the exact location
((30*owners$spring_locx[i]-30* lifetime_census$locx)^2+(30* owners$spring_locy[i]-30* lifetime_census$locy)^2<=(distance)^2)) #this sets the search limit

owners[i,"previous_owner"] <- last_owner$previous_id[i]

}

我不知道如何让循环按顺序遍历条件,然后 select 只有在没有找到完全匹配的情况下才在搜索限制内记录。

有什么想法吗?

我建议这样(假设 locx 等单位与 distance 相同:

distance = 30

distance_xy = function (x1, y1, x2, y2) {
  sqrt((x2 - x1)^2 + (y2 -y1)^2)
}

for (i in 1:dim(owners)[1]) {
  if (owners$reflo.x[i] %in% lifetime_census$reflo) {
    owners$previous_owner[i] = lifetime_census[lifetime_census$reflo == owners$reflo.x[i], ]$previous_id
  } else {
    dt = distance_xy(owners$spring_locx[i], owners$spring_locy[i], lifetime_census$locx, lifetime_census$locy)
      if (any(dt <= distance)) {
        owners$previous_owner[i] = lifetime_census[order(dt), ]$previous_id[1L]
      } else {
        owners$previous_id[i] = NA
      }
    }
  }

给出:

   squirrel_id spr_census reflo.x spring_locx spring_locy previous_owner
1        6391       2005      M3          13         2.5           6077
2        6130       2005    -310          -3        10.0           5587
3       23586       2019      B9           2         9.0           5587

请注意,如果 reflo 有多个匹配项,这将失败。

[编辑] 根据下面的评论添加替代方案。

当您开始添加条件时,

if-else 语句可能会变得非常混乱。这是避免上述嵌套结构的另一种实现方式:

for (i in 1:dim(owners)[1]) {

  # if we find the reflo
  if (owners$reflo.x[i] %in% lifetime_census$reflo) {
    owners$previous_owner[i] = lifetime_census[lifetime_census$reflo == owners$reflo.x[i], ]$previous_id
    next
  }

  # if we got here, then we didn't find the reflo, compute distances:
  dt = distance_xy(owners$spring_locx[i], owners$spring_locy[i], lifetime_census$locx, lifetime_census$locy)

  # if we find anyone within distance, get the closest one
  if (any(dt <= distance)) {
    owners$previous_owner[i] = lifetime_census[order(dt), ]$previous_id[1L]
    next
  }

  # if we got here, there was nobody within range, set NA and move on:
  owners$previous_id[i] = NA
}

代码的作用完全相同,但是通过利用 for 循环和 next 可以删除每个 else 和孔嵌套结构。

由于您有两套标准,我建议您也将任务分成两部分。此外,在组合两个数据帧时,我总是建议找到合适的连接。

对于完全匹配,dplyr::inner_join 将为您提供正确的行。

对于下一部分,您可以排除完全匹配并使用 fuzzyjoin 包中的 distance_left_join 来匹配剩余的行。它还带有最大距离选项。

然后,你可以简单地绑定两个结果

library(data.table)
lifetime_census <- fread('id         previous_id  reflo  locx    locy   lifespan  
16161      5587         -310    -3     10     1810    
16848      5101         Q1      17.3   0.8    55    
21815      6077         M2      13     1.8    979
23938      6130         -49     -4     9      374
29615      7307         B.1     3      1      1130')
lifetime_census
#>       id previous_id reflo locx locy lifespan
#> 1: 16161        5587  -310 -3.0 10.0     1810
#> 2: 16848        5101    Q1 17.3  0.8       55
#> 3: 21815        6077    M2 13.0  1.8      979
#> 4: 23938        6130   -49 -4.0  9.0      374
#> 5: 29615        7307   B.1  3.0  1.0     1130
owners <- fread('squirrel_id      spr_census reflo.x    spring_locx      spring_locy 
6391              2005       M3           13             2.5  
6130              2005       -310         -3             10    
23586             2019       B9           2              9')
owners
#>    squirrel_id spr_census reflo.x spring_locx spring_locy
#> 1:        6391       2005      M3          13         2.5
#> 2:        6130       2005    -310          -3        10.0
#> 3:       23586       2019      B9           2         9.0

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:data.table':
#> 
#>     between, first, last
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(fuzzyjoin)

# Search for exact match
df1 <- inner_join(owners,lifetime_census ,by=c(reflo.x='reflo')) %>% 
  select(squirrel_id:spring_locy,previous_id)
df1
#>   squirrel_id spr_census reflo.x spring_locx spring_locy previous_id
#> 1        6130       2005    -310          -3          10        5587


df2 <- 
  owners %>% 
  anti_join(df1,by=c('squirrel_id')) %>% # Remove rows with exact matches
    distance_left_join(lifetime_census,
                       by=c(spring_locx='locx',spring_locy='locy'), # Match columns
                       max_dist=1, # Since you want a maximum distance of 30m = 1 unit
                       distance_col='dist') %>% # Optional, if you want to see the distance
    select(squirrel_id:spring_locy,previous_id,dist)

bind_rows(df1,df2)  
#>   squirrel_id spr_census reflo.x spring_locx spring_locy previous_id dist
#> 1        6130       2005    -310          -3        10.0        5587   NA
#> 2        6391       2005      M3          13         2.5        6077  0.7
#> 3       23586       2019      B9           2         9.0          NA   NA

reprex package (v0.3.0)

于 2020 年 3 月 2 日创建

以下解决问题。

计算距离的函数:

distance_xy = function (x1, y1, x2, y2) {
  sqrt((x2 - x1)^2 + (y2 -y1)^2)
}

判断30米范围内的上一个id。如果所有距离都大于 30 米,请将 id 设置为 NA。

library(tidyverse)

previous_id_fn <- function(v, w, years){
   dists <- map2_dbl(lifetime_census$locx, lifetime_census$locy, ~distance_xy(.x, .y, v, w)) 
   df <- data.frame(previous = lifetime_census$previous_id, 
                    dist = dists, 
                    life = lifetime_census$lifespan) %>% 
               filter(life < years)
   id <- df$previous[[which.min(df$dist)]]
   if (min(df$dist, na.rm = TRUE) > 30) { id <- NA }
   return(id)
}

首先加入 data.frame 拥有 data.frame lifetime_census 的所有者以获得 previous_id 的列。然后将上面定义的函数应用于 data.frame 的每一行。

owners %>%
  left_join(., lifetime_census, by = c("reflo.x" = "reflo")) %>%
  select(squirrel_id:spring_locy, previous_id) %>%
  rowwise() %>%
  mutate(previous_id = ifelse(is.na(previous_id), 
                            previous_id_fn(spring_locx, spring_locy, 1000), 
  previous_id))

编辑:

我向函数 previous_id_fn() 添加了一个参数 years。如果 lifetime > years 函数现在 returns NA。