也许答案应该很明显,但是我有点卡住了。
我的数据看起来像这样:
> df <- data.frame(person = c("A", "B", "C"), start = c("2014-01-01", "2014-01-02", "2014-01-03"), stop = c("2014-01-05", "2014-01-06", "2014-01-04") )
> df
person start stop
1 A 2014-01-01 2014-01-05
2 B 2014-01-02 2014-01-06
3 C 2014-01-03 2014-01-04
最终,我想绘制某一天进行某项活动的总人数,但只计算每天的总人数(即,在知道开始日期和结束日期的情况下,计算每个日期的总发生次数)就可以解决。对于上面的数据,这是我正在寻找的答案:
Date Tally
2014-01-01 1
2014-01-02 2
2014-01-03 3
2014-01-04 3
2014-01-05 2
2014-01-06 1
我尝试过的一种方法是使用seq()生成所有日期,但这似乎不适用于长度> 1的开始/停止日期:
seq(df$start, df$stop, length = "1 day") ## Does not work
任何帮助将不胜感激。
最佳答案
可能是:
as.data.frame(table(unlist(apply(df[-1], 1,
function(x) as.character(seq(as.Date(x[1], "%Y-%m-%d"),
as.Date(x[2], "%Y-%m-%d"), "1 day"))))))
Var1 Freq
1 2014-01-01 1
2 2014-01-02 2
3 2014-01-03 3
4 2014-01-04 3
5 2014-01-05 2
6 2014-01-06 1
由于您正在寻找效率,因此可以通过避免一些瓶颈来加快相同的答案。首先,请注意,每次在
as.Date
循环中都调用apply
。这是因为在循环之前调用一次不会产生任何效果,因为apply
强制转换为矩阵,因此日期强制转换为字符,因此seq
会产生错误。其次,您可以避免为类“ Date”使用seq
的方法的开销。第三,您希望天数有所不同。这些都鼓励将日期转换为整数并在“数字”类上进行操作。f1 = function() { #keeping dates
as.data.frame(table(unlist(apply(df[-1], 1,
function(x) as.character(seq(as.Date(x[1], "%Y-%m-%d"),
as.Date(x[2], "%Y-%m-%d"), "1 day"))))))
}
f2 = function() { #using numeric
df$start = as.numeric(as.Date(df$start, "%Y-%m-%d"))
df$stop = as.numeric(as.Date(df$stop, "%Y-%m-%d"))
res = as.data.frame(table(unlist(apply(df[-1], 1,
function(x) seq(x[1], x[2])))))
res$Var1 = factor(as.Date(as.numeric(as.character(res$Var1)),
origin = "1970-01-01"))
res
}
f1()
# Var1 Freq
#1 2014-01-01 1
#2 2014-01-02 2
#3 2014-01-03 3
#4 2014-01-04 3
#5 2014-01-05 2
#6 2014-01-06 1
f2()
# Var1 Freq
#1 2014-01-01 1
#2 2014-01-02 2
#3 2014-01-03 3
#4 2014-01-04 3
#5 2014-01-05 2
#6 2014-01-06 1
并在更大的data.frame上进行基准测试:
df = data.frame(person = paste("ID", 1:1e3, sep = ""),
start = as.Date(sample(Sys.Date() : (Sys.Date()+10), 1e3, T),
origin = "1970-01-01"))
df$stop = df$start + 5
head(df)
# person start stop
#1 ID1 2014-03-07 2014-03-12
#2 ID2 2014-03-01 2014-03-06
#3 ID3 2014-03-04 2014-03-09
#4 ID4 2014-02-28 2014-03-05
#5 ID5 2014-02-27 2014-03-04
#6 ID6 2014-03-07 2014-03-12
identical(f1(), f2())
#[1] TRUE
library(microbenchmark)
microbenchmark(f1(), f2(), times = 10)
#Unit: milliseconds
# expr min lq median uq max neval
# f1() 366.90895 368.36777 379.78573 395.82724 410.17782 10
# f2() 31.66473 32.11122 33.04891 33.62642 35.75063 10