我在data.frame中有两个日期（date1和date2）和一个id变量：
dat <- data.frame(c('2014-02-11', '2014-05-04', '2014-05-22'), c('2014-04-12', '2014-09-22', '2014-07-04'), c('a', 'a', 'b'))
names(dat) <- c('date1', 'date2', 'id')
dat$date1 <- as.character.Date(dat$date1, format = '%Y-%m-%d')
dat$date2 <- as.character.Date(dat$date2, format = '%Y-%m-%d')
> dat
date1 date2 id
1 2014-02-11 2014-04-12 a
2 2014-05-04 2014-09-22 a
3 2014-05-22 2014-07-04 b
我想创建一个新的变量var，它指示任何date2日期值是否在该行的date1日期值之前（不仅仅是紧接在它之前的date2值）：
> dat
date1 date2 id var
1 2014-02-11 2014-04-12 a 0
2 2014-05-04 2014-09-22 a 1
3 2014-05-22 2014-07-04 b 0
我已经能够通过以下循环实现这一目标：
ids <- as.vector(unique(unlist(dat$id)))
dat$var <- as.numeric(0)
for (i in ids) {
date2s <- as.vector(unlist(filter(dat, id == i)$date2))
for (j in date2s) {
dat <- dat %>% mutate(var = replace(var, (j < date1) & (id == i), 1)) # if any cdate precedes rdate
}
}
但是，我的数据集非常大，如果可能的话，我想用data.table实现这个目标，尽管如果有一种有效的方法，我很乐意用dplyr来解决这个问题。
建立在目前为止的其他三个答案......
library(data.table)
frank_first = function() dat[, v0 := as.logical(copy(.SD)[copy(.SD), on=.(id, date2 < date1), mult="first", .N, by=.EACHI]$N)]
frank_which = function() dat[, vw := !is.na(copy(.SD)[copy(.SD), on=.(id, date2 < date1), mult="first", which=TRUE])]
frank_any = function() dat[, v1 := .SD[copy(.SD), on=.(id, date2 < date1), .N, by=.EACHI]$N > 0L]
frank_min = function() dat[, v := as.logical(.SD[, min(date2), by=id][copy(.SD), on=.(id, V1 < date1), .N, by=.EACHI]$N)]
fun = function(x, y) x > min(y)
mtm <- function(df) {
df$var <- NA # new column, to be updated
split(df$var, df$id) <-
Map(fun, split(df$date1, df$id), split(df$date2, df$id))
df
}
由于copy，需要an open issue/bug的东西。
与chinsoon + Martin Morgan的数据基准：
set.seed(2L)
N <- 1e5
ng = 1e4
dat <- data.table(date1=sample(seq(as.Date("1970-01-01"), Sys.Date(), by="1 day"), N, replace=TRUE),
date2=sample(seq(as.Date("1970-01-01"), Sys.Date(), by="1 day"), N, replace=TRUE),
id=sample(ng, N, replace=TRUE))
df = data.frame(dat)
microbenchmark::microbenchmark(frank_first(), frank_which(), frank_any(), frank_min(), mtm(df), times=5L)
Unit: milliseconds
expr min lq mean median uq max neval cld
frank_first() 70.38654 70.72610 80.37284 73.33607 86.87363 100.54186 5 a
frank_which() 55.90631 57.16385 62.89525 61.82535 64.63895 74.94178 5 a
frank_any() 38.56254 39.42893 40.53816 39.85976 41.47074 43.36885 5 a
frank_min() 36.73850 36.90551 62.55768 45.44839 55.41056 138.28545 5 a
mtm(df) 186.44924 190.26654 209.38918 219.73829 224.06300 226.42884 5 b
所以min way（由Martin Morgan的答案推动）赢得了这个示例数据。
建议在@thelatemail建议的自我加入后使用.EACHI
dat[dat, .(date1=i.date1, date2=i.date2, var=any(date2 < i.date1)), by=.EACHI, on=.(id)]
# id date1 date2 var
#1: a 2014-02-11 2014-04-12 FALSE
#2: a 2014-05-04 2014-09-22 TRUE
#3: b 2014-05-22 2014-07-04 FALSE
编辑：一些时间供参考
set.seed(2L)
N <- 1e5
dat <- data.table(date1=sample(seq(as.Date("1970-01-01"), Sys.Date(), by="1 day"), N, replace=TRUE),
date2=sample(seq(as.Date("1970-01-01"), Sys.Date(), by="1 day"), N, replace=TRUE),
id=sample(letters, N, replace=TRUE))
dt1 <- copy(dat)
tlmMtd <- function() {
dt1[, rownum := .I]
dt1[dt1[dt1, on="id", rownum[i.date2 < date1], allow.cartesian=TRUE], hit := 1]
}
dt2 <- copy(dat)
csMtd <- function() dt2[dt2, .(date1=i.date1, date2=i.date2, var=any(date2 < i.date1)), by=.EACHI, on=.(id)]
dt3 <- copy(dat)
frankMtd <- function() dt3[, v := .SD[copy(.SD), on=.(id, date2 < date1), .N, by=.EACHI]$N > 0L]
microbenchmark::microbenchmark(
tlmMtd(),
csMtd(),
frankMtd(),
times=5L)
# Unit: milliseconds
# expr min lq mean median uq max neval
# tlmMtd() 18528.9799 18652.2217 23486.4213 19116.8014 21140.5923 39993.511 5
# csMtd() 3801.2146 3943.6201 4984.6274 5341.4322 5673.6878 6163.182 5
# frankMtd() 176.4477 177.5576 191.9636 178.9564 182.0311 244.825 5
我很确定这可以通过data.table的自我加入来实现。例如。：
library(data.table)
setDT(dat)
dat[, rownum := .I]
dat[dat[dat, on="id", rownum[i.date2 < date1]], hit := 1]
dat
# date1 date2 id rownum hit
#1: 2014-02-11 2014-04-12 a 1 NA
#2: 2014-05-04 2014-09-22 a 2 1
#3: 2014-05-22 2014-07-04 b 3 NA
我基本上创建一个行引用号，然后将表连接到自身on "id"，找到日期比较符合预期的行，然后使用这些行号分配最终的hit变量。
既不是data.table也不是dplyr，而是首先编写一个函数来做你想要的假设列没有分组
function(x, y)
as.Date(x) > min(as.Date(y))
然后使用split()将数据分成组，Map()将函数应用于每个组，并使用split<-()分配新值
answer <- logical(nrow(dat))
split(answer, dat$id) <-
Map(fun, split(dat$date1, dat$id), split(dat$date2, dat$id))
即使数据量很大，这也会相对有效，只要没有太多的组。不确定为什么日期被转换为样本数据中的字符; fun()可以另外推广。
对于使用@ chinsoon12中的数据进行计时（实际上只有几个组），我有
df <- as.data.frame(dat)
mtm1 <- function(df) {
answer <- logical(nrow(dat))
split(answer, df$id) <-
Map(fun, split(df$date1, df$id), split(df$date2, df$id))
answer
}
同
> identical(mtm1(df), frankMtd()$v)
[1] TRUE
> microbenchmark::microbenchmark(frankMtd(), mtm(df), times=5L)
Unit: milliseconds
expr min lq mean median uq max
frankMtd() 1917.95697 1927.2548 1928.65821 1928.45893 1933.34159 1936.27878
mtm1(df) 47.00293 47.0198 48.02849 47.10012 47.18432 51.83523
neval cld
5 b
5 a
如果有1000组（id = sample(1000, N, replace = TRUE)），则时间更均匀
Unit: milliseconds
expr min lq mean median uq max neval
frankMtd() 140.87859 140.88647 141.97093 141.86977 142.28619 143.9336 5
mtm1(df) 61.82032 64.55505 64.61313 65.53642 65.53768 65.6162 5
cld
b
a
通过将Date值向量化强制转换为数字，可以获得相当大的加速
mtm2 <- function(df) {
answer <- logical(nrow(df))
split(answer, df$id) <- Map(
function(x, y) x > min(y),
split(as.numeric(df$date1), df$id),
split(as.numeric(df$date2), df$id)
)
answer
}
在1e4组中有1e5值，id是一个因子（），与最快的frank_*()相比，结果是
> identical(frank_any()$v, mtm1(df))
[1] TRUE
> identical(frank_any()$v, mtm2(df))
[1] TRUE
和
Unit: milliseconds
expr min lq mean median uq max neval
frank_any() 79.90262 80.43112 81.79228 81.18565 83.18963 84.25236 5
mtm1(df) 237.00027 241.40299 244.83638 246.26495 249.47713 250.03658 5
mtm2(df) 44.11074 46.17133 51.26976 47.03285 52.77204 66.26184 5
cld
b
c
a