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"

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相同的数据并对函数进行（显然）表面更改，我看到了不同的结果。只是在这里展示它们以防万一有人好奇。亚历克西斯的答案（经过小幅修改）仍然存在。

功能：

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

Answer 2

另一个想法 - 类似于Frank＆＃39; s - 试图（1）避免子集化数据。表格＆＃39;行（我假设必须有一些成本）和（2）避免在每次迭代中检查length == nrow(dat)的{{1}}向量。

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"

Answer 3

我们转换了＆＃39; data.frame＆＃39;到＆＃39; data.table＆＃39;并创建一个行id列（setDT(df1, keep.rownames=TRUE)）。我们重新塑造了“广泛的”。长期＆＃39;格式为melt。由＆＃39;，if分组，＆＃39;值＆＃39;中没有NA个元素。专栏，我们得到了＆＃39; value＆＃39;的最后一个元素。（value[.N]）或else，我们在＆＃39;值＆＃39;中获得第一个NA之前的元素获得＆＃39; V1＆＃39;列，我们提取（$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，我们可以使用na.rm=TRUE中的melt并使其更紧凑

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

Answer 4

以下是单行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"

Answer 5

我不确定如何改进@ alexis的答案超出了@Frank已经做过的事情，但是你对基础R的原始方法与合理的性能相差太远。

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

font

最昂贵的部分似乎是as.matrix(dat)[cbind(1:nrow(dat), max.col(!is.na(dat), "last"))]部分，但除此之外，它似乎比@akrun共享的as.matrix(dat)方法更快。

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

5 个答案: