2013-04-10 12 views
8

預備:這個問題主要是教育價值,即使這種方法並不是完全最優的,它仍然完成了實際的任務。我的問題是下面的代碼是否可以針對速度進行優化和/或實現更優雅。也許使用額外的軟件包,如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))) 

總而言之,有一個雙*應用函數,一個跨越列表,另一個跨數據框行。這使它有點慢。有什麼建議麼?提前致謝。

+0

(+1)非常好框的問題。 – Arun 2013-04-10 19:36:31

回答

4

我真的很喜歡@ 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)) 
} 

我還想補充一點,@阿龍的方法,使用whicharr.ind=TRUE也將是非常快速和優雅,如果mydata開始作爲一個matrix,而不是data.frame。強制轉換爲matrix比其他功能慢。如果速度是一個問題,那麼首先將數據讀取爲矩陣是值得考慮的。

+1

nograpes,(+1)謝謝。根據我對平行工作的經驗,除非你平行的任務是「沉重的」,否則在完成後創造工作和合並結果的開銷*要高得多,結果變慢。在1處理器和一組處理器上進行基準測試會很有趣。我不認爲這裏的實際操作「很重」。如果我設法榨取一些時間,我會盡力去做。 – Arun 2013-04-10 21:43:47

+0

謝謝。我也喜歡@ Arun關於矩陣乘法的建議。儘管如此,我發現你的代碼對於真正的數據應用來說更加強大乘法方法取決於數據的清晰度,否則行總和將不正確。我盡我所能消除了違規行爲,但人們永遠無法知曉。代碼在速度方面表現非常好,0.25秒。偉大的建議。 – 2013-04-10 21:44:31

+2

在data.frame上使用apply將強制爲一個矩陣,這不是有效的。 – mnel 2013-04-11 00:26:45

4

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 
+0

謝謝,阿倫。矩陣乘法是一個絕妙的想法,我甚至沒有朝這個方向思考。直覺上我期望plyr或者重塑一些簡潔的技巧,但是你使用data.table的建議也是一個非常值得歡迎的發現。 – 2013-04-10 21:30:47

5

這是一個基本上瞬時的方法。 (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以及....

+0

我不知道什麼是錯的,但是這段代碼並沒有給我結果。相反,我得到一個data.table(newDT),其中包含變量名稱而不是值。我設想這些對應於我尋求的值,例如V1_8指的是8.對於「set」仍然是一個有價值的建議,謝謝。 – 2013-04-11 08:03:10

+2

@ mnel,輝煌的答案。我做了一些更正。對'whiches [[。]]'的訪問是不正確的。對於每一個'jj',當對於ex:對於'jj = 2','ii'必須是'13:24'時,它都經歷了相同的1:12。希望你不介意編輯。如果你不服氣,隨意編輯/回滾。馬克西姆,你現在應該得到想要的結果。是的,它*是*快! – Arun 2013-04-11 08:46:08

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! 
+0

一個非常有趣的方法,謝謝。不幸的是,它不適用於原始數據,很可能是由於某些行僅包含NA。它確實對模擬數據確實有效,當然實際數據也可以進行調整。 – 2013-04-11 09:12:58

+0

附錄:它實際上可以處理原始數據,不確定第一次出錯的地方。再次感謝。 – 2013-04-11 09:28:26

相關問題