首页 文章

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

提问于
浏览 次
7

我一直无法在Stack Overflow上找到我的查询解决方案 . This post is similar，但我的数据集略有 - 而且重要的是 - 不同（因为我在我的分组变量中有多个'time'的度量） .

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

Question

如何循环通过时间段并与之前的时间段进行比较，计算交叉点（即两个时间段内发生的“站点”数量）和每个时间段内出现的数量之和？

Toy dataset:

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)

My function

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)

What I get:

dist2（df）
时间交叉点
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

What I expect (hoped!) to achieve:

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)
r function time plyr

3 回答

  • 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
    回复于
  • 4

    您可以修改该功能

    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
    回复于
  • 1

    这是我的记忆密集型提案

    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

    Output:

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

    将0更改为NA，您就完成了 .

    回复于

相关问题