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

我有一个由factor列组成的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)]

##一些示例数据
种子集（0）
dat我们将“data.frame”转换为“data.table”，并创建一个行id列（
setDT（df1，keep.rownames=TRUE）
）。我们使用
melt
将“宽”格式改为“长”格式。按“rn”分组，
如果“value”列中没有
NA
元素，我们将得到“value”的最后一个元素（
value[.N]
）或
else
，我们将得到“value”中第一个NA之前的元素，以得到我们提取的“V1”列（
$V1
）

在这种情况下，数据已经是
数据。表

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在评论中提到的，我们可以使用
na.rm=TRUE
from
melt
并使其更加紧凑

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

还有一种方法：

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

这里是一个单行
基本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" 

另一个想法——类似于Frank的想法——尝试（1）避免对“data.table”行进行子集设置（我认为这肯定有一定的成本）和（2）避免在每次迭代中检查
length==nrow（dat）
向量的
NA
s

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

我不知道如何改进@alexis的答案，使之超越@Frank已经做过的，但您最初使用base R的方法与合理的性能相差不远

我喜欢你的方法的一个变体，因为（1）它相当快，（2）它不需要太多的思考来弄清楚发生了什么：

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

这其中最昂贵的部分似乎是
as.matrix（dat）
部分，但除此之外，它似乎比@akrun共享的
melt
方法要快。
@时间是的，你可以这样做，但是如果我们必须从
data.frame
转换到
data.table
，
setDT
中的选项会很方便。@很抱歉，我添加了一些解释。
值
来自
melt
步骤后的默认列名。不过，我怀疑它是否值得回答：
dat[，do.call（Map，c（function（…）tail（c（…）[！is.na（c（…）]），1），lappy（dat，as.character））]
你可以在melt中删除NAs:
melt（dat[，r:=.I]，id=“r”，na.rm=TRUE）[，value[.N]，by=r]
@时间你的.by选项可能很慢，因为你在它前面做了一个按行操作。相反
dat[，colInd:=Reduce（函数（x，y）x+！is.na（y），.SD，init=0L）][，res:=as.character（.SD[.BY[[1]]]），BY=colInd]
（不确定是否要更改）。是的，我是从你以前的一篇帖子中得到我的想法的。我想知道它与dat[，colInd:=Reduce（函数（x，y）x+！is.na（y），.SD，init=0L）][，res:=as.character（.SD[.BY[[1]]]），BY=colInd]
相比如何。对于几列和许多列，我认为这种方式可能是相当好的。另外，OP的
max.col
方法也会很有趣。@Frank：有了一个粗略的基准，
Reduce..
确实比第一种方法快，但是，我想，
+
的每一列的三读速度，
和
是。na
会增加一些时间。我没有添加
max.col
，因为
microbenchmark（as.matrix（DAT1））
一开始似乎足够慢。@时间：在递归函数中使用了“data.table”吗？我在“data.table”子集设置方面遇到了一些问题，首先使用了
as.list.data.table
。我遇到了与时间相同的问题，但是
as.list
解决了它，是的。用您的想法添加了另一个基准，但与
set
处于循环中；稍微快一点。
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

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