Блог

У меня есть фрейм данных обнаружения фотоловушек с более чем 50 000 строк, и я хотел бы идентифицировать и / или удалить наблюдения одного вида, которые происходят в течение определенного периода времени другого вида на той же станции камеры.

Ниже приведен пример моего фрейма данных:

    Species    StationID    DateTime
1  Human      A            2013-05-20 10:00:00
2  Dog        A            2013-05-20 10:09:00
3  Dog        A            2013-05-21 10:40:00
4  Puma       B            2013-05-21 15:59:00
5  Dog        B            2013-05-23 10:05:00
6  Human      B            2013-05-23 10:10:00
  

Если бы я хотел идентифицировать / удалить все обнаружения собак в течение 10 минут по обе стороны от обнаружения человека на одной и той же станции камеры, я бы ожидал, что будут возвращены следующие данные:

    Species    StationID    DateTime
1  Human      A            2013-05-20 10:00:00
2  Dog        A            2013-05-21 10:40:00
3  Puma       B            2013-05-21 15:59:00
4  Human      B            2013-05-23 10:10:00
  

Среди прочего, я попытался разделить обнаружения людей и собак на отдельные фреймы данных и создать верхние и нижние столбцы даты и времени для наблюдений за собаками на основе желаемого временного допуска или -10 минут. Затем я использовал fuzzy_left_join, как показано ниже, который хорошо работал для обработки StationID, но он не возвращал правильные определения на основе указанных операций DateTime.

 Dog_HumanDF <- fuzzy_left_join(DogDF, HumanDF, 
                                  by = c("StationID" = "StationID",
                                         "DateTimeDogLower" = "DateTimeHuman", 
                                         "DateTimeDogUpper" = "DateTimeHuman"),  
                                  match_fun = list(`==`, `<=` , `>=`))
  

Я много искал похожие проблемы и решения, но не смог найти ничего, что соответствовало бы моим целям. Я бы предпочел решение, которое не требовало создания отдельных фреймов данных, как это было для fuzzy_join . Любая помощь очень ценится!

Приведенное ниже решение было предоставлено Барреттом Вулфом на другой платформе, и оно отлично работает! Я надеюсь, что это может быть полезно и другим пользователям.

 no_bad_dogs <- function(df){
output <- list()
for(i in 1:length(unique(df$StationID))){
stat_df <- df[df$StationID==unique(df$StationID)[i],]
if("Human" %in% stat_df$Species amp; "Dog" %in% stat_df$Species){
HumanDF <- stat_df[stat_df$Species == "Human",]
dog_index <- which(stat_df$Species=="Dog")
DogDF <- stat_df[dog_index,]
bad_in_dog_index <- sapply(DogDF$DateTime, FUN = function(x, human_times){return(any( x >= human_times-600 amp; x <= human_times 600))},human_times = HumanDF$DateTime)
if(any(bad_in_dog_index)){
output[[i]] <- stat_df[-dog_index[bad_in_dog_index],]} else {output[[i]] <- stat_df }
} else { output[[i]] <- stat_df }
}
do.call("rbind", output)
}