Как проверить, находится ли дата между двумя значениями в R?

Question

У меня есть таблица, которая выглядит следующим образом;

user_id     timestamp
aa          2018-01-01 12:01 UTC
ab          2018-01-01 05:01 UTC
bb          2018-06-01 09:01 UTC
bc          2018-03-03 23:01 UTC
cc          2018-01-02 11:01 UTC

У меня есть еще один стол, который есть каждую неделю в 2018 году.

week_id    week_start     week_end
1          2018-01-01     2018-01-07
2          2018-01-08     2018-01-15
3          2018-01-16     2018-01-23
4          2018-01-23     2018-01-30
...        ...            ...

Предположим, что week_start - понедельник, а week_end - воскресенье.

Я бы хотел сделать две вещи. Сначала я хотел бы присоединить week_id к первой таблице, а затем я хотел бы назначить день для каждой из временных меток. Мой вывод будет выглядеть так:

user_id     timestamp               week_id    day_of_week
aa          2018-01-01 12:01 UTC    1          Monday
ab          2018-01-02 05:01 UTC    1          Tuesday
bb          2018-01-13 09:01 UTC    2          Friday
bc          2018-01-28 23:01 UTC    4          Friday
cc          2018-01-06 11:01 UTC    1          Saturday

В Excel я мог бы легко сделать это с vlookup. Мой главный интерес - научиться объединять таблицы в таких случаях. По этой причине я не буду принимать ответы, использующие функцию weekday.

Вот обе таблицы в более доступном формате.

user_id <- c("aa", "ab", "bb", "bc", "cc")
timestamp <- c("2018-01-01 12:01", "2018-01-01 05:01", "2018-06-01 09:01", "2018-03-03 23:01", "2018-01-02 11:01")

week_id <- seq(1,52)
week_start <- seq(as.Date("2018-01-01"), as.Date("2018-12-31"), 7)
week_end <- week_start + 6

week_start <- week_start[1:52]
week_end <- week_end[1:52]  

table1 <- data.frame(user_id, timestamp)
table2 <- data.frame(week_id, week_start, week_end)

Answer 1

Используя SQL, можно объединить две таблицы в таком диапазоне. Это кажется наиболее элегантным решением, выражающим наши намерения напрямую, но мы также предлагаем несколько альтернатив ниже.

library(sqldf)

DF1$date <- as.Date(DF1$timestamp)

sqldf("select * 
  from DF1 a 
  left join DF2 b on date between week_start and week_end")

дает:

  user_id           timestamp       date week_id week_start   week_end
1      aa 2018-01-01 12:01:00 2018-01-01       1 2018-01-01 2018-01-07
2      ab 2018-01-01 05:01:00 2018-01-01       1 2018-01-01 2018-01-07
3      bb 2018-06-01 09:01:00 2018-06-01      NA       <NA>       <NA>
4      bc 2018-03-03 23:01:00 2018-03-04      NA       <NA>       <NA>
5      cc 2018-01-02 11:01:00 2018-01-02       1 2018-01-01 2018-01-07

dplyr

В комментарии автор спросил, можно ли это сделать в dplyr. Это не может быть сделано напрямую, поскольку dplyr не поддерживает сложные объединения, но обходной путь может заключаться в полном перекрестном объединении двух фреймов данных, что приводит к промежуточному результату nrow(DF1) * nrow(DF2), а затем отфильтровывает его. dplyr напрямую не поддерживает перекрестные объединения, но мы можем смоделировать их, выполнив полное объединение с идентичным столбцом фиктивной константы, который добавляется к обоим фреймам данных при полном объединении. Так как нам здесь действительно нужно правильное соединение, чтобы добавить обратно несопоставленные строки, мы делаем последнее правое соединение с исходным фреймом данных DF1. Очевидно, что это совершенно нецелесообразно для достаточно больших входных данных, но для небольших входных данных мы можем это сделать. Если бы было известно, что в DF2 есть соответствие каждой строке в DF1, тогда right_join в конце можно было бы опустить.

DF1 %>% 
  mutate(date = as.Date(timestamp), dummy = 1) %>%
  full_join(DF2 %>% mutate(dummy = 1)) %>%
  filter(date >= week_start & date <= week_end) %>%
  select(-dummy) %>%
  right_join(DF1)

R База

findix находит индекс в DF2, соответствующий дате d. Затем мы sapply пересекаем даты, соответствующие строкам DF1, и складываем DF1 и соответствующую строку DF2.

findix <- function(d) c(which(d >= DF2$week_start & d <= DF2$week_end), NA)[1]
cbind(DF1, DF2[sapply(as.Date(DF1$timestamp), findix), ])

Примечание

Используемые входные данные в воспроизводимой форме:

Lines1 <- "user_id     timestamp
aa          2018-01-01 12:01 UTC
ab          2018-01-01 05:01 UTC
bb          2018-06-01 09:01 UTC
bc          2018-03-03 23:01 UTC
cc          2018-01-02 11:01 UTC"
DF1 <- read.csv(text = gsub("     +", ",", Lines1), strip.white = TRUE)
DF1$timestamp <- as.POSIXct(DF1$timestamp)

Lines2 <- "week_id    week_start     week_end
1          2018-01-01     2018-01-07
2          2018-01-08     2018-01-15
3          2018-01-16     2018-01-23
4          2018-01-23     2018-01-30"
DF2 <- read.table(text = Lines2, header = TRUE)
DF2$week_start <- as.Date(DF2$week_start)
DF2$week_end <- as.Date(DF2$week_end)

Answer 2

Это случай для fuzzyjoin -пакета. С аргументом match_fun - мы можем указать условия для каждого столбца. В этом случае table1$date >= table2$week_start и table1$date <= table2$week_end.

library(fuzzyjoin)
library(lubridate)

table1$date <- as.Date(table1$timestamp)

fuzzy_left_join(table1, table2, 
                by = c("date" = "week_start", "date" = "week_end"),
                match_fun = list(`>=`, `<=`)) %>%
  mutate(day_of_week = wday(date, label = TRUE)) %>%
  select(user_id, timestamp, week_id, day_of_week) 

  user_id        timestamp week_id day_of_week
1      aa 2018-01-01 12:01       1          Mo
2      ab 2018-01-01 05:01       1          Mo
3      bb 2018-06-01 09:01      22          Fr
4      bc 2018-03-03 23:01       9          Sa
5      cc 2018-01-02 11:01       1          Di

Я тоже сообразительный, потому что я использовал не weekday -функцию, а wday из lubridate -пакета.