Funzione per calcolare i valori di periodi di tempo sequenziali

Question

Non riesco a trovare una soluzione alla mia interrogazione su Stack Overflow. This post is similar, ma il mio set di dati è leggermente - e soprattutto - diverso (nel senso che ho più misure di "tempo" all'interno della mia variabile di raggruppamento).

Ho osservazioni di organismi in vari siti, nel tempo. I siti sono ulteriormente aggregati in aree più grandi, quindi desidero infine avere una funzione che posso chiamare in ddply per riassumere il set di dati per ciascuno dei periodi di tempo all'interno delle aree geografiche. Tuttavia, sto avendo problemi ad ottenere la funzione di cui ho bisogno.

Domanda

Come fare scorrere periodi di tempo e confrontarlo con il periodo di tempo precedente, calcolando l'intersezione (cioè il numero di 'siti' si verificano in entrambi i periodi di tempo) e la somma del numero che si verificano in ogni periodo?

Toy set di dati:

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) 

La mia funzione

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) 

Cosa ottengo:

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 

quello che mi aspetto (! Sperato) per ottenere:

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

Una volta che ho una funzione di lavoro, voglio usarlo con ddply su tutto il set di dati per calcolare questi valori per ogni area.

Molte grazie per eventuali suggerimenti, consigli, consigli!

Sono in esecuzione:

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

Answer 1

È possibile determinare il numero di volte in cui ciascun sito è apparso in ogni momento con la funzione 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 

Con alcune semplici manipolazioni, è possibile costruire una tabella di dimensioni simili che contenga ns il numero di volte in cui un sito è apparso nel precedente periodo di tempo:

(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 

Determinazione del numero di siti in comune con l'iterazione precedente o il numero di siti unici nella precedente iterazione più il numero di siti unici al iterazione corrente sono ora semplici operazioni vettorializzate:

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 

Poiché questo non comporta fare un mazzo di intersection o unique chiamate coinvolgono coppie di valori di tempo dovrebbe essere più efficiente rispetto alle soluzioni loop:

# 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

È possibile modificare la funzione

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

Qui è la mia memoria proposta intensiva

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 

uscita:

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

Change da 0 a NA e il gioco è fatto.