2016-02-18 2 views
8

Meine Probe data.table sieht wie folgt ausKopieren Reihen innerhalb data.table basierend auf Zustand

Daten Start

library(data.table) 
x <- data.table(id = as.character(c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3)), 
      time = as.character(c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)), 
      status = c("P", "R", "R", "R", "R", "P", "P", "P", "R", "R", "P", "P", "R", "R", "R"), 
      balance = c(100, 90, 80, 70, 60, 320, 300, 250, 200, 100, 40, 34, 31, 29, 10), 
      employment = c("Y", "Y", "Y", "N", "N", "N", "N", "N", "N", "Y", "N", "Y", "Y", "Y", "Y") 
) 

Das Ziel ist es, die Informationen in der Spalt Gleichgewicht und Beschäftigung, wenn die kopieren Status migriert von "P" nach "R" mit "id". I.e. Ich möchte die Daten in der letzten Periode verwenden, in der eine ID "P" ist, und die vorhandenen Informationen für alle nächsten Perioden überschreiben, in denen die ID "R" ist.

Daher ist es das Ziel

Y <- data.table(id = as.character(c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3)), 
      time = as.character(c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)), 
      status =  c("P", "R", "R", "R", "R", "P", "P", "P", "R", "R", "P", "P", "R", "R", "R"), 
      balance = c(100, 100, 100, 100, 100, 320, 300, 250, 250, 250, 40, 34, 34, 34, 34), 
      employment = c("Y", "Y", "Y", "Y", "Y", "N", "N", "N", "N", "N", "N", "Y", "Y", "Y", "Y") 
) 

Hinweis: dieses data.table

Tor zu erhalten, dass die Spalten Zeit und Status itselft (und natürlich id) sind nicht betroffen.

Ich habe versucht, seq_len über IDs zu verwenden, dann diese Spalte auf Null setzen, wenn der Status "R ist und nach dem Maximalwert (nach ID) dieser Spalte suchen, um als Indikator zu verwenden, welche Zeile kopiert werden muss sind sicher, dass es ein schnellerer und besserer Weg, dies zu lösen. Vielleicht sogar ein Einzeiler.

Wenn irgendetwas mit mir bitte unklar ist

+1

Enthält alle ids immer mit 'P' anfangen? –

+0

Ja, nun, es beginnt immer mit einem Nicht-R-Buchstaben (in diesem Beispiel P) –

+0

Also der 'by' Teil ist egal Ich würde dann raten –

Antwort

12

einen Weg wissen lassen, dies zu tun ist, um die gewünschten Spalten NA einzustellen s wenn status == R und dann die letzte Beobachtung vorwärts (LOCF), da alle id s mit P starten, glaube ich nicht, dass Sie wirklich th tun müssen ist durch id und damit die Leistung zu verbessern. Hier ist ein Weg

## Define column names you want to modify 
cols <- c("balance", "employment") 

## Assign `NA`s when satus == "R" 
x[status == "R", (cols) := NA] 

## Carry the last observation forward and update by reference 
library(zoo) ## You could do this with base R too, just more writing 
x[, (cols) := lapply(.SD, na.locf), .SDcols = cols] 
+0

'j' sollte sein' (cols): = lapply (.SD, na.locf, na.rm = FALSE) 'in diesem Fall sollte – jangorecki

+0

' by = id' wahrscheinlich enthalten sein. Bei den angegebenen Daten ist es nicht erforderlich, nur weil die 'id' sortiert ist und nicht 'status == "R" 'auf der ersten Entität jeder' id '. – jangorecki

+0

@jangorecki nicht sicher in Bezug auf die ', na.rm = FALSE' und wenn Sie sicherstellen möchten, dass es geordnet ist, wird wahrscheinlich nur' Reihenfolge (id) 'in der' i'th Ausdruck viel effizienter. –

0

Dies funktioniert nur data.table verwenden, aber die Laufzeit ist viel langsamer als die locf Option David vorgeschlagen.

hash <- x[status == 'P', .(t = max(time)), .(i = id)] 
hash[,c('b', 'e') := x[i == id & t == time, .(balance, employment)], 
    .(i)] 
setnames(hash, 'i', 'id') 

x <- merge(x = x, 
      y = hash, 
      by = 'id') 

x[status == 'R', 
    `:=`(employment = e, 
     balance = b)] 
x[,`:=`(e = NULL, 
     b = NULL, 
     t = NULL)] 

print(all(x==y)) 
5

Hinzufügen auch klar data.table Lösung vs Zoo Lösung. Data.table Rolling Join scheint besser zu skalieren.

library(data.table) 
library(zoo) 

x = data.table(id = as.character(c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3)), 
       time = as.character(c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)), 
       status = c("P", "R", "R", "R", "R", "P", "P", "P", "R", "R", "P", "P", "R", "R", "R"), 
       balance = c(100, 90, 80, 70, 60, 320, 300, 250, 200, 100, 40, 34, 31, 29, 10), 
       employment = c("Y", "Y", "Y", "N", "N", "N", "N", "N", "N", "Y", "N", "Y", "Y", "Y", "Y") 
) 
y = data.table(id = as.character(c(1,1,1,1,1,2,2,2,2,2,3,3,3,3,3)), 
       time = as.character(c(1,2,3,4,5,1,2,3,4,5,1,2,3,4,5)), 
       status =  c("P", "R", "R", "R", "R", "P", "P", "P", "R", "R", "P", "P", "R", "R", "R"), 
       balance = c(100, 100, 100, 100, 100, 320, 300, 250, 250, 250, 40, 34, 34, 34, 34), 
       employment = c("Y", "Y", "Y", "Y", "Y", "N", "N", "N", "N", "N", "N", "Y", "Y", "Y", "Y") 
) 

zoo = function(x, by = "id", cols = c("balance", "employment")){ 
    x[status == "R", (cols) := NA] 
    x[, (cols) := lapply(.SD, na.locf, na.rm=FALSE), by = by, .SDcols = cols] 
} 

dt = function(x, by = "id", cols = c("balance", "employment")){ 
    x[, i := .I] 
    x[status == "R", (cols) := NA] 
    # Rdatatable/data.table#1217 
    x[, (cols) := x[status != "R"][x, .SD, roll = TRUE, on = c(by,"i"), .SDcols = cols] 
     ][, i := NULL] 
} 

all.equal(zoo(copy(x)), y, check.attributes = FALSE) 
# [1] TRUE 
all.equal(dt(copy(x)), y, check.attributes = FALSE) 
# [1] TRUE 

Und die Benchmark.

library(data.table) 
library(zoo) 

zoo = function(x, by = "id", cols = c("balance", "employment")){ 
    x[status == "R", (cols) := NA] 
    x[, (cols) := lapply(.SD, na.locf, na.rm=FALSE), by = by, .SDcols = cols] 
} 

dt = function(x, by = "id", cols = c("balance", "employment")){ 
    x[, i := .I] 
    x[status == "R", (cols) := NA] 
    # Rdatatable/data.table#1217 
    x[, (cols) := x[status != "R"][x, .SD, roll = , on = c(by,"i"), .SDcols = cols] 
     ][, i := NULL] 
} 

data = function(N, seed = 123){ 
    set.seed(seed) 
    data.table(id = as.character(sample(300, N, TRUE)), 
       time = as.character(sample(500, N, TRUE)), 
       status = sample(c("P","P","R","R","R"), N, TRUE), 
       balance = runif(N, 34, 300), 
       employment = sample(c("N","N","N","N","N"), N, TRUE)) 
} 

run_n = function(N){ 
    # zoo 
    x = data(N) 
    cat(sprintf("zoo %0.e:\n", N)) 
    print(system.time(
     zoor <- zoo(x) 
    )) 
    # data.table 
    x = data(N) 
    cat(sprintf("data.table %0.e:\n", N)) 
    print(system.time(
     dtr <- dt(x) 
    )) 
    # equal 
    isTRUE(all.equal(zoor, dtr, check.attributes = FALSE)) 
} 

sapply(c(1e4,1e5,1e6,1e7), run_n) 
#zoo 1e+04: 
# user system elapsed 
# 0.024 0.000 0.022 
#data.table 1e+04: 
# user system elapsed 
# 0.004 0.000 0.004 
#zoo 1e+05: 
# user system elapsed 
# 0.048 0.000 0.044 
#data.table 1e+05: 
# user system elapsed 
# 0.016 0.000 0.016 
#zoo 1e+06: 
# user system elapsed 
# 0.264 0.028 0.292 
#data.table 1e+06: 
# user system elapsed 
# 0.172 0.000 0.172 
#zoo 1e+07: 
# user system elapsed 
# 2.952 0.188 3.130 
#data.table 1e+07: 
# user system elapsed 
# 1.932 0.176 2.109 
#[1] TRUE TRUE TRUE TRUE 
+0

'x [ , (cols): = .SD [1], von = cumsum (status! = "R"), .SDcols = cols] 'ist auch eine Nicht-Zoo-Lösung. Ich denke, deine ist schneller, aber rolle nicht wirklich so (und weiß es auch nicht) – Frank

+0

@Frank Ich denke, Ihre Lösung wird nicht zu den erwarteten Ergebnissen führen. – jangorecki

+0

Es scheint für den Fall des OP sicherlich zu funktionieren. Nach dem Ausführen ist 'identical (x, Y)' wahr. Ich kann mir keinen Fall vorstellen, in dem es nicht funktionieren würde, also könntest du es vielleicht ausarbeiten ..? – Frank

Verwandte Themen