優化：將數據幀拆分爲數據幀列表，每行轉換數據

Question

預備：這個問題主要是教育價值，即使這種方法並不是完全最優的，它仍然完成了實際的任務。我的問題是下面的代碼是否可以針對速度進行優化和/或實現更優雅。也許使用額外的軟件包，如plyr或重塑。運行實際數據大約需要140秒，遠高於模擬數據，因爲一些原始行只包含NA，並且必須進行額外的檢查。爲了比較，模擬的數據在大約30秒內被處理。

條件：數據集包含360個變量設定的12 30倍，讓我們爲它們命名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

我真的很喜歡@ Arun的矩陣乘法思想。有趣的是，如果你針對某些OpenBLAS庫編譯R，則可以將其並行操作。

不過，我想向您提供另一個，也許比矩陣乘法，解決方案，使用你原來的模式慢，但比你實現更快：

# 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，我學到了很多關於如何提高THI通過按列處理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，您每12列只有一個1。你有其餘的0或NA。如果是這樣，這個想法可以更快地執行操作。

的想法：而是通過每個行會，並要求爲1的位置，你可以每行僅僅是1:12使用與維1500 * 12的矩陣。那就是：

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

現在，你可以乘這個矩陣，每個subset'd data.frame的（中相同的尺寸，1500 * 12在這裏），並帶他們去他們的「rowSums」（這是矢量化）與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!