Оптимизация: разделение фрейма данных на список фреймов данных, преобразование данных в строку

квалификации: этот вопрос в основном имеет образовательную ценность, фактическая задача под рукой завершена, даже если подход не совсем оптимален. Мой вопрос в том,код ниже может быть оптимизирован для скорости и / или реализован более элегантно. Возможно использование дополнительных пакетов, таких как plyr или reshape. Запуск на фактических данных занимает около 140 секунд, что намного выше, чем смоделированные данные, так как некоторые из исходных строк содержат только NA, и необходимо провести дополнительные проверки. Для сравнения, моделируемые данные обрабатываются примерно за 30 секунд.

условия: набор данных содержит 360 переменных, в 30 раз больше 12. Назовем их V1_1, V1_2... (первый набор), V2_1, V2_2 ... (вторая группа) и так далее. Каждый набор из 12 переменных содержит дихотомические (да/нет) ответы, на практике соответствующие статусу карьеры. Например: работа (да / нет), учеба (да/нет) и так далее, всего 12 статусов, повторенных 30 раз.

задание: задача состоит в том, чтобы перекодировать каждый набор из 12 дихотомических переменных в одной переменной с 12 категорий (например, работы, учебы... ). В конечном счете мы должны получить 30 переменных, каждая из которых имеет 12 категорий ответов.

данные: Я не могу опубликовать фактический набор данных, но вот хорошее смоделированное приближение:

randomRow <- function() {
  # make a row with a single 1 and some NA's
  sample(x=c(rep(0,9),1,NA,NA),size=12,replace=F) 
}

# create a data frame with 12 variables and 1500 cases
makeDf <- function() {
  data <- matrix(NA,ncol=12,nrow=1500)
  for (i in 1:1500) {
    data[i,] <- randomRow()
  }
  return(data)
}

mydata <- NULL

# combine 30 of these dataframes horizontally
for (i in 1:30) {
  mydata <- cbind(mydata,makeDf())
}
mydata <- as.data.frame(mydata) # example data ready

мое решение:

# Divide the dataset into a list with 30 dataframes, each with 12 variables
S1 <- lapply(1:30,function(i) {
  Z <- rep(1:30,each=12) # define selection vector
  mydata[Z==i]           # use selection vector to get groups of variables (x12)
})

recodeDf <- function(df) {
  result <- as.numeric(apply(df,1,function(x) {
    if (any(!is.na(df))) which(x == 1) else NA # return the position of "1" per row
  }))                                          # the if/else check is for the real data
  return(result)
}
# Combine individual position vectors into a dataframe
final.df <- as.data.frame(do.call(cbind,lapply(S1,recodeDf)))

в целом, есть двуспальная * применить функцию, один через список, другой через строки фрейма данных. Это делает его немного медленным. Есть предложения? Спасибо заранее.

8
apply optimization r

4 ответов

мне очень нравится идея умножения матрицы @Arun. Интересно, что если вы компилируете R против некоторых библиотек OpenBLAS, вы можете заставить это работать параллельно.

тем не менее, я хотел предоставить вам другое, возможно, медленнее, чем матричное умножение, решение, которое использует ваш исходный шаблон, но намного быстрее, чем ваша реализация:

# Match is usually faster than which, because it only returns the first match 
# (and therefore won't fail on multiple matches)
# It also neatly handles your *all NA* case
recodeDf2 <- function(df) apply(df,1,match,x=1) 
# You can split your data.frame by column with split.default
# (Using split on data.frame will split-by-row)
S2<-split.default(mydata,rep(1:30,each=12))
final.df2<-lapply(S2,recodeDf2)

если у вас был очень большой фрейм данных и много процессоров, вы можете рассмотреть возможность распараллеливания этого операция с:

library(parallel)
final.df2<-mclapply(S2,recodeDf2,mc.cores=numcores) 
# Where numcores is your number of processors.

прочитав @Arun и @mnel, я много узнал о том, как улучшить эту функцию, избегая принуждения к массиву, обрабатывая data.frame по столбцу, а не по строке. Я не имею в виду "украсть" ответ здесь; OP должен рассмотреть возможность переключения флажка на ответ @mnel.

я хотел, однако, поделиться решением, которое не использует data.table, и не for. Однако это все еще медленнее, чем решение @mnel, хотя слегка.

nograpes2<-function(mydata) {
  test<-function(df) {
    l<-lapply(df,function(x) which(x==1))
    lens<-lapply(l,length)
    rep.int(seq.int(l),times=lens)[order(unlist(l))]
  }
  S2<-split.default(mydata,rep(1:30,each=12))
  data.frame(lapply(S2,test))
}

я также хотел бы добавить, что подход @Aaron, используя which С arr.ind=TRUE также было бы очень быстро и элегантно, если mydata начинал как matrix, а не data.frame. Принуждение к matrix медленнее, чем остальная часть функции. Если бы скорость была проблемой, было бы целесообразно рассмотреть возможность чтения данных в качестве матрицы в первую очередь.

4

вот подход, который в основном мгновенный. (система.время = 0.1 сек.)

se set. Компонент columnMatch будет зависеть от ваших данных, но если это каждые 12 столбцов, то будет работать следующее. 

MYD <- data.table(mydata)
# a new data.table (changed to numeric : Arun)
newDT <- as.data.table(replicate(30, numeric(nrow(MYD)),simplify = FALSE))
# for each column, which values equal 1
whiches <- lapply(MYD, function(x) which(x == 1))
# create a list of column matches (those you wish to aggregate)
columnMatch <- split(names(mydata), rep(1:30,each = 12))
setattr(columnMatch, 'names', names(newDT))

# cycle through all new columns
# and assign the the rows in the new data.table
## Arun: had to generate numeric indices for 
## cycling through 1:12, 13:24 in whiches[[.]]. That was the problem.
for(jj in seq_along(columnMatch)) {
 for(ii in seq_along(columnMatch[[jj]])) {
  set(newDT, j = jj, i = whiches[[ii + 12 * (jj-1)]], value = ii)
 }
}

это будет работать так же, как добавление столбцов по ссылке на оригинал.

Примечание set работает на data.frames как хорошо....

5

IIUC, у вас только один 1 в 12 столбцов. У вас есть остальное с 0 или NA. Если это так, операция может быть выполнена намного быстрее с помощью этой идеи.

идея: вместо того, чтобы проходить через каждую строку и просить позицию 1, вы можете использовать матрицу с размерами 1500 * 12 где каждая строка-это просто 1:12. То есть:

mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

теперь вы можете умножить эту матрицу с каждым из ваших подмножеств data.frame (таких же размеров, 1500*12 здесь), и они берут свои "rowSums" (который векторизован) с na.rm = TRUE. Это просто даст непосредственно строку, где у вас есть 1 (потому что этот 1 будет умножен на соответствующее значение между 1 и 12).

данные.реализация таблицы: здесь, я буду использовать data.table чтобы проиллюстрировать идею. Поскольку он создает столбец по ссылкам, я ожидаю, что та же идея используется на data.frame было бы немного медленнее, хотя это должно резко ускорить ваш текущий код.

require(data.table)
DT <- data.table(mydata)
ids <- seq(1, ncol(DT), by=12)

# for multiplying with each subset and taking rowSums to get position of 1
mul.mat <- matrix(rep(1:12, nrow(DT)), ncol = 12, byrow=TRUE)

for (i in ids) {
    sdcols <- i:(i+12-1)
    # keep appending the new columns by reference to the original data
    DT[, paste0("R", i %/% 12 + 1) := rowSums(.SD * mul.mat, 
                     na.rm = TRUE), .SDcols = sdcols]
}
# delete all original 360 columns by reference from the original data
DT[, grep("V", names(DT), value=TRUE) := NULL]

теперь у вас останется 30 столбцов, которые соответствуют позиции 1. В моей системе это занимает около 0,4 секунды. 

all(unlist(final.df) == unlist(DT)) # not a fan of `identical`
# [1] TRUE
4

другой способ сделать это с базой R-просто получить значения, которые вы хотите поместить в новую матрицу, и заполнить их непосредственно индексированием матрицы.

idx <- which(mydata==1, arr.ind=TRUE)   # get indices of 1's
i <- idx[,2] %% 12                      # get column that was 1
idx[,2] <- ((idx[,2] - 1) %/% 12) + 1   # get "group" and put in "col" of idx
out <- array(NA, dim=c(1500,30))        # make empty matrix
out[idx] <- i                           # and fill it in!
4