Funktion zum Berechnen von Werten zum Vergleichen sequentieller Zeiträume

Question

Ich konnte keine Lösung für meine Abfrage auf Stack Overflow finden. This post is similar, aber mein Datensatz ist leicht - und wichtig - anders (ich habe mehrere Maße für 'Zeit' innerhalb meiner Gruppierungsvariablen).

Ich habe Beobachtungen von Organismen an verschiedenen Standorten, im Laufe der Zeit. Die Standorte werden weiter zu größeren Gebieten zusammengefasst, daher möchte ich eventuell eine Funktion haben, die ich in ddply aufrufen kann, um den Datensatz für jeden der Zeiträume innerhalb der geographischen Gebiete zusammenzufassen. Ich habe jedoch Probleme, die Funktion zu bekommen, die ich brauche.

Frage

Wie fahre ich durch Zeitperioden und mit dem vorherigen Zeitraum vergleichen, Berechnen der Kreuzung (dh Anzahl von ‚Sites‘ in beiden Zeiträumen auftritt) und die Summe der Zahl auftretenden jede Periode?

Toy-Datensatz:

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) 

Meine Funktion

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) 

Was erhalte ich:

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 

Was ich erwarte, dass (! Gehofft) zu erreichen:

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

Einmal habe ich eine Arbeitsfunktion haben, möchte ich es auf dem gesamten Datensatz mit ddply verwenden diese Werte für jeden Bereich zu berechnen.

Vielen Dank für Hinweise, Tipps, Ratschläge!

Ich betreibe:

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

Answer 1

Sie die Häufigkeit bestimmen kann jede Site zu jeder Zeit mit der table Funktion erschienen:

(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 

Mit ein paar einfachen Manipulationen können Sie gleichgroße Tabellen erstellen, die enthalten ns die Anzahl der Male erschien eine Seite des vorangegangenen Zeitraum:

(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 

Bestimmung der Anzahl der Websites, gemeinsam mit der vorherigen Iteration oder die Anzahl der einzigartigen Stellen in der vorherigen Iteration plus die Anzahl der einzigartigen Stellen in der aktuelle Iteration sind jetzt einfach vektorisiert Operationen:

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 

Da dies beinhaltet nicht eine Reihe von intersection oder unique Anrufen Paare von Zeit die Werte, die sie effizienter als Looping Lösungen sein sollten:

Hier

# 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

Sie die Funktion ändern können

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

ist mein Gedächtnis intensiver Vorschlag

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 

Ausgang:

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

Änderung 0 bis NA und du bist fertig.