Question

我的示例data.table如下所示

开始数据

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

目标是在状态从“P”迁移到“R”并通过“id”复制列平衡和就业中的信息。即我想使用id为“P”的最后一个时期的数据，并覆盖id为“R”的所有下一个时期的现有信息。

因此，目标是获得此数据。表

目标

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

请注意，列时间和状态itselft（当然还有id）不受影响。

我试图在id中使用seq_len，如果status为“R并且搜索此列的最大值（按id），则将此列设置为零，以用作指示哪一行必须为复制。我确信有一种更快更好的方法可以解决这个问题。甚至可能是单行。

如果有什么不清楚请告诉我

Answer 1

执行此操作的一种方法是在NA时将所需列设置为status == R，然后向前移动最后一个观察点（LOCF），因为所有id都以{开头{ {1}}，我认为您不需要P执行此操作，因此可以提高性能。这是一种方式

id

Answer 2

添加简单的data.table解决方案vs zoo解决方案。 Data.table滚动连接似乎更好地扩展。

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

和基准。

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

Answer 3

这只能使用data.table，但运行时间远比David提出的locf选项慢。

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

根据条件复制data.table中的行

3 个答案: