使用 data.table 提取行中的最后一个非缺失值答案

【问题标题】：Extract last non-missing value in row with data.table使用 data.table 提取行中的最后一个非缺失值
【发布时间】：2015-11-12 04:52:13
【问题描述】：

我有一个因子列的 data.table，我想提取每行中最后一个非缺失值的标签。这是一种典型的max.col 情况，但我不想在尝试使用 data.table 优化此代码时进行不必要的强制。真实数据也有其他类型的列。

这是一个例子，

## Some sample data
set.seed(0)
dat <- sapply(split(letters[1:25], rep.int(1:5, 5)), sample, size=8, replace=TRUE)
dat[upper.tri(dat)] <- NA
dat[4:5, 4:5] <- NA                              # the real data isnt nice and upper.triangular
dat <- data.frame(dat, stringsAsFactors = TRUE)  # factor columns

## So, it looks like this
setDT(dat)[]
#    X1 X2 X3 X4 X5
# 1:  u NA NA NA NA
# 2:  f  q NA NA NA
# 3:  f  b  w NA NA
# 4:  k  g  h NA NA
# 5:  u  b  r NA NA
# 6:  f  q  w  x  t
# 7:  u  g  h  i  e
# 8:  u  q  r  n  t

## I just want to get the labels of the factors
## that are 'rightmost' in each row.  I tried a number of things 
## that probably don't make sense here.
## This just about gets the column index
dat[, colInd := sum(!is.na(.SD)), by=1:nrow(dat)]

不过，我们的目标是提取这些标签，这里使用常规的基本函数。

## Using max.col and a data.frame
df1 <- as.data.frame(dat)
inds <- max.col(is.na(as.matrix(df1)), ties="first")-1
inds[inds==0] <- ncol(df1)
df1[cbind(1:nrow(df1), inds)]
# [1] "u" "q" "w" "h" "r" "t" "e" "t"

【问题讨论】：

标签： r data.table

【解决方案1】：

这是另一种方式：

dat[, res := NA_character_]
for (v in rev(names(dat))[-1]) dat[is.na(res), res := get(v)]


   X1 X2 X3 X4 X5 res
1:  u NA NA NA NA   u
2:  f  q NA NA NA   q
3:  f  b  w NA NA   w
4:  k  g  h NA NA   h
5:  u  b  r NA NA   r
6:  f  q  w  x  t   t
7:  u  g  h  i  e   e
8:  u  q  r  n  t   t

基准测试 使用与@alexis_laz 相同的数据并对函数进行（显然）表面上的更改，我看到了不同的结果。只是在这里展示它们以防有人好奇。亚历克西斯的回答（稍作修改）仍然在前面。

功能：

alex = function(x, ans = rep_len(NA, length(x[[1L]])), wh = seq_len(length(x[[1L]]))){
    if(!length(wh)) return(ans)
    ans[wh] = as.character(x[[length(x)]])[wh]
    Recall(x[-length(x)], ans, wh[is.na(ans[wh])])
}   

alex2 = function(x){
    x[, res := NA_character_]
    wh = x[, .I]
    for (v in (length(x)-1):1){
      if (!length(wh)) break
      set(x, j="res", i=wh, v = x[[v]][wh])
      wh = wh[is.na(x$res[wh])]
    }
    x$res
}

frank = function(x){
    x[, res := NA_character_]
    for(v in rev(names(x))[-1]) x[is.na(res), res := get(v)]
    return(x$res)       
}

frank2 = function(x){
    x[, res := NA_character_]
    for(v in rev(names(x))[-1]) x[is.na(res), res := .SD, .SDcols=v]
    x$res
}

示例数据和基准：

DAT1 = as.data.table(lapply(ceiling(seq(0, 1e4, length.out = 1e2)), 
                     function(n) c(rep(NA, n), sample(letters, 3e5 - n, TRUE))))
DAT2 = copy(DAT1)
DAT3 = as.list(copy(DAT1))
DAT4 = copy(DAT1)

library(microbenchmark)
microbenchmark(frank(DAT1), frank2(DAT2), alex(DAT3), alex2(DAT4), times = 30)

Unit: milliseconds
         expr       min        lq      mean    median         uq        max neval
  frank(DAT1) 850.05980 909.28314 985.71700 979.84230 1023.57049 1183.37898    30
 frank2(DAT2)  88.68229  93.40476 118.27959 107.69190  121.60257  346.48264    30
   alex(DAT3)  98.56861 109.36653 131.21195 131.20760  149.99347  183.43918    30
  alex2(DAT4)  26.14104  26.45840  30.79294  26.67951   31.24136   50.66723    30

【讨论】：

【解决方案2】：

另一个想法 - 类似于 Frank 的 - 尝试 (1) 避免对“data.table”行进行子集化（我认为这必须有一些成本）和 (2) 避免检查 length == nrow(dat) 向量中的 NAs在每次迭代中。

alex = function(x, ans = rep_len(NA, length(x[[1L]])), wh = seq_len(length(x[[1L]])))
{
    if(!length(wh)) return(ans)
    ans[wh] = as.character(x[[length(x)]])[wh]
    Recall(x[-length(x)], ans, wh[is.na(ans[wh])])
}   
alex(as.list(dat)) #had some trouble with 'data.table' subsetting
# [1] "u" "q" "w" "h" "r" "t" "e" "t"

并与弗兰克的比较：

frank = function(x)
{
    x[, res := NA_character_]
    for(v in rev(names(x))[-1]) x[is.na(res), res := get(v)]
    return(x$res)       
}

DAT1 = as.data.table(lapply(ceiling(seq(0, 1e4, length.out = 1e2)), 
                     function(n) c(rep(NA, n), sample(letters, 3e5 - n, TRUE))))
DAT2 = copy(DAT1)
microbenchmark::microbenchmark(alex(as.list(DAT1)), 
                               { frank(DAT2); DAT2[, res := NULL] }, 
                               times = 30)
#Unit: milliseconds
#                                            expr       min        lq    median        uq       max neval
#                             alex(as.list(DAT1))  102.9767  108.5134  117.6595  133.1849  166.9594    30
# {     frank(DAT2)     DAT2[, `:=`(res, NULL)] } 1413.3296 1455.1553 1497.3517 1540.8705 1685.0589    30
identical(alex(as.list(DAT1)), frank(DAT2))
#[1] TRUE

【讨论】：

是的，我从您之前的一篇文章中得到了我的想法。我想知道它与dat[, colInd := Reduce(function(x,y) x+!is.na(y), .SD, init=0L)][, res := as.character(.SD[[.BY[[1]]]]), by=colInd] 相比如何。对于几列和多行，我认为这种方式可能非常好。此外，OP 的 max.col 方法会很有趣。
@Frank ：通过粗略的基准测试，Reduce.. 确实比您的第一种方法更快，但是，我猜，+、! 和 is.na 的每一列的三重读取增加了一段时间。我没有添加max.col，因为microbenchmark(as.matrix(DAT1)) 开始时似乎足够慢。
@TheTime ：你在递归函数中使用了“data.table”吗？我在使用“data.table”子集时遇到了一些问题，首先使用了as.list.data.table。
我遇到了与 TheTime 相同的问题，但 as.list 解决了，是的。
根据您的想法添加了另一个基准测试，但与set 循环使用；它有点快。

【解决方案3】：

这是一个单一的base R 方法：

sapply(split(dat, seq(nrow(dat))), function(x) tail(x[!is.na(x)],1))
#  1   2   3   4   5   6   7   8 
#"u" "q" "w" "h" "r" "t" "e" "t"

【讨论】：

【解决方案4】：

我们将 'data.frame' 转换为 'data.table' 并创建一个行 id 列 (setDT(df1, keep.rownames=TRUE))。我们使用melt 将“宽”格式重塑为“长”格式。按'rn'分组，if'value'列中没有NA元素，我们得到'value'的最后一个元素（value[.N]）或else，我们得到第一个NA之前的元素'value' 以获取我们提取的 'V1' 列 ($V1)。

melt(setDT(df1, keep.rownames=TRUE), id.var='rn')[,
     if(!any(is.na(value))) value[.N] 
     else value[which(is.na(value))[1]-1], by =  rn]$V1
#[1] "u" "q" "w" "h" "r" "t" "e" "t"

万一，数据已经是data.table

dat[, rn := 1:.N]#create the 'rn' column
melt(dat, id.var='rn')[, #melt from wide to long format
     if(!any(is.na(value))) value[.N] 
     else value[which(is.na(value))[1]-1], by =  rn]$V1
#[1] "u" "q" "w" "h" "r" "t" "e" "t"

这是另一种选择

dat[, colInd := sum(!is.na(.SD)), by=1:nrow(dat)][
   , as.character(.SD[[.BY[[1]]]]), by=colInd]

或者正如 @Frank 在 cmets 中提到的那样，我们可以使用 melt 中的 na.rm=TRUE 并使其更紧凑

 melt(dat[, r := .I], id="r", na.rm=TRUE)[, value[.N], by=r]

【讨论】：

@TheTime 是的，你可以这样做，但如果我们必须从data.frame 转换为data.table，setDT 中的选项会很方便。
@TheTime 抱歉，我添加了一些解释。 value 来自melt 步骤之后的默认列名。
我想出了一些可笑的东西。我怀疑它是否值得回答：dat[, do.call(Map, c(function(...) tail(c(...)[!is.na(c(...))],1), lapply(dat,as.character)) )]
您可以将 NA 放入熔体中：melt(dat[, r := .I], id="r", na.rm=TRUE)[, value[.N], by=r]
@TheTime 您的 .BY 选项可能很慢，因为您在它之前执行了逐行操作。相反...dat[, colInd := Reduce(function(x,y) x+!is.na(y), .SD, init=0L)][, res := as.character(.SD[[.BY[[1]]]]), by=colInd]（不确定是否要更改它。）

【解决方案5】：

我不确定如何改进@alexis 的答案，超出@Frank 已经完成的工作，但是您使用base R 的原始方法与合理性能的东西相差不远。

这是我喜欢的你方法的一个变体，因为 (1) 它相当快，并且 (2) 它不需要太多思考就能弄清楚发生了什么：

as.matrix(dat)[cbind(1:nrow(dat), max.col(!is.na(dat), "last"))]

其中最昂贵的部分似乎是as.matrix(dat) 部分，但除此之外，它似乎比@akrun 共享的melt 方法更快。

【讨论】：