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

Question

Предварительные данные: этот вопрос в основном имеет образовательное значение, фактическая задача выполнена, даже если подход не является полностью оптимальным. Мой вопрос: нижеприведенный код может быть оптимизирован для скорости и/или реализован более элегантно. Возможно использование дополнительных пакетов, таких как 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))) 

В общем, есть двойная * применить функцию, одну по списку, другую по строкам данных. Это делает его немного медленным. Какие-либо предложения? Заранее спасибо.

Answer 1

Мне очень нравится идея умножения матрицы Аруна. Интересно, что если вы компилируете 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, я узнал много нового о том, как улучшить Тхи~d s, избегая принуждения к массиву, обработкой 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)) 
} 

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

Answer 2

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

Идея: Вместо того, чтобы идти через каждый ряд и просить должность 1, вы могли бы использовать матрицу с размерами 1500 * 12, где каждая строка просто 1:12. То есть:

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

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

---

data.table реализация: Здесь я буду использовать 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 

Answer 3

Это подход, который в основном мгновенен. (system.time = 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 а ....

Answer 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!