Minimum je Spaltenfilterung als neue Spalte in R

[Bonanca]

Hiho @All,

leider habe ich keine Hinweise zu dieser konkreten Frage gefunden, daher hoffe ich, dass mir hier jemand helfen kann.
Ich habe in R ein dataframe df mit einer Identifikationsnummer ID und einer Jahreszahl YEAR, wobei die ID mehrfach auftaucht mit steigender Jahreszahl:

ID	YEAR
1	2018
1	2019
1	2020
2	2019
2	2020
3	2017
3	2018
3	2019
3	2020

Jetzt möchte ich eine neue Spalte hinzufügen, welche für jede ID das aus der Liste kleinste Jahr mit der ID liefert, d.h.

ID	YEAR	MIN_YEAR
1	2018	2018
1	2019	2018
1	2020	2018
2	2019	2019
2	2020	2019
3	2017	2017
3	2018	2017
3	2019	2017
3	2020	2017

Mithilfe von

min( df[df$ID == df[2, "ID"] , "YEAR" )

erhalte ich das Minimale Jahr für die ID aus Spalte 2. Das ganze kann ich jetzt natürlich für alle 400.000 Zeilen in meinem echten Anwendungsfall als Schleife durchgehen, ein leeres Dataframe damit befüllen und dann mithilfe von cbind anhängen, d.h.

buffer <- data.frame()
for (id in df$ID) {
    buffer <- rbind(buffer, min( df[df$ID == id , "YEAR"] ) )
}
df <- cbind(df, buffer)

Funktioniert, dauert aber auch entsprechend ~30 Minuten und fühlt sich zu umständlich an, um richtig zu sein

Welche schnellere Möglichkeite gibt es, die gewünschte Spalte zu erhalten?
Gibt es eine Möglichkeit, die gewünschte Spalte vllt sogar direkt mit einer Zeile (Code) zu erhalten?

MfG
Bonanca

 

[AW4]

Wenn du die Ergebnisse nur einmal von allen IDs brauchst, dann geh die Liste sequentiell durch und merk dir in geeigneter Datenstruktur zu jeder ID das kleinste Jahr.

Wenn du immer wieder mal das kleinste Jahr von einer ID oder ein paar IDs brauchst, dann würde eine sortierte Liste schon etwas helfen (da du weißt, dass du die Schleife beenden kannst, wenn sich die ID wechselt) und sowas wie eine Hash Map noch etwas mehr (weil die ID-Liste kleiner ist als eine Liste IDs+Jahr).

Dazu muss ich aber sagen, dass ich keinerlei Erfahrung in Sachen R habe und wie einfach es da wäre eine Hash Map zu bauen, wenn es keine oder keine geeignete gibt.

 

[BeBur]

Idee/Vorschlag:
1. Group_by ID um MIN_YEAR zu erhalten
2. Ergebnis in dict/hash table(?)/key-value-structure speichern (keys: ID, values: MIN YEAR)
3. Je Zeile entsprechend dem hash table das gewünschte Ergebnis generieren.

Dein Ansatz sieht nach potenziell O(n^2) (jdfs schlechter als linear) aus, falls das stimmt wärst du fein raus, weil dann jeder Ansatz der das vermeidet dein Ziel erfüllt.

Falls die Daten aus einer Datenbank kommen würde ich das ganze allerdings in SQL realisieren, das ist nicht so schwer und voraussichtlich sehr performant.

 

[BAGZZlash]

Ich würde vorschlagen, wenigstens nicht über die Zeilen, sondern über die IDs zu iterieren. Wie viel das bringt, hängt davon ab, wie das Mengenverhältnis von IDs zu Zeilen aussieht. Etwa so:

# Ausgangssituation herstellen:

ID <- c(1, 1, 1, 2, 2, 3, 3, 3, 3)
Year <- c(2018, 2019, 2020, 2019, 2020, 2017, 2018, 2019, 2020)

df <- data.frame(cbind(ID, Year))

############################################################################

# Hier geht's los:

MinYears <- as.numeric()

for (i in 1:length(unique(df$ID))) MinYears[i] <- min(df[df$ID == i, ]$Year)

df$MinYear <- NA
df$MinYear[1:nrow(df)] <- MinYears[df$ID[1:nrow(df)]]

Statt der for-Schleife kann man das bestimmt auch mit der Magie der apply-Funktion (und Konsorten, lapply etc.) machen, aber das, fürchte ich, wird für mich immer ein Buch mit sieben Siegeln bleiben... 😏

Ach so, und dann gibt's ja noch Parallelisierung, damit der Threadripper mal was zu tun bekommt. Hier mal, dank SNOW, sogar mit hübscher Progressbar:

# Ausgangssituation herstellen:

ID <- c(1, 1, 1, 2, 2, 3, 3, 3, 3)
Year <- c(2018, 2019, 2020, 2019, 2020, 2017, 2018, 2019, 2020)

df <- data.frame(cbind(ID, Year))

############################################################################

# Hier geht's los:

library(parallel)
library(doSNOW)

NumCores <- detectCores() - 1
cl <- makeCluster(NumCores)
clusterExport(cl, "df")
registerDoSNOW(cl)

iterations <- length(unique(df$ID))
pb <- txtProgressBar(max = iterations, style = 3)
progress <- function(n) setTxtProgressBar(pb, n)
opts <- list(progress = progress)
MinYears <- foreach(i = 1:iterations, .combine = rbind, .options.snow = opts) %dopar% min(df[df$ID == i, ]$Year)

close(pb)
stopCluster(cl)

df$MinYear <- NA
df$MinYear[1:nrow(df)] <- MinYears[df$ID[1:nrow(df)]]

/edit: Okay, ich hab' mir mal ein Benchmarkszenario erstellt mit, wie Du sagst, knapp 400.000 Zeilen. Die Datei ist auch hier angehängt. Der Code unten kommt zu diesen Ergebnissen:

Bonanca() benötigt 1550 Sekunden (25,8 Minuten), BAGZZlash1() dauert 180 Sekunden (3 Minuten) und BAGZZlash2() braucht 87 Sekunden (1,5 Minuten). Bei letzterem ist etwas Overhead für das Laden der Libraries enthalten. Rechner ist ein Ryzen 5 1600X, d.h. 11 Threads im parallelisierten Szenario.

Hier der Code:

load("C:/Temp/df.RData")

###########################################

Bonanca <- function()
{
    buffer <- data.frame()
    for (id in df$ID) {
        buffer <- rbind(buffer, min( df[df$ID == id , "Year"] ) )
    }
    df <- cbind(df, buffer)
   
    return(df)
}

###########################################

BAGZZlash1 <- function()
{
    MinYears <- as.numeric()

    for (i in 1:length(unique(df$ID))) MinYears[i] <- min(df[df$ID == i, ]$Year)

    df$MinYear <- NA
    df$MinYear[1:nrow(df)] <- MinYears[df$ID[1:nrow(df)]]
   
    return(df)
}

###########################################

BAGZZlash2 <- function(df)
{
    suppressPackageStartupMessages(library(parallel))
    suppressPackageStartupMessages(library(doSNOW))

    NumCores <- detectCores() - 1
    cl <- makeCluster(NumCores)
    clusterExport(cl, "df")
    registerDoSNOW(cl)

    iterations <- length(unique(df$ID))
    pb <- txtProgressBar(max = iterations, style = 3)
    progress <- function(n) setTxtProgressBar(pb, n)
    opts <- list(progress = progress)
    MinYears <- foreach(i = 1:iterations, .combine = rbind, .options.snow = opts) %dopar% min(df[df$ID == i, ]$Year)

    close(pb)
    stopCluster(cl)

    df$MinYear <- NA
    df$MinYear[1:nrow(df)] <- MinYears[df$ID[1:nrow(df)]]

    return(df)
}

###########################################

system.time(Test1 <- Bonanca())
system.time(Test2 <- BAGZZlash1())
system.time(Test3 <- BAGZZlash2(df))

 

[firespot]

Ich hoffe ich erledige da keine Hausaufgabe für dich ...

Effizientes R ist meist grundlegend anders als viele andere Hochsprachen. Generell gilt: Vermeide low-level Funktionalität wie Schleifen wo immer es geht, und nutze stattdessen die R-internen, higher-level Funktionen (das heißt natürlich auch, dass du dich mit einem Basispaket dieser higher-level Funktionen auseinandersetzen musst). Statt Schleifen nimmt man in R üblicherweise die apply-Gefährten, wie z.B. apply, sapply, tapply, lapply, by, etc.

Deine Aufgabe in einer einzigen Codezeile zu erledigen ist zwar auch mit diesen Gefährten etwas gar ambitioniert (mit brutaler Formatierung aber möglich ), aber mehr als 3 sauber lesbare Zeilen brauchts nicht - und selbst bei 400.000 Einträgen ist es bei mir in Windeseile (< 0.1 Sekunden) durchgerechnet:

# Überprüfen dass die Spalten in df sinnvolle Datentypen enthalten
# falls nicht, vorher konvertieren, z.B:
#   df$ID <- as.factor(as.integer(df$ID))
#   df$YEAR <- as.integer(df$YEAR)
stopifnot(is.factor(df$ID) || is.integer(df$ID))
stopifnot(is.numeric(df$YEAR)) # integer als Datentyp wäre logischer (Jahreszahl), numeric geht aber prinzipiell auch

MinYearTable <- tapply(df$YEAR, df$ID, min) # minimales Jahr pro ID
Mapping <- match(df$ID, names(MinYearTable)) # mapping zwischen den Zeilen in df und den Einträgen in MinYearTable
df$MIN_YEAR <- MinYearTable[Mapping] # Zielspalte erstellen

Sollte die anzuwendende Funktion (hier: min) auf mehrere Spalten des data.frames Zugriff benötigen (anstatt nur auf df$YEAR), dann kann "by" der richtige Gefährte sein.

 

[BAGZZlash]

Hammer, dat isset! You the man!

 

[firespot]

Gerne

@Bonanca: Falls es dich interessiert: Der wirkliche Grund für den Performanceeinbruch bei deiner Version war weniger die Nutzung einer Schleife an sich, als dass:
a) deine Schleife jede Zeile des df durchackert, anstatt nur ID-weise
b) deine Lese- und Schreib-operationen sich auf data.frame-Level bezogen haben, anstatt auf vector-Level

Wenn man deine Schleife leicht modifiziert sodass sie entsprechend dieser Hinweise:
a) ID-weise arbeitet (durch das "unique" im Schleifenkopf); und
b) das Zielobjekt (hier: buffer) bzw. der Schleifen-body ausschließlich vector-weise statt data.frame-weise arbeiten,
dann wird die Performance plötzlich dramatisch ansteigen (bei mir ist die Laufzeit dann im Sekundenbereich, aber das hängt im Detail von der Anzahl der insgesamt vorhandenen IDs ab; du siehst aber es ist viel schneller als die Urversion, wenngleich langsamer als die tapply & match Version):

buffer <- rep(NA, nrow(df))
for (id in unique(df$ID)) {
    w <- which(df$ID == id)
    buffer[w] <- min(df$YEAR[w])
}
df$MIN_YEAR = buffer

 

[BAGZZlash]

Wenn man deine Schleife leicht modifiziert

Hm, diese Version dauert bei mir 113 Sekunden.

 

[firespot]

Hm, diese Version dauert bei mir 113 Sekunden.

Im Detail kommts v.a. auf die Anzahl an unterschiedlichen IDs an (siehe:

length(unique(df$ID))

); je mehr desto mehr individuelle Schleifendurchläufe brauchts. Aber schneller als 30 Minuten wirds in Summe auch für den Anwendungsfall des OP werden

 

[ogi.nic]

Mal eine andere Version ohne Schleifen mit lapply und split:

# split(), lapply() und unlist():
split(df$YEAR, df$ID)
lapply(split(df$YEAR, df$ID), min)
unlist(lapply(split(df$YEAR, df$ID), min))

# Eigentlicher code (rep() sollte klar sein):
year.min <- unlist(lapply(split(df$YEAR, df$ID), min))
year.n   <- unlist(lapply(split(df$YEAR, df$ID), length))
year.out <- rep(year.min, year.n)
df.new   <- cbind(df, min.year = year.out)

Funktioniert solange df nach ID sortiert ist (ggf. anpassen).
Schleifen in R soweit möglich vermeiden, so dauert's ein paar ms ...