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

Question

我有一个由因子列组成的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"

- Rorschach

Answer 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 相同的数据，对函数进行（显然）表面上的更改后，我看到了不同的结果。只是在这里展示它们，以防有人感兴趣。Alexis 的答案（稍作修改）仍然领先。

函数：

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

- Frank

Answer 2

另一个想法——类似于Frank的——试图（1）避免对“data.table”行进行子集操作（我认为这肯定是有一些代价的），并且（2）在每次迭代中避免检查一个长度为nrow(dat)的向量是否存在NA。

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的比较：

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_laz

---

@Frank：经过初步的基准测试，“Reduce..”确实比你的第一种方法快，但我猜想每列进行“+”，“!”和“is.na”的三次读取会增加一些时间。我没有添加“max.col”，因为“microbenchmark(as.matrix(DAT1))”看起来已经足够慢了。 - alexis_laz

@TheTime：你在递归函数中使用了"data.table"吗？我在"data.table"子集上遇到了一些麻烦，先使用了as.list.data.table。 - alexis_laz

我遇到了和TheTime一样的问题，但是使用as.list解决了，是的。 - Frank

@TheTime：刚在想，使用for(i in length(x):1)可能可以避免对“x”进行迭代子集操作，但使用递归更新非NA索引会更加简洁。@Frank：我也尝试过x[, -length(x), with = FALSE]，但仍然在函数中遇到了一些问题。 - alexis_laz

使用你的想法添加了另一个基准测试，但是在循环中使用 set，速度有些更快。 - Frank

Answer 3

我们将 'data.frame' 转换为 'data.table' 并创建一列行 ID (setDT(df1, keep.rownames=TRUE))。我们使用 melt 将 'wide' 格式转换为 'long' 格式。按 'rn' 分组，如果 'value' 列中没有 NA 元素，则获取 'value' 的最后一个元素 (value[.N])，否则获取第一个 NA 之前的元素以获取 '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提到的那样，我们可以在melt函数中使用na.rm=TRUE来使代码更加简洁。

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

- akrun

---

@TheTime 很抱歉，我添加了一些解释。value 是在 melt 步骤后默认列名中的一个。 - akrun

这是我想出来的一个荒谬的东西。虽然我怀疑它值得回答：dat[, do.call(Map, c(function(...) tail(c(...)[!is.na(c(...))],1), lapply(dat,as.character)) )] - thelatemail

您可以在熔断中删除NA值：melt(dat[, r := .I], id="r", na.rm=TRUE)[, value[.N], by=r]。 - Frank

@TheTime，您可以对这些选项进行基准测试。 data.table中的melt速度很快，但我尚未对所有内容进行基准测试。 - akrun

@TheTime，你的.BY选项可能很慢，因为你在之前进行了按行操作。相反... dat[, colInd := Reduce(function(x,y) x+!is.na(y), .SD, init=0L)][, res := as.character(.SD[[.BY[[1]]]]), by=colInd]（不确定你是否想要更改它）。 - Frank

Answer 4

以下是一行基于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" 

- Colonel Beauvel

Answer 5

我不确定如何在@alexis的答案上进一步改进，除了已经由@Frank完成的内容，但是您使用基本R的原始方法并不太远离合理性能的东西。

以下是我喜欢的您方法的变体，因为（1）它相当快速，（2）不需要太多思考就可以弄清楚发生了什么：

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

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

- A5C1D2H2I1M1N2O1R2T1