В R, как я могу заполнить вниз для всех строк, которые соответствуют одной переменной и не соответствуют другой - PullRequest
0 голосов
/ 26 октября 2018

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

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

Если время находится в пределах (меньше или равно) 2 часов, я хочу использовать тот же идентификатор, что и в исходной верхней строке.

Для всех строк, где разница во времени превышает 2 часа, я хочу начать новую URN с этой точки и далее.

Может иметь больше смысла с данными:

ID      Time      URN             URN_whichIwanttomake  Index
hawk    09:05     hawk_09         hawk_09               1
hawk    09:10     hawk_09         hawk_09               2
hawk    10:00     hawk_10         hawk_09               3
hawk    11:00     hawk_11         hawk_09               4
hawk    15:00     hawk_15         hawk_15               5
hawk    16:00     hawk_16         hawk_15               6
eagle   12:00     eagle_12        eagle_12              7
eagle   12:20     eagle_12        eagle_12              8
eagle   12:45     eagle_12        eagle_12              9
eagle   13:50     eagle_13        eagle_12              10
eagle   14:00     eagle_14        eagle_12              11
eagle   14:30     eagle_14        eagle_14              12
eagle   15:15     eagle_15        eagle_14              13

Я пытался использовать векторы с логическими операторами в операторе if, я могу заставить свою логику работать и возвращать правильный вектор TRUE / FALSE, но я не могу использовать это для перезаписи URN

Мой код на данный момент:

IndexShiftedBy1 <- dt$Index + 1               # ie a vector which starts at 2 and goes up to 14

if ((dt$ID[dt$Index] == dt$ID[IndexShiftedBy1]) # ie if the two IDs are the same
&  (dt$URN[dt$Index] != dt$URN[IndexShiftedBy1])) { # URN2 (ie time dependent) is NOT the same
dt$URN[IndexShiftedBy1] <- dt$URN[Index] } # overwrite lower row with upper row's value

Теперь, во-первых, это не сработает, а во-вторых, если бы это сработало, мне пришлось бы запускать его несколько раз, поскольку это просто сдвигало проблему вниз на ряд!

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

1 Ответ

0 голосов
/ 26 октября 2018

Вот решение Tidyverse. Ключевым компонентом является zoo::na.locf (не tidyverse), который заполняет значения NA предыдущим значением, отличным от NA.

library(dplyr)
# library(zoo)
dat %>%
  group_by(ID) %>%
  mutate(
    URN_new = if_else(c(TRUE, `units<-`(diff(Time), "hours") > 2), URN_original, NA_character_),
    URN_new = zoo::na.locf(URN_new)
  ) %>%
  ungroup()
# # A tibble: 13 x 5
#    ID    Time                URN_original URN_whichIwanttomake URN_new 
#    <chr> <dttm>              <chr>        <chr>                <chr>   
#  1 hawk  2018-10-26 09:05:00 hawk_09      hawk_09              hawk_09 
#  2 hawk  2018-10-26 09:10:00 hawk_09      hawk_09              hawk_09 
#  3 hawk  2018-10-26 10:00:00 hawk_10      hawk_09              hawk_09 
#  4 hawk  2018-10-26 11:00:00 hawk_11      hawk_09              hawk_09 
#  5 hawk  2018-10-26 15:00:00 hawk_15      hawk_15              hawk_15 
#  6 hawk  2018-10-26 16:00:00 hawk_16      hawk_15              hawk_15 
#  7 eagle 2018-10-26 12:00:00 eagle_12     eagle_12             eagle_12
#  8 eagle 2018-10-26 12:20:00 eagle_12     eagle_12             eagle_12
#  9 eagle 2018-10-26 12:45:00 eagle_12     eagle_12             eagle_12
# 10 eagle 2018-10-26 13:50:00 eagle_13     eagle_12             eagle_12
# 11 eagle 2018-10-26 14:00:00 eagle_14     eagle_12             eagle_12
# 12 eagle 2018-10-26 14:30:00 eagle_14     eagle_14             eagle_12
# 13 eagle 2018-10-26 15:15:00 eagle_15     eagle_14             eagle_12

data.table альтернатива:

library(data.table)
datdt <- as.data.table(dat)
datdt[,
      URN_newdt := zoo::na.locf(
        ifelse(c(TRUE, `units<-`(diff(Time), "hours") > 2), URN_original, NA_character_)
      ),
      by = "ID"]

База R:

ave(dat, dat$ID, FUN = function(d) {
  d$URN_newave <- zoo::na.locf(
    ifelse(c(TRUE, `units<-`(diff(d$Time), "hours") > 2), d$URN_original, NA_character_)
  )
  d
})

Краткое объяснение: zoo::na.locf заполняет NA последним не NA значением:

zoo::na.locf(c("hawk_09", NA, NA, NA, "hawk_15", NA))
# [1] "hawk_09" "hawk_09" "hawk_09" "hawk_09" "hawk_15" "hawk_15"

Зная это, следующим шагом будет выяснить, как назначить NA для нового URN, когда разница во времени составляет менее двух часов. diff(dat$Time) достаточно прямой, хотя, поскольку он может возвращать разные единицы без предупреждения, нам нужно заключить его в units<-(..., "hours"), чтобы убедиться, что мы получаем то, что нам нужно.

На следующем шаге diff возвращает длину вектора минус 1, поэтому нам нужно определить, нужно ли нам добавлять или добавлять, и должно ли это добавленное значение быть TRUE или FALSE. В этом случае мы всегда хотим, чтобы первое в группе было оригиналом, поэтому в большинстве случаев стоит указывать TRUE.


Данные:

dat <- read.table(header=TRUE, stringsAsFactors=FALSE, text="
ID      Time      URN_original    URN_whichIwanttomake
hawk    09:05     hawk_09         hawk_09
hawk    09:10     hawk_09         hawk_09
hawk    10:00     hawk_10         hawk_09
hawk    11:00     hawk_11         hawk_09 
hawk    15:00     hawk_15         hawk_15
hawk    16:00     hawk_16         hawk_15
eagle   12:00     eagle_12        eagle_12
eagle   12:20     eagle_12        eagle_12
eagle   12:45     eagle_12        eagle_12
eagle   13:50     eagle_13        eagle_12
eagle   14:00     eagle_14        eagle_12
eagle   14:30     eagle_14        eagle_14
eagle   15:15     eagle_15        eagle_14")
dat$Time <- as.POSIXct(paste(Sys.Date(), dat$Time))

Я использую «сегодня» для POSIXt для удобства. Я предлагаю пойти с чем-то POSIXt -подобным, но вам нужно определить разницу во времени.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...