Kopiowanie wierszy wewnątrz data.table na podstawie stanu

Question

Moja próbka data.table wygląda następująco

Zaczynając danych

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") 
) 

Celem jest, aby skopiować informacje w bilansie kolumnami i zatrudnienia, jeżeli status migruje z "P" do "R" przez "id". To znaczy. Chciałbym użyć danych z ostatniego okresu, w którym identyfikator to "P" i zastąpić istniejące informacje dla wszystkich kolejnych okresów, w których identyfikator to "R".

Stąd celem jest uzyskanie tego data.table

celem

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") 
) 

zauważyć, że czas kolumny i status itselft (i oczywiście id) nie zostaną naruszone.

Próbowałem użyć seq_len przez id, a następnie ustawić tę kolumnę na zero, jeśli status to "R i wyszukaj maksymalną wartość (według id) tej kolumny, aby użyć jej jako wskaźnika, który wiersz musi zostać skopiowany. jestem pewien, że jest szybszy i lepszy sposób, aby rozwiązać ten problem. Może nawet jednego-liner.

Jeśli coś jest niejasne, proszę dać mi znać

Answer 1

jednym ze sposobów, aby to zrobić, to ustawić żądane kolumny do NA s kiedy status == R, a następnie przenieść ostatnią obserwację do przodu (LOCF), ponieważ wszystkie id s zaczynają się od P, nie sądzę, że naprawdę trzeba zrobić jest przez id, a tym samym poprawić wydajność. Oto sposób

## 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] 

Answer 2

ta działa tylko przy użyciu data.table, ale czas pracy jest znacznie wolniejszy niż opcja locf David proponowanej.

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)) 

Answer 3

Dodanie również rozwiązania plain data.table vs zoo. Łączenie stopniowe danych.table wydaje się skalować lepiej.

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 

a benchmarku.

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