具有此数据框:
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
答案 0 :(得分:2)
如果我理解正确,则OP希望在id
,name
以及前一天或后一天找到匹配的条目。因此,非平等参加将无济于事,因为它将包括当天的比赛。
我建议使用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
数据集,并为每个date
和id
包含具有+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)
。