r - 计算比较连续时间段的值的函数

Question

我无法在 Stack Overflow 上找到我的查询的解决方案。 This post is similar ，但我的数据集略有不同(而且重要的是)(因为我的分组变量中有多种“时间”度量)。

随着时间的推移，我对不同地点的生物体进行了观察。这些站点进一步聚合成更大的区域，因此我希望最终有一个可以在 ddply 中调用的函数来汇总地理区域内每个时间段的数据集。但是，我无法获得所需的功能。

问题

如何循环时间段并与前一个时间段进行比较，计算交集(即两个时间段内出现的“站点”数量)以及每个时间段内出现的数量总和？

玩具数据集:

time = c(1,1,1,1,2,2,2,3,3,3,3,3)
site = c("A","B","C","D","A","B","C","A","B","C","D","E")
df <- as.data.frame(cbind(time,site))
df$time = as.numeric(df$time) 

我的功能

dist2 <- function(df){
  for(i in unique(df$time))
  {
    intersection <- length(which(df[df$time==i,"site"] %in% df[df$time==i-   1,"site"]))
    both <- length(unique(df[df$time==i,"site"])) + length(unique(df[df$time==i-1,"site"]))
  }
  return(as.data.frame(cbind(time,intersection,both)))
  }

dist2(df)

我得到了什么:

dist2(df)
   time intersection both
1     1            3    8
2     1            3    8
3     1            3    8
4     1            3    8
5     2            3    8
6     2            3    8
7     2            3    8
8     3            3    8
9     3            3    8
10    3            3    8
11    3            3    8
12    3            3    8

我期望(希望!)实现的目标:

time intersection both
1    1           NA    4
2    2            3    7
3    3            3    8

一旦我有了一个工作函数，我想在整个数据集上将它与 ddply 一起使用来计算每个区域的这些值。

非常感谢您的指点、提示和建议!

我正在运行:

R version 3.1.2 (2014-10-31)
Platform: x86_64-apple-darwin13.4.0 (64-bit)

Answer 1

您可以使用table函数确定每个网站每次出现的次数:

(tab <- table(df$time, df$site))
#     A B C D E
#   1 1 1 1 1 0
#   2 1 1 1 0 0
#   3 1 1 1 1 1

通过一些简单的操作，您可以构建相同大小的表，其中包含网站在前一时间段内出现的次数:

(prev.tab <- head(rbind(NA, tab), -1))
#    A  B  C  D  E
#   NA NA NA NA NA
# 1  1  1  1  1  0
# 2  1  1  1  0  0

确定与上一次迭代相同的站点数量或上一次迭代中的唯一站点数量加上当前迭代中的唯一站点数量现在是简单的矢量化操作:

data.frame(time=unique(df$time),
           intersection=rowSums(tab * (prev.tab >= 1)),
           both=rowSums(tab >= 1) + rowSums(prev.tab >= 1, na.rm=TRUE))
#   time intersection both
# 1    1           NA    4
# 2    2            3    7
# 3    3            3    8

因为这不涉及进行一堆涉及时间值对的交集或唯一调用，所以它应该比循环解决方案更有效:

# Slightly larger dataset with 100000 observations
set.seed(144)
df <- data.frame(time=sample(1:50, 100000, replace=TRUE),
                 site=sample(letters, 100000, replace=TRUE))
df <- df[order(df$time),]
josilber <- function(df) {
  tab <- table(df$time, df$site)
  prev.tab <- head(rbind(NA, tab), -1)
  data.frame(time=unique(df$time),
             intersection=rowSums(tab * (prev.tab >= 1)),
             both=rowSums(tab >= 1) + rowSums(prev.tab >= 1, na.rm=TRUE))
}
# dist2 from @akrun's solution
microbenchmark(josilber(df), dist2(df))
# Unit: milliseconds
#          expr       min        lq      mean    median         uq       max neval
#  josilber(df)  28.74353  32.78146  52.73928  40.89203   62.04933  237.7774   100
#     dist2(df) 540.78422 574.28319 829.04174 825.99418 1018.76561 1607.9460   100