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" 

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

我々は 'data.table' から 'data.frame' に変換し、行IDカラム（setDT(df1, keep.rownames=TRUE)）を作成します。我々はmeltで 'ワイド'から 'ロング'フォーマットに変更します。 'value'の最後の要素（value[.N]）またはelseを取得すると、 'value'の最初の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] 

Answer 3

ここに1つのライナー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 4

（を試みるFrank's-に-similarもう一つのアイデア1） 'data.table'行を部分集合化することを避けるために（私はいくらかのコストが必要であると仮定します）、（2）tすべての反復でNA秒のlength == nrow(dat)ベクトルをチェックしないでください。

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 

Answer 5

私は@Frankはすでに行っているもの以外、@アレクシスの答えを改善する方法がわからないんだけど、基本Rを使用して独創的なアプローチではありませんでした合理的に実行可能なものから離れすぎている。ここで

は、（1）それは合理的に速いですし、（2）それはあまりにも起こっているのかを把握するために考えを必要としないので、私は気に入ってあなたのアプローチの変種です：

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

最も高価な部分これはas.matrix(dat)部分であると思われますが、それ以外の場合は、@akrunを共有するmeltのアプローチよりも速いと思われます。