data.frame do listy

Mam plik data.frame, który chciałbym przekonwertować na listę według wierszy, co oznacza, że ​​każdy wiersz odpowiadałby własnym elementom listy. Innymi słowy, chciałbym otrzymać listę tak długą, jak data.frame zawiera wiersze.

Do tej pory rozwiązywałem ten problem w następujący sposób, ale zastanawiałem się, czy istnieje lepszy sposób na rozwiązanie tego problemu.

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,]
}

Lubię to:

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

A jeśli chcesz, aby nazwy rzędów xy.dfbyły nazwami listy wyników, możesz zrobić:

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

Eureka!

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

Jeśli chcesz całkowicie nadużywać data.frame (tak jak ja) i chcesz zachować funkcjonalność $, jednym ze sposobów jest podzielenie data.frame na jednowierszowe data.frames zebrane na liście:

> 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

Jest to nie tylko intelektualna masturbacja, ale pozwala `` przekształcić '' ramkę data.frame w listę jej wierszy, zachowując indeksację $, która może być przydatna do dalszego użytku z lapply (zakładając, że funkcja, którą przekazujesz do lapply, używa tej indeksacji $)

Bardziej nowoczesne rozwiązanie wykorzystuje tylko 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

Pracowałem nad tym dzisiaj dla ramki data.frame (tak naprawdę data.table) z milionami obserwacji i 35 kolumnami. Moim celem było zwrócenie listy data.frames (data.tables), każda z jednym wierszem. Oznacza to, że chciałem podzielić każdy wiersz na osobną ramkę data.frame i zapisać je na liście.

Oto dwie metody, które wymyśliłem, które były około 3 razy szybsze niż w split(dat, seq_len(nrow(dat)))przypadku tego zestawu danych. Poniżej porównuję te trzy metody na zestawie danych z 7500 wierszami i 5 kolumnami ( tęczówka powtórzona 50 razy).

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
) 

To wraca

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

Chociaż różnice nie są tak duże jak w moim poprzednim teście, setDFmetoda prosta jest znacznie szybsza na wszystkich poziomach dystrybucji przebiegów z max (setDF) <min (split), a attrmetoda jest zwykle ponad dwukrotnie szybsza.

Czwartą metodą jest ekstremalny mistrz, który jest prostym zagnieżdżonym lapply, zwracającym zagnieżdżoną listę. Ta metoda ilustruje koszt tworzenia ramki data.frame z listy. Co więcej, wszystkie metody, które wypróbowałem z tą data.framefunkcją, były mniej więcej o rząd wielkości wolniejsze niż data.tabletechniki.

dane

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

Wydaje się, że aktualna wersja pakietu purrr(0.2.2) jest najszybszym rozwiązaniem:

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

Porównajmy najciekawsze rozwiązania:

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
)

Wyniki:

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

Ten sam wynik możemy również uzyskać stosując 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;
}

Teraz porównaj z purrr:

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

Wyniki:

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

Jeszcze kilka opcji:

Z 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 
#....

Z splitirow

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
#....

dane

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

Dla mnie najlepszym sposobem było:

Przykładowe dane:

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

Dzwonimy do BBmiscbiblioteki

library(BBmisc)

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

Rezultatem będzie:

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) 

Alternatywnym sposobem jest konwersja df do macierzy, a następnie zastosowanie do niej lappyfunkcji listy zastosuj :ldf <- lapply(as.matrix(myDF), function(x)x)

Kolejne alternatywne użycie library(purrr)(wydaje się być nieco szybsze w przypadku dużych ramek danych)

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

Jak napisał @flodel: To konwertuje twoją ramkę danych na listę, która ma taką samą liczbę elementów, jak liczba wierszy w ramce danych:

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

Możesz dodatkowo dodać funkcję, aby wybrać tylko te kolumny, które nie są NA w każdym elemencie listy:

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

by_rowFunkcji z purrrlyrpakietu zrobi to za Ciebie.

Ten przykład demonstruje

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

Domyślnie zwracana wartość z myfnjest umieszczana w nowej kolumnie listy w nazwie df .out. Na $.outkońcu powyższej instrukcji natychmiast wybiera tę kolumnę, zwracając listę list.