Как выбрать определенные строки DF в зависимости от временного промежутка между строками и двух других условий, связанных с другими переменными - PullRequest
Новая
       11

Как выбрать определенные строки DF в зависимости от временного промежутка между строками и двух других условий, связанных с другими переменными

1 голос
/ 30 апреля 2019

У меня есть фрейм данных df, который обобщает наблюдения особей определенного вида животных. В столбце DateTime указывается, когда животное было замечено, в столбце Observer, который его видел, и в столбце Animal указывается конкретный человек (их можно узнать). 

df<-data.frame(DateTime=c("2016-08-01 12:04:07","2016-08-01 12:06:07","2016-08-01 12:06:58","2016-08-01 13:12:12","2016-08-01 14:04:07","2016-08-01 13:12:45","2016-08-01 15:04:07","2016-08-01 17:13:16","2016-08-01 17:21:16","2016-08-01 17:21:34","2016-08-01 17:23:42","2016-08-01 17:27:16","2016-08-01 17:27:22","2016-08-01 17:28:01","2016-08-01 17:29:28","2016-08-01 17:28:08","2016-08-01 17:28:15"),
               Observer=c("Peter","Sophie","Peter","Peter","Sophie","Sophie","Peter","Sophie","Sophie","Sophie","Peter","Peter","Peter","Andreu","Sophie","Anna","Peter"),
               Animal=c(1,2,1,1,2,1,2,1,2,1,1,2,2,2,1,2,2))
df$DateTime<- as.POSIXct(df$DateTime, format= "%Y-%m-%d %H:%M:%S", tz= "UTC")

df
              DateTime Observer Animal
1  2016-08-01 12:04:07    Peter      1
2  2016-08-01 12:06:07   Sophie      2
3  2016-08-01 12:06:58    Peter      1
4  2016-08-01 13:12:12    Peter      1
5  2016-08-01 14:04:07   Sophie      2
6  2016-08-01 13:12:45   Sophie      1
7  2016-08-01 15:04:07    Peter      2
8  2016-08-01 17:13:16   Sophie      1
9  2016-08-01 17:21:16   Sophie      2
10 2016-08-01 17:21:34   Sophie      1
11 2016-08-01 17:23:42    Peter      1
12 2016-08-01 17:27:16    Peter      2
13 2016-08-01 17:27:22    Peter      2
14 2016-08-01 17:28:01   Andreu      2
15 2016-08-01 17:29:28   Sophie      1
16 2016-08-01 17:28:08     Anna      2
17 2016-08-01 17:28:15    Peter      2

Из-за методологии подсчета животных один и тот же человек не может видеть одного и того же человека менее чем за 60 секунд, но другой человек видит.

Для конкретной цели мне нужно создать df, в котором каждый раз, когда кто-то видит конкретного человека, я удаляю строки в следующие 60 секунд наблюдений ДРУГИХ ЛЮДЕЙ (если один и тот же человек видит то же животное в Менее чем за 60 с я удаляю непосредственно строку. Мы можем видеть этот пример в строках 12 и 13), но я добавляю информацию об этих удаленных строках в столбцы Other_observers, которые суммируют количество других людей, которые видели это животное, и Who, в котором приведены их имена.

Что бы я хотел получить, это: 

df
              DateTime Observer Ind Other_observers         Who
1  2016-08-01 12:04:07    Peter   1               0          NA
2  2016-08-01 12:06:07   Sophie   2               0          NA
3  2016-08-01 12:06:58    Peter   1               0          NA
4  2016-08-01 13:12:12    Peter   1               1      Sophie
5  2016-08-01 14:04:07   Sophie   2               0          NA
6  2016-08-01 15:04:07    Peter   2               0          NA
7  2016-08-01 17:13:16   Sophie   1               0          NA
8  2016-08-01 17:21:16   Sophie   2               0          NA
9  2016-08-01 17:21:34   Sophie   1               0          NA
10 2016-08-01 17:23:42    Peter   1               0          NA
11 2016-08-01 17:27:16    Peter   2               2 Andreu Anna
12 2016-08-01 17:28:15    Peter   2               0          NA
13 2016-08-01 17:29:28   Sophie   1               0          NA

Кто-нибудь знает, как это сделать?

1 Ответ

1 голос
/ 30 апреля 2019

Я снова немного подумал об этом и думаю, что у меня есть (также гораздо более простое) решение, которое не имеет ограничений, которые мы обсуждали.Я добавил несколько дополнительных наблюдений, чтобы проверить этот крайний случай. 

library(tidyverse)

df <- tribble(
  ~DateTime, ~Observer, ~Animal,
  "2016-08-01 12:04:07",   "Peter",       1,
  "2016-08-01 12:06:07",  "Sophie",       2,
  "2016-08-01 12:06:58",   "Peter",       1,
  "2016-08-01 13:12:12",   "Peter",       1,
  "2016-08-01 14:04:07",  "Sophie",       2,
  "2016-08-01 13:12:45",  "Sophie",       1,
  "2016-08-01 15:04:07",   "Peter",       2,
  "2016-08-01 17:13:16",  "Sophie",       1,
  "2016-08-01 17:21:16",  "Sophie",       2,
  "2016-08-01 17:21:34",  "Sophie",       1,
  "2016-08-01 17:23:42",   "Peter",       1,
  "2016-08-01 17:27:16",   "Peter",       2,
  "2016-08-01 17:27:22",   "Peter",       2,
  "2016-08-01 17:28:01",  "Andreu",       2,
  "2016-08-01 17:29:28",  "Sophie",       1,
  "2016-08-01 17:28:08",    "Anna",       2,
  "2016-08-01 17:28:15",   "Peter",       2,
  "2016-08-01 17:28:17",   "Peter",       2,
  "2016-08-01 17:28:21",   "Peter",       2,
  "2016-08-01 17:28:21",   "Anna",        2,
) %>%
  mutate(DateTime = as.POSIXct(DateTime, format= "%Y-%m-%d %H:%M:%S", tz= "UTC"))

min_diff = as.difftime(60, units = c("secs"))

cumsum_reset <- function(s, x, reset) {
  ns <- s + x
  if (ns > reset) return(0)
  ns
}

df_wrangled <- df %>%
  arrange(DateTime) %>%
  group_by(Animal) %>%
  mutate(
    # Time difference to laste observation of this animal
    Diff = replace_na(DateTime - lag(DateTime, 1), 0),
    # Cumulative time since first observation, resets to 0 when more than `min_diff`
    CumDiff = accumulate(Diff, cumsum_reset, reset = min_diff),
    # Group observations within the `min_diff` period
    ObsGroup = cumsum(CumDiff == 0)
  ) %>%
  group_by(ObsGroup, add = TRUE) %>%
  summarize(
    Other_observers = length(unique(Observer)) - 1,
    Who = paste(unique(setdiff(Observer, Observer[1])), collapse = " "),
    DateTime = DateTime[1],
    Observer = Observer[1]
  ) %>%
  ungroup()

print(df_wrangled, n = Inf)
#> # A tibble: 13 x 6
#>    Animal ObsGroup Other_observers Who         DateTime            Observer
#>     <dbl>    <int>           <dbl> <chr>       <dttm>              <chr>   
#>  1      1        1               0 ""          2016-08-01 12:04:07 Peter   
#>  2      1        2               0 ""          2016-08-01 12:06:58 Peter   
#>  3      1        3               1 Sophie      2016-08-01 13:12:12 Peter   
#>  4      1        4               0 ""          2016-08-01 17:13:16 Sophie  
#>  5      1        5               0 ""          2016-08-01 17:21:34 Sophie  
#>  6      1        6               0 ""          2016-08-01 17:23:42 Peter   
#>  7      1        7               0 ""          2016-08-01 17:29:28 Sophie  
#>  8      2        1               0 ""          2016-08-01 12:06:07 Sophie  
#>  9      2        2               0 ""          2016-08-01 14:04:07 Sophie  
#> 10      2        3               0 ""          2016-08-01 15:04:07 Peter   
#> 11      2        4               0 ""          2016-08-01 17:21:16 Sophie  
#> 12      2        5               2 Andreu Anna 2016-08-01 17:27:16 Peter   
#> 13      2        6               1 Anna        2016-08-01 17:28:17 Peter

Создано в 2019-04-30 пакетом Представить (v0.2.1)

СТАРЫЕ РЕШЕНИЯ:

Вот одно решение, использующее превосходный пакет fuzzyjoin .По сути, я присоединяю наблюдения к себе, если они находятся на расстоянии менее min_dist.

Здесь есть несколько сложных случаев, которые я не рассмотрел.Например, если наблюдатель записывает наблюдение за одним животным, скажем, каждые 30 с в течение 5 минут, я полагаю, что все они будут отфильтрованы до тех пор, пока они находятся на расстоянии <1 минуты, кроме первого наблюдения.Вероятно, это не то, что вам нужно, но я не уверен, как именно это решить. </p> 

library(tidyverse)
library(fuzzyjoin)
df<-data.frame(DateTime=c("2016-08-01 12:04:07","2016-08-01 12:06:07","2016-08-01 12:06:58","2016-08-01 13:12:12","2016-08-01 14:04:07","2016-08-01 13:12:45","2016-08-01 15:04:07","2016-08-01 17:13:16","2016-08-01 17:21:16","2016-08-01 17:21:34","2016-08-01 17:23:42","2016-08-01 17:27:16","2016-08-01 17:27:22","2016-08-01 17:28:01","2016-08-01 17:29:28","2016-08-01 17:28:08","2016-08-01 17:28:15"),
               Observer=c("Peter","Sophie","Peter","Peter","Sophie","Sophie","Peter","Sophie","Sophie","Sophie","Peter","Peter","Peter","Andreu","Sophie","Anna","Peter"),
               Animal=c(1,2,1,1,2,1,2,1,2,1,1,2,2,2,1,2,2))
df$DateTime<- as.POSIXct(df$DateTime, format= "%Y-%m-%d %H:%M:%S", tz= "UTC")


min_diff = as.difftime(1, units = c("mins"))

df_wrangled <- df %>%
  as_tibble() %>%
  arrange(DateTime) %>%
  # Add a unique id for each observation
  mutate(id = 1:n()) %>%
  fuzzy_left_join(
    x = .,
    y = .,
    by = c("Animal", "DateTime"),
    match_fun = list(
      `==`,
      function(x, y) y - x < min_diff & y - x > 0
    )
  ) %>%
  # Remove observations that occured within `min_diff`
  filter(!(id.x %in% id.y)) %>%
  # Remove observations by same observer within `min_diff`
  filter(ifelse(is.na(Observer.y), TRUE, Observer.x != Observer.y)) %>%
  group_by(DateTime.x, Observer.x, Animal.x, id.x) %>%
  summarize(
    Other_observers = length(na.omit(Observer.y)),
    Who = paste(Observer.y, collapse = " ")
  ) %>%
  ungroup()

print(df_wrangled, n = Inf)
#> # A tibble: 12 x 6
#>    DateTime.x          Observer.x Animal.x  id.x Other_observers Who       
#>    <dttm>              <fct>         <dbl> <int>           <int> <chr>     
#>  1 2016-08-01 12:04:07 Peter             1     1               0 NA        
#>  2 2016-08-01 12:06:07 Sophie            2     2               0 NA        
#>  3 2016-08-01 12:06:58 Peter             1     3               0 NA        
#>  4 2016-08-01 13:12:12 Peter             1     4               1 Sophie    
#>  5 2016-08-01 14:04:07 Sophie            2     6               0 NA        
#>  6 2016-08-01 15:04:07 Peter             2     7               0 NA        
#>  7 2016-08-01 17:13:16 Sophie            1     8               0 NA        
#>  8 2016-08-01 17:21:16 Sophie            2     9               0 NA        
#>  9 2016-08-01 17:21:34 Sophie            1    10               0 NA        
#> 10 2016-08-01 17:23:42 Peter             1    11               0 NA        
#> 11 2016-08-01 17:27:16 Peter             2    12               2 Andreu An…
#> 12 2016-08-01 17:29:28 Sophie            1    17               0 NA

Создано в 2019-04-30 пакетом Представить (v0.2.1)

...