If / else if: выбрать первую соответствующую запись в пределах установленного расстояния только после того, как первое условие не выполнено в R - PullRequest
Новая
       5

If / else if: выбрать первую соответствующую запись в пределах установленного расстояния только после того, как первое условие не выполнено в R

1 голос
/ 20 февраля 2020

Я бы хотел выбрать ближайшего предыдущего владельца на заданном расстоянии только после того, как не выполнено первое условие поиска. Местоположения называются reflo (контрольное местоположение), и они имеют соответствующие координаты x и y (называемые locx и locy соответственно).

Условия:

  • если lifetime_census$reflo==owners$reflo.x[i], то условие выполнено
  • , если lifetime_census$reflo!=owners$reflo.x[i], то найти следующую ближайшую запись (в пределах 30 метров)
  • , если в течение 30 записей нет метров, затем назначьте NA

Предыдущие владельцы (> 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]

}

Я не могу понять, как получить l oop go через условия по порядку, а затем выберите запись в пределах предела поиска только после того, как точное совпадение не было найдено.

Есть идеи?

Ответы [ 3 ]

1 голос
/ 02 марта 2020

Поскольку у вас есть 2 набора критериев, я предлагаю разделить задачу на две части. Кроме того, при объединении двух фреймов данных я всегда предлагаю найти подходящее соединение.

Для точных совпадений dplyr::inner_join даст вам правильные строки.

Для следующей части вы можете исключить точные совпадения и использовать distance_left_join из пакета fuzzyjoin для сопоставьте оставшиеся строки. Также имеется опция для максимального расстояния.

Затем вы можете просто связать два результата 

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

Создано в 2020-03-02 с помощью Представить пакет (v0.3.0)

1 голос
/ 04 марта 2020

Следующее решает проблему.

Функция для расчета расстояний: 

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

Определение предыдущего идентификатора на расстоянии 30 метров. Установите идентификатор равным NA, если все расстояния превышают 30 м. 

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 life_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 (). В случае продолжительности жизни> лет функция теперь возвращает NA.

1 голос
/ 02 марта 2020

Я бы предложил что-то подобное (нумерация единиц для 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 l oop и next можно удалить каждую else и дырку вложенной структуры.

...