是否有超快的方式將數據框行轉換爲列表元素？

Question

假設這樣一個數據幀：

> n <- 3 
> a <- data.frame(x=1:n,y=sample(letters,n,replace = T),stringsAsFactors = F) 
> rownames(a) <- paste0("p",1:n) 
> a 
    x y 
p1 1 a 
p2 2 e 
p3 3 b 

我希望將數據幀轉換爲像這樣的列表：

$p1 
$p1$x 
[1] 1 

$p1$y 
[1] "a" 


$p2 
$p2$x 
[1] 2 

$p2$y 
[1] "e" 


$p3 
$p3$x 
[1] 3 

$p3$y 
[1] "b" 

一個直觀的方式來進行這樣的改造是使用lapply遍歷所有的行，但它真的很慢。如果它是矩陣，另一種方法是apply(a,1,as.list)。我做了一些基準測試，他們表明apply的方法比lapply的方法快5倍。此外，我還測試了apply(a,1,as.vector,mode="list")的方法，它比as.list方法快4倍。不幸的是，它是一個具有不同類型列的數據框。

當數據幀的行數較大時，所有方法似乎都運行緩慢。有沒有辦法做得更快？ （使用RCPP如何？）

Answer 1

爲了記錄（自從你提到過「Rcpp」），我在C級添加了一個方法。加速大約是7倍;可能會有更好/更快的解決方案，但是 - 與評論意見一致 - 可能更適合規劃不同的方法，而不是試圖以特定的部分儘快製作出特定的部分，特別是如果難以獲得顯着的加速。

library(inline) 

ff <- cfunction(sig = c(R_df = "data.frame"), body = ' 
    R_len_t nr = LENGTH(VECTOR_ELT(R_df, 0)), nc = LENGTH(R_df); 

    SEXP ans; 
    PROTECT(ans = allocVector(VECSXP, nr)); 
    for(int i = 0; i < nr; i++) { 
     SET_VECTOR_ELT(ans, i, allocVector(VECSXP, nc)); 
     setAttrib(VECTOR_ELT(ans, i), R_NamesSymbol, 
        getAttrib(R_df, R_NamesSymbol)); 
    } 
    setAttrib(ans, R_NamesSymbol, getAttrib(R_df, R_RowNamesSymbol)); 

    for(int i = 0; i < nc; i++) { 
     SEXP tmp; 
     PROTECT(tmp = coerceVector(VECTOR_ELT(R_df, i), 
            TYPEOF(VECTOR_ELT(R_df, i)))); 
     switch(TYPEOF(tmp)) { 
      case LGLSXP: 
      case INTSXP: { 
       R_len_t *ptmp = INTEGER(tmp); 
       for(int j = 0; j < nr; j++) 
        SET_VECTOR_ELT(VECTOR_ELT(ans, j), i, 
            ScalarInteger(ptmp[j])); 
       break;    
      } 
      case REALSXP: { 
       double *ptmp = REAL(tmp); 
       for(int j = 0; j < nr; j++) 
        SET_VECTOR_ELT(VECTOR_ELT(ans, j), i, 
            ScalarReal(ptmp[j])); 
       break;    
      } 
      case STRSXP: { 
       for(int j = 0; j < nr; j++) 
        SET_VECTOR_ELT(VECTOR_ELT(ans, j), i, 
            ScalarString(STRING_ELT(tmp, j))); 
       break;    
      } 
     } 
     UNPROTECT(1); 
    } 

    UNPROTECT(1); 
    return(ans); 
') 

ff(a) 
#$p1 
#$p1$x 
#[1] 1 
# 
#$p1$y 
#[1] "k" 
# 
# 
#$p2 
#$p2$x 
#[1] 2 
# 
#$p2$y 
#[1] "o" 
# 
# 
#$p3 
#$p3$x 
#[1] 3 
# 
#$p3$y 
#[1] "l" 

而且隨着你那被證明是快速的方法（在評論中提到的）比較：

identical(setNames(do.call(Map, 
          c(function(...) 
           "names<-"(list(...), colnames(a)), a)), 
        row.names(a)), 
      ff(a)) 
#[1] TRUE 

而且在更大的 「data.frame」：

set.seed(101) 
DF = do.call(cbind.data.frame, 
      replicate(4, cbind.data.frame(x = I(sample(letters, 1e5, T)), 
              y = runif(1e5), 
              z = sample(1e5)), simplify = F)) 
names(DF) = make.unique(names(DF), "") 


identical(setNames(do.call(Map, 
          c(function(...) 
           "names<-"(list(...), colnames(DF)), DF)), 
        row.names(DF)), 
      ff(DF)) 
#[1] TRUE 
library(microbenchmark) 
microbenchmark(ans1 = setNames(do.call(Map, 
             c(function(...) 
              "names<-"(list(...), colnames(DF)), 
             DF)), 
           row.names(DF)), 
       ff(DF), 
       times = 10) 
#Unit: milliseconds 
# expr  min  lq median  uq  max neval 
# ans1 3504.1825 3862.4333 3931.0853 4063.691 4162.9370 10 
# ff(DF) 143.0398 340.6897 365.5144 404.475 498.3854 10 

Answer 2

從你的意見，我會建議要麼使用一個真正的數據庫，或使用包data.table：

DT <- data.table(name=c("Ken","Ashley"),type=c("A","B"),score=c(9,8)) 
setkey(DT, name) 
interests <- data.table(name=c("Ken", "Ashley"), 
       interests=list(c("reading","music"), c("dancing","swimming"))) 

DT[interests] 
#  name type score  interests 
#1: Ken A  9 reading,music 
#2: Ashley B  8 dancing,swimming 

需要注意的是其核心，這是一個列表：

unclass(DT[interests]) 
$name 
[1] "Ken" "Ashley" 

$type 
[1] "A" "B" 

$score 
[1] 9 8 

$interests 
$interests[[1]] 
[1] "reading" "music" 

$interests[[2]] 
[1] "dancing" "swimming" 


attr(,"row.names") 
[1] 1 2 
attr(,".internal.selfref") 
<pointer: 0x7fc7c4007978> 

Answer 3

它看起來像你想要的行被拆分成一個列表，然後在每個這些拆分行與列表中的所有元素。這是一種與OP的輸出相匹配的方法，但我認爲@ Roland's更有用。 sprintf的用途是解決由split完成的重新排序。這比apply(a, 1, as.list)解決方案的優勢在於，嵌套列表的各個元素是數字和字符，而apply強制所有元素都是字符（它形成了matrix）。

rows <- 1:nrow(a) 
breaks <- paste0("p", sprintf(paste0("%0", nchar(max(rows)), "d"), rows)) 
lapply(split(a, breaks), as.list) 

## $p1 
## $p1$x 
## [1] 1 
## 
## $p1$y 
## [1] "g" 
## 
## 
## $p2 
## $p2$x 
## [1] 2 
## 
## $p2$y 
## [1] "c" 
## 
## 
## $p3 
## $p3$x 
## [1] 3 
## 
## $p3$y 
## [1] "t"