R - разбить большой фрейм данных на список параллельно - PullRequest
0 голосов
/ 22 января 2019

У меня большой набор данных транзакций (около 5 миллионов строк), мне нужно разделить все транзакции по идентификатору (около 1 миллиона уникальных идентификаторов).Ожидаемые результаты будут уникальным идентификатором с элементом в списках.

Я попробовал самый простой и прямой способ разделения набора данных транзакций (см. Почему разделение неэффективно для больших фреймов данных со многими группами? ), я знаю, что конвертировать данные в фреймDataatable может быть более эффективным.

Источник выборки df

set.seed(123)
n = 500000 #number of sample data (500k as trial)
x <- data.frame(ID = paste(LETTERS[1:8],sample(1:round(n/3), n, replace = TRUE),sep = ""), 
                Item= sample(c('apple','orange','lemon','tea','rice'), n, replace=TRUE) 
                )

Преобразование символа в коэффициент

x$ID <- as.character(x$ID)
x$Item <- as.factor(x$Item)

Преобразование df в dt, затем разделите dt на списки

library(data.table)
x <- as.data.table(x)
system.time(
  xx <- split(x$Item, x$ID)
)

Ожидаемые результаты в списках

head(xx, 2)
#$A100
#[1] tea    orange
#Levels: apple lemon orange rice tea

#$A101
#[1] rice
#Levels: apple lemon orange rice tea

Проблема : после запуска в течение 2 часовна моей машине (4 ядра, 16 Гб оперативной памяти, Win10, R 3.4.3) он все еще работает и никогда не завершается.Я проверял загрузку процессора, когда он работает, он потреблял только 35-40% загрузки процессора.

Моя идея:

Я думаю, есть ли способ полностью использовать вычислительную мощность моей машины (запустите «split»)параллельно), используя только Detecores () - 1 = 3 ядра.

1st: Разделить большой набор данных транзакций по идентификаторам на 3 меньших раздела (меньший набор данных)

2nd: Использование цикла foreach для запуска split 3разделить (меньший набор данных) на список параллельно, затем добавить (связать строку) каждый список для каждой итерации до конца.

Вопрос : Является ли моя идея практичной?Я читал о mclapply, и это mc.cores, но, похоже, mc.cores = 1 - единственный вариант для Windows, поэтому он не поможет в моем случае.Есть ли лучший и более эффективный способ разбить большой набор данных?Любые комментарии приветствуются, спасибо!

Ответы [ 2 ]

0 голосов
/ 23 января 2019

Факторы, похоже, являются ключевыми здесь.У меня нет 64 ГБ ОЗУ ?, но, возможно, вы можете попробовать еще раз с stringsAsFactors = F. Мои результаты для меньшего теста ниже, и кажется, что разделение происходит довольно быстро, если не использовать коэффициенты.


n <- 50000

x <- data.frame(ID = paste(LETTERS[1:8],sample(1:round(n/3), n, replace = TRUE),sep = ""), 
                Item= sample(c('apple','orange','lemon','tea','rice'), n, replace=TRUE),
                stringsAsFactors = T
)


x2 <- data.frame(ID = paste(LETTERS[1:8],sample(1:round(n/3), n, replace = TRUE),sep = ""), 
                Item= sample(c('apple','orange','lemon','tea','rice'), n, replace=TRUE),
                stringsAsFactors = F)


splitFactor <- function() split(x$Item, x$ID)
byFactor <- function() by(x$Item, x$ID, identity)


splitNotFactor <- function() split(x2$Item, x2$ID)
byNotFactor <- function() by(x2$Item, x2$ID, identity)

a <- microbenchmark::microbenchmark(splitFactor(),
                                    byFactor(),
                                    splitNotFactor(),
                                    byNotFactor(),
                                    times = 3
)

Unit: milliseconds
             expr        min         lq       mean     median         uq        max neval  cld
    splitFactor() 51743.1633 51936.7261 52025.1205 52130.2889 52166.0990 52201.9091     3    d
       byFactor()  1963.0673  1987.7360  2030.5779  2012.4048  2064.3332  2116.2616     3  b  
 splitNotFactor()   399.7618   401.6796   412.4632   403.5973   418.8139   434.0306     3 a   
    byNotFactor()  2410.3804  2518.3651  2578.3501  2626.3499  2662.3349  2698.3199     3   c 

Benchmarks

splitNotFactor () также должен приводить к объекту с гораздо меньшим объемом памяти, чем другие функции.

0 голосов
/ 22 января 2019

Удивительно и интересно, рассмотрим by (объектно-ориентированную оболочку для tapply), которая работает аналогично split для фреймов данных с добавленной функцией запуска, разделяется на вызов функции. Эквивалентом split будет возвращение аргумента или вызов identity.

by(x$Item, x$ID, function(x) x)

by(x$Item, x$ID, identity)

Обратите внимание, возвращаемое значение by - это объект класса by, который, по сути, представляет собой список с дополнительными атрибутами.

Используя ваш пример случайного фрейма данных, base::split не завершился через 1 час, но base::by показала намного меньше 5 минут на моей машине с 64 ГБ ОЗУ! Обычно я предполагал, что у by будет больше накладных расходов, если он будет родственником заявленной семьи, но мое мнение может скоро измениться.

50K ROW ПРИМЕР

set.seed(123)
n = 50000 #number of sample data (50k as trial)
x <- data.frame(ID = paste(LETTERS[1:8],sample(1:round(n/3), n, replace = TRUE),sep = ""), 
                Item= sample(c('apple','orange','lemon','tea','rice'), n, replace=TRUE) 
)

system.time( xx <- split(x$Item, x$ID) )
#   user  system elapsed 
#  20.09    0.00   20.09 

system.time( xx2 <- by(x$Item, x$ID, identity) )
#   user  system elapsed 
#   1.55    0.00    1.55 

all.equal(unlist(xx), unlist(xx2))
# [1] TRUE

identical(unlist(xx), unlist(xx2))
# [1] TRUE

500K ROW ПРИМЕР

set.seed(123)
n = 500000 #number of sample data (500k as trial)
x <- data.frame(ID = paste(LETTERS[1:8],sample(1:round(n/3), n, replace = TRUE),sep = ""), 
                Item= sample(c('apple','orange','lemon','tea','rice'), n, replace=TRUE) 
)

system.time( xx <- split(x$Item, x$ID) )
# DID NOT FINISH AFTER 1 HOUR

system.time( xx2 <- by(x$Item, x$ID, identity) )
#   user  system elapsed 
#  23.00    0.06   23.09 

Исходный код показывает, что split.default может запускать больше процессов на уровне R (в отличие от C или Fortran) с циклом for с коэффициентом levels:

getAnywhere(split.data.frame)

function (x, f, drop = FALSE, sep = ".", lex.order = FALSE, ...) 
{
    if (!missing(...)) 
        .NotYetUsed(deparse(...), error = FALSE)
    if (is.list(f)) 
        f <- interaction(f, drop = drop, sep = sep, lex.order = lex.order)
    else if (!is.factor(f)) 
        f <- as.factor(f)
    else if (drop) 
        f <- factor(f)
    storage.mode(f) <- "integer"
    if (is.null(attr(x, "class"))) 
        return(.Internal(split(x, f)))
    lf <- levels(f)
    y <- vector("list", length(lf))
    names(y) <- lf
    ind <- .Internal(split(seq_along(x), f))
    for (k in lf) y[[k]] <- x[ind[[k]]]
    y
}

И наоборот, исходный код для by.data.frame показывает вызов tapply, который сам по себе является оберткой для lapply:

getAnywhere(by.data.frame)

function (data, INDICES, FUN, ..., simplify = TRUE) 
{
    if (!is.list(INDICES)) {
        IND <- vector("list", 1L)
        IND[[1L]] <- INDICES
        names(IND) <- deparse(substitute(INDICES))[1L]
    }
    else IND <- INDICES
    FUNx <- function(x) FUN(data[x, , drop = FALSE], ...)
    nd <- nrow(data)
    structure(eval(substitute(tapply(seq_len(nd), IND, FUNx, 
        simplify = simplify)), data), call = match.call(), class = "by")
}
...