data.frame baris ke daftar

Saya memiliki data.frame yang ingin saya ubah menjadi daftar per baris, yang berarti setiap baris akan sesuai dengan elemen daftarnya sendiri. Dengan kata lain, saya ingin daftar yang sepanjang data.frame memiliki baris.

Sejauh ini, saya telah mengatasi masalah ini dengan cara berikut, tetapi saya bertanya-tanya apakah ada cara yang lebih baik untuk melakukan ini.

xy.df <- data.frame(x = runif(10),  y = runif(10))

# pre-allocate a list and fill it with a loop
xy.list <- vector("list", nrow(xy.df))
for (i in 1:nrow(xy.df)) {
    xy.list[[i]] <- xy.df[i,]
}

Seperti ini:

xy.list <- split(xy.df, seq(nrow(xy.df)))

Dan jika Anda ingin nama baris xy.dfmenjadi nama daftar keluaran, Anda dapat melakukan:

xy.list <- setNames(split(xy.df, seq(nrow(xy.df))), rownames(xy.df))

Eureka!

xy.list <- as.list(as.data.frame(t(xy.df)))

Jika Anda ingin sepenuhnya menyalahgunakan data.frame (seperti yang saya lakukan) dan ingin mempertahankan fungsionalitas $, salah satu caranya adalah dengan membagi data.frame Anda menjadi satu baris data.frames yang dikumpulkan dalam daftar:

> df = data.frame(x=c('a','b','c'), y=3:1)
> df
  x y
1 a 3
2 b 2
3 c 1

# 'convert' into a list of data.frames
ldf = lapply(as.list(1:dim(df)[1]), function(x) df[x[1],])

> ldf
[[1]]
x y
1 a 3    
[[2]]
x y
2 b 2
[[3]]
x y
3 c 1

# and the 'coolest'
> ldf[[2]]$y
[1] 2

Ini bukan hanya masturbasi intelektual, tetapi memungkinkan untuk 'mengubah' data.frame menjadi daftar barisnya, menjaga $ indexation yang dapat berguna untuk digunakan lebih lanjut dengan lapply (dengan asumsi fungsi yang Anda berikan untuk lapply menggunakan $ indexation ini)

Solusi yang lebih modern hanya menggunakan purrr::transpose:

library(purrr)
iris[1:2,] %>% purrr::transpose()
#> [[1]]
#> [[1]]$Sepal.Length
#> [1] 5.1
#> 
#> [[1]]$Sepal.Width
#> [1] 3.5
#> 
#> [[1]]$Petal.Length
#> [1] 1.4
#> 
#> [[1]]$Petal.Width
#> [1] 0.2
#> 
#> [[1]]$Species
#> [1] 1
#> 
#> 
#> [[2]]
#> [[2]]$Sepal.Length
#> [1] 4.9
#> 
#> [[2]]$Sepal.Width
#> [1] 3
#> 
#> [[2]]$Petal.Length
#> [1] 1.4
#> 
#> [[2]]$Petal.Width
#> [1] 0.2
#> 
#> [[2]]$Species
#> [1] 1

Saya mengerjakan ini hari ini untuk data.frame (benar-benar data.table) dengan jutaan observasi dan 35 kolom. Tujuan saya adalah mengembalikan daftar data.frames (data.tables) masing-masing dengan satu baris. Artinya, saya ingin membagi setiap baris menjadi data.frame terpisah dan menyimpannya dalam daftar.

Berikut adalah dua metode yang saya temukan yang kira-kira 3 kali lebih cepat daripada split(dat, seq_len(nrow(dat)))untuk kumpulan data itu. Di bawah ini, saya membandingkan tiga metode pada 7500 baris, set data 5 kolom ( iris diulang 50 kali).

library(data.table)
library(microbenchmark)

microbenchmark(
split={dat1 <- split(dat, seq_len(nrow(dat)))},
setDF={dat2 <- lapply(seq_len(nrow(dat)),
                  function(i) setDF(lapply(dat, "[", i)))},
attrDT={dat3 <- lapply(seq_len(nrow(dat)),
           function(i) {
             tmp <- lapply(dat, "[", i)
             attr(tmp, "class") <- c("data.table", "data.frame")
             setDF(tmp)
           })},
datList = {datL <- lapply(seq_len(nrow(dat)),
                          function(i) lapply(dat, "[", i))},
times=20
) 

Ini kembali

Unit: milliseconds
       expr      min       lq     mean   median        uq       max neval
      split 861.8126 889.1849 973.5294 943.2288 1041.7206 1250.6150    20
      setDF 459.0577 466.3432 511.2656 482.1943  500.6958  750.6635    20
     attrDT 399.1999 409.6316 461.6454 422.5436  490.5620  717.6355    20
    datList 192.1175 201.9896 241.4726 208.4535  246.4299  411.2097    20

Meskipun perbedaannya tidak sebesar pada pengujian saya sebelumnya, setDFmetode lurus secara signifikan lebih cepat di semua tingkat distribusi proses dengan max (setDF) <min (split) dan attrmetode ini biasanya lebih dari dua kali lebih cepat.

Metode keempat adalah juara ekstrem, yang merupakan metode bersarang sederhana lapply, yang menampilkan daftar bersarang. Metode ini mencontohkan biaya pembuatan data.frame dari daftar. Selain itu, semua metode yang saya coba dengan data.framefungsi kira-kira urutan besarnya lebih lambat daripada data.tableteknik.

data

dat <- vector("list", 50)
for(i in 1:50) dat[[i]] <- iris
dat <- setDF(rbindlist(dat))

Tampaknya versi purrrpaket (0.2.2) saat ini adalah solusi tercepat:

by_row(x, function(v) list(v)[[1L]], .collate = "list")$.out

Mari bandingkan solusi yang paling menarik:

data("Batting", package = "Lahman")
x <- Batting[1:10000, 1:10]
library(benchr)
library(purrr)
benchmark(
    split = split(x, seq_len(.row_names_info(x, 2L))),
    mapply = .mapply(function(...) structure(list(...), class = "data.frame", row.names = 1L), x, NULL),
    purrr = by_row(x, function(v) list(v)[[1L]], .collate = "list")$.out
)

Hasil:

Benchmark summary:
Time units : milliseconds 
  expr n.eval   min  lw.qu median   mean  up.qu  max  total relative
 split    100 983.0 1060.0 1130.0 1130.0 1180.0 1450 113000     34.3
mapply    100 826.0  894.0  963.0  972.0 1030.0 1320  97200     29.3
 purrr    100  24.1   28.6   32.9   44.9   40.5  183   4490      1.0

Kita juga bisa mendapatkan hasil yang sama dengan Rcpp:

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
List df2list(const DataFrame& x) {
    std::size_t nrows = x.rows();
    std::size_t ncols = x.cols();
    CharacterVector nms = x.names();
    List res(no_init(nrows));
    for (std::size_t i = 0; i < nrows; ++i) {
        List tmp(no_init(ncols));
        for (std::size_t j = 0; j < ncols; ++j) {
            switch(TYPEOF(x[j])) {
                case INTSXP: {
                    if (Rf_isFactor(x[j])) {
                        IntegerVector t = as<IntegerVector>(x[j]);
                        RObject t2 = wrap(t[i]);
                        t2.attr("class") = "factor";
                        t2.attr("levels") = t.attr("levels");
                        tmp[j] = t2;
                    } else {
                        tmp[j] = as<IntegerVector>(x[j])[i];
                    }
                    break;
                }
                case LGLSXP: {
                    tmp[j] = as<LogicalVector>(x[j])[i];
                    break;
                }
                case CPLXSXP: {
                    tmp[j] = as<ComplexVector>(x[j])[i];
                    break;
                }
                case REALSXP: {
                    tmp[j] = as<NumericVector>(x[j])[i];
                    break;
                }
                case STRSXP: {
                    tmp[j] = as<std::string>(as<CharacterVector>(x[j])[i]);
                    break;
                }
                default: stop("Unsupported type '%s'.", type2name(x));
            }
        }
        tmp.attr("class") = "data.frame";
        tmp.attr("row.names") = 1;
        tmp.attr("names") = nms;
        res[i] = tmp;
    }
    res.attr("names") = x.attr("row.names");
    return res;
}

Sekarang bandingkan dengan purrr:

benchmark(
    purrr = by_row(x, function(v) list(v)[[1L]], .collate = "list")$.out,
    rcpp = df2list(x)
)

Hasil:

Benchmark summary:
Time units : milliseconds 
 expr n.eval  min lw.qu median mean up.qu   max total relative
purrr    100 25.2  29.8   37.5 43.4  44.2 159.0  4340      1.1
 rcpp    100 19.0  27.9   34.3 35.8  37.2  93.8  3580      1.0

Beberapa opsi lagi:

Dengan asplit

asplit(xy.df, 1)
#[[1]]
#     x      y 
#0.1137 0.6936 

#[[2]]
#     x      y 
#0.6223 0.5450 

#[[3]]
#     x      y 
#0.6093 0.2827 
#....

Dengan splitdanrow

split(xy.df, row(xy.df)[, 1])

#$`1`
#       x      y
#1 0.1137 0.6936

#$`2`
#       x     y
#2 0.6223 0.545

#$`3`
#       x      y
#3 0.6093 0.2827
#....

data

set.seed(1234)
xy.df <- data.frame(x = runif(10),  y = runif(10))

Cara terbaik bagi saya adalah:

Contoh data:

Var1<-c("X1",X2","X3")
Var2<-c("X1",X2","X3")
Var3<-c("X1",X2","X3")

Data<-cbind(Var1,Var2,Var3)

ID    Var1   Var2  Var3 
1      X1     X2    X3
2      X4     X5    X6
3      X7     X8    X9

Kami menyebutnya BBmiscperpustakaan

library(BBmisc)

data$lists<-convertRowsToList(data[,2:4])

Dan hasilnya adalah:

ID    Var1   Var2  Var3  lists
1      X1     X2    X3   list("X1", "X2", X3") 
2      X4     X5    X6   list("X4","X5", "X6") 
3      X7     X8    X9   list("X7,"X8,"X9) 

Cara alternatifnya adalah dengan mengonversi df ke matriks lalu menerapkan fungsi list apply lappydi atasnya:ldf <- lapply(as.matrix(myDF), function(x)x)

Penggunaan alternatif lain library(purrr)(yang tampaknya sedikit lebih cepat pada data.frames besar)

flatten(by_row(xy.df, ..f = function(x) flatten_chr(x), .labels = FALSE))

Seperti @flodel menulis: Ini mengubah dataframe Anda menjadi daftar yang memiliki jumlah elemen yang sama dengan jumlah baris dalam dataframe:

NewList <- split(df, f = seq(nrow(df)))

Anda juga dapat menambahkan fungsi untuk memilih hanya kolom yang bukan NA di setiap elemen daftar:

NewList2 <- lapply(NewList, function(x) x[,!is.na(x)])

The by_rowfungsi dari purrrlyrpaket akan melakukan ini untuk Anda.

Contoh ini menunjukkan

myfn <- function(row) {
  #row is a tibble with one row, and the same number of columns as the original df
  l <- as.list(row)
  return(l)
}

list_of_lists <- purrrlyr::by_row(df, myfn, .labels=FALSE)$.out

Secara default, nilai yang dikembalikan dari myfndimasukkan ke dalam kolom daftar baru di df yang dipanggil .out. Di $.outakhir pernyataan di atas segera memilih kolom ini, mengembalikan daftar daftar.