Question

我无法在Stack Overflow上找到我的查询解决方案。 This post is similar，但我的数据集略有 - 而且重要的是 - 不同（因为我在我的分组变量中有多个时间＆＃39;）。

随着时间的推移，我对不同地点的生物进行了观察。这些网站进一步汇总到更大的区域，所以我想最终有一个我可以在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

因为这不涉及进行一系列涉及时间值对的intersection或unique调用，所以它应该比循环解决方案更有效：

# 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

Answer 2

您可以修改功能

dist2 <- function(df){
   Un1 <- unique(df$time)
   intersection <- numeric(length(Un1))
   both <- numeric(length(Un1))

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

dist2(df)
#    time intersection both
#1    1            0    4
#2    2            3    7
#3    3            3    8

Answer 3

这是我的记忆密集型提案

df <- rbind(df, within(df, {time = time + 1}))
ddply(df, ~time, summarize, intersect = sum(duplicated(site)), both = length(site)) -> res
res <- res[-nrow(res), ]
res

<强>输出：

  time intersect both
1    1         0    4
2    2         3    7
3    3         3    8

将0更改为NA并完成。

用于计算比较连续时间段的值的函数

3 个答案: