保留外部列表的日期之前和之后

时间:2019-09-27 20:30:31

标签: r

具有此数据框:

dframe1 <- structure(list(id = c(1L, 1L, 1L, 2L, 2L), name = c("Google", 
"Yahoo", "Amazon", "Amazon", "Google"), date = c("2008-11-01", 
"2008-11-01", "2008-11-04", "2008-11-01", "2008-11-02")), class = "data.frame", row.names = c(NA, 
-5L))

第二个:

    dframe2 <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 2L, 2L, 2L, 2L, 2L, 2L), date = c("2008-11-01", "2008-11-01", 
"2008-11-04", "2008-10-31", "2008-10-31", "2008-11-02", "2008-11-02", 
"2008-11-02", "2008-11-05", "2008-11-02", "2008-11-03", "2008-10-31", 
"2008-11-01", "2008-11-01", "2008-11-02", "2008-11-02", "2008-11-03"
), name = c("Google", "Yahoo", "Amazon", "Google", "Yahoo", "Amazon", 
"Google", "Yahoo", "Amazon", "Google", "Yahoo", "Amazon", "Google", 
"Amazon", "Google", "Amazon", "Google"), text_sth = c("test", 
"text_sth", "text here", "another text", "other", "another one", 
"test", "text_sth", "text here", "another text", "other", "etc", 
"test", "text_sth", "text here", "another text", "text here")), class = "data.frame", row.names = c(NA, 
-17L))

使用dframe1的结果,如何从dataframe2中保留每个ID与dframe1相同名称但在dframe1记录日期之前和之后的日期的行?

这是我尝试过的

library(data.table)
library(tidyverse)
library(reshape2)

dframe1 = data.table(dframe1)
dframe1[, date := as.Date(date)]

dframe1_first = dframe1[, .(date = min(date)), .(id, name)] %>% 
    mutate(date_pre = date - 1,
           date_after = date + 1)

req_rows = dframe2 %>%
    merge(dframe1_first %>%
              rename(id = id),
          by = "id") %>%
    filter(date >= date_pre,
           date <= date_after,
           date != date) %>%
    mutate(period = ifelse(date<date, '1-day-pre', '1-day-after'))

预期输出:

 id       date   name     text_sth
1 2008-10-31 Google another text
1 2008-10-31  Yahoo        other
1 2008-11-02 Google         test
1 2008-11-02  Yahoo     text_sth
1 2008-11-05 Amazon    text here
1 2008-11-02 Google another text
2 2008-10-31 Amazon          etc
2 2008-11-01 Google         test
2 2008-11-02 Amazon another text
2 2008-11-03 Google    text here

3 个答案:

答案 0 :(得分:2)

如果我理解正确,则OP希望在idname以及前一天或后一天找到匹配的条目。因此,非平等参加将无济于事,因为它将包括当天的比赛。

我建议使用lapply()执行两个内部联接,一个在前一天,第二个在后一天。随后,将结果与rbindlist()合并,该结果还添加了新列matching_day as requested by the OP

library(data.table)
library(magrittr)
setDT(dframe1)[, date := as.Date(date)]
setDT(dframe2)[, date := as.Date(date)]

lapply(
  c(-1, +1), 
  function(x) dframe2[dframe1[, .(id, name, date = date + x)], on = .(id, name, date), nomatch = 0L]
) %>%
  set_names(c("before", "after")) %>% 
  rbindlist(idcol = "matching_day") %>% 
  .[order(id)]
    matching_day id       date   name     text_sth
 1:       before  1 2008-10-31 Google another text
 2:       before  1 2008-10-31  Yahoo        other
 3:        after  1 2008-11-02 Google         test
 4:        after  1 2008-11-02 Google another text
 5:        after  1 2008-11-02  Yahoo     text_sth
 6:        after  1 2008-11-05 Amazon    text here
 7:       before  2 2008-10-31 Amazon          etc
 8:       before  2 2008-11-01 Google         test
 9:        after  2 2008-11-02 Amazon another text
10:        after  2 2008-11-03 Google    text here

答案 1 :(得分:1)

一种方法可能是扩展dframe1数据集,并为每个dateid包含具有+1和-1 name的行。我们删除dframe1的原始行,并对inner_join进行dframe2

library(dplyr)

dframe1 %>%
  mutate(date = as.Date(date), date1 = date) %>%
  group_by(id, name) %>%
  tidyr::complete(date1 = seq(date1 - 1, date1 + 1, by = "1 day")) %>%
  filter(date1 != date | is.na(date)) %>%
  select(-date) %>%
  rename(date = 3) %>%
  inner_join(dframe2 %>% mutate(date = as.Date(date)))

#Joining, by = c("id", "name", "date")
# A tibble: 10 x 4
# Groups:   id, name [5]
#      id name   date       text_sth    
#   <int> <chr>  <date>     <chr>       
# 1     1 Amazon 2008-11-05 text here   
# 2     1 Google 2008-10-31 another text
# 3     1 Google 2008-11-02 test        
# 4     1 Google 2008-11-02 another text
# 5     1 Yahoo  2008-10-31 other       
# 6     1 Yahoo  2008-11-02 text_sth    
# 7     2 Amazon 2008-10-31 etc         
# 8     2 Amazon 2008-11-02 another text
# 9     2 Google 2008-11-01 test        
#10     2 Google 2008-11-03 text here 

要添加新列,我们可以添加另一个mutate语句。

dframe1 %>%
   mutate(date = as.Date(date), date1 = date) %>%
   group_by(id, name) %>%
   tidyr::complete(date1 = seq(date1 - 1, date1 + 1, by = "1 day")) %>%
   filter(date1 != date | is.na(date)) %>%
   select(-date) %>%
   mutate(col = c("before", "after")) %>%
   rename(date = 3) %>%
   inner_join(dframe2 %>% mutate(date = as.Date(date)))  

答案 2 :(得分:0)

R的基本方式可能是将dframe1转换为数据帧dframe1a,该数据帧已经由所需的日期和merge()dframe2组成。

dframe1a <- do.call(rbind, lapply(1:nrow(dframe1), function(m) 
  cbind(dframe1[m, -3], date=as.matrix(dframe1[m, "date"] + c(-1, 1)), row.names=NULL)))
dframe1a$date <- as.Date(as.numeric(as.character(dframe1a$date)), origin="1970-01-01")
merge(dframe2, dframe1a)
#    id       date   name     text_sth
# 1   1 2008-10-31 Google another text
# 2   1 2008-10-31  Yahoo        other
# 3   1 2008-11-02 Google another text
# 4   1 2008-11-02 Google         test
# 5   1 2008-11-02  Yahoo     text_sth
# 6   1 2008-11-05 Amazon    text here
# 7   2 2008-10-31 Amazon          etc
# 8   2 2008-11-01 Google         test
# 9   2 2008-11-02 Amazon another text
# 10  2 2008-11-03 Google    text here

注意:当然,您的出生日期也需要这样格式化,例如dframe1$date <- as.Date(dframe1$date)