Chức năng tính giá trị so sánh các khoảng thời gian tuần tự

Question

Tôi không thể tìm thấy giải pháp cho truy vấn của mình trên Stack Overflow. This post is similar, nhưng tập dữ liệu của tôi hơi - và quan trọng - khác nhau (trong đó tôi có nhiều biện pháp 'thời gian' trong biến nhóm của tôi).

Tôi có quan sát sinh vật tại các địa điểm khác nhau, theo thời gian. Các trang web được tổng hợp thêm vào các khu vực lớn hơn, vì vậy tôi muốn có một hàm tôi có thể gọi theo ddply để tóm tắt tập dữ liệu cho từng khoảng thời gian trong các khu vực địa lý. Tuy nhiên, tôi gặp khó khăn khi nhận được hàm tôi cần.

Câu hỏi

Làm thế nào để chu kỳ thông qua khoảng thời gian và so sánh với khoảng thời gian trước đó, tính toán giao điểm (tức là số 'trang web' xảy ra ở cả hai giai đoạn thời gian) và tổng các số xảy ra trong từng giai đoạn?

Toy bộ dữ liệu:

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) 

chức năng My

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) 

Những gì tôi nhận được:

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 

Những gì tôi mong đợi (! Hy vọng) để đạt được:

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

Khi tôi có một chức năng làm việc, tôi muốn sử dụng nó với ddply trên bộ tập dữ liệu để tính toán các giá trị cho mỗi khu vực.

Rất cám ơn mọi lời khuyên, mẹo, lời khuyên!

Tôi đang chạy:

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

Answer 1

Bạn có thể xác định số lần mỗi trang web xuất hiện tại mỗi lần với table chức năng:

(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 

Với một số thao tác đơn giản, bạn có thể tạo bảng có kích thước tương tự ns số lần một trang web xuất hiện trong khoảng thời gian trước đó:

(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 

Xác định số điểm tương đồng với phiên trước đó hoặc số lượng các trang web độc đáo trong phiên trước đó cộng với số lượng các trang web độc đáo trong lặp hiện tại rất đơn giản hoạt động vectorized:

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 

Bởi vì đây không liên quan đến thực hiện một loạt các intersection hoặc unique cuộc gọi liên quan đến cặp thời gian đánh giá cao nó nên hiệu quả hơn so với các giải pháp lặp:

# 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

Bạn có thể thay đổi chức năng

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

Đây là bộ nhớ đề nghị tập trung của tôi

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 

Thay đổi từ 0 đến NA và bạn đã hoàn tất.