최적화 : 데이터 프레임을 데이터 프레임 목록으로 분할하고 행당 데이터 변환

Question

예비 사항 :이 질문은 대부분 교육적 가치를 지니고 있지만 접근 방법이 완전히 최적화되지는 않았더라도 실제 작업이 완료되었습니다. 제 질문은 코드가 속도를 최적화하거나보다 우아하게 구현할 수 있는지 여부입니다.. 아마도 plyr 또는 reshape와 같은 추가 패키지를 사용합니다. 실제 데이터에서 실행하면 시뮬레이션 된 데이터보다 훨씬 높은 약 140 초가 걸립니다. 일부 원본 행에는 NA가 포함되어 있으므로 추가 검사가 필요합니다. 비교하기 위해 시뮬레이션 된 데이터는 약 30 초 내에 처리됩니다.

조건

는 : 데이터 세트는 360 개 변수, (12)의 30 배 세트의이 V1_1, V1_2 (첫번째 설정), V2_1, V2_2이 (두 번째 세트) 등을 이름하자가 포함되어 있습니다. 12 개 변수의 각 집합은 실제적으로 진로 상태에 해당하는 이분법 (예/아니오) 응답을 포함합니다. 예 : 일 (예/아니오), 연구 (예/아니오) 등 총 12 가지 상태가 30 번 반복됩니다.

작업 : 12 개 이분법 변수의 각 집합을 12 개의 응답 범주 (예 : 직장, 학습 ...)가있는 단일 변수로 다시 코딩하는 작업이 있습니다. 궁극적으로 우리는 12 개의 응답 범주를 가진 30 개의 변수를 얻어야합니다.

데이터 : 나는 실제 데이터 집합을 게시 할 수 없습니다, 그러나 여기 좋은 시뮬레이션 근사 :

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 읽으면서, 나는 생을 개선하는 방법에 대해 많은 것을 배웠습니다 행의 대신에 열로 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)) 
} 

또한 mydata 오히려 data.frame보다는 matrix로 시작하는 경우도 매우 빠르고 우아한 것 whicharr.ind=TRUE로를 사용하여, 아론의 접근 @ 것을 추가하고 싶습니다. matrix에 대한 강제 변환은 나머지 함수보다 느립니다. 속도가 문제라면 먼저 데이터를 매트릭스로 읽는 것이 좋습니다.

Answer 2

IIUC, 12 열당 하나만 1입니다. 나머지는 0 또는 NA입니다. 그렇다면이 아이디어로 작업을 훨씬 빨리 수행 할 수 있습니다.

아이디어

: 각 행은 단지 1:12입니다 대신에 각 행을 통과하고 1의 위치를 ​​묻는, 당신은 크기 1500 * 12와 매트릭스를 사용할 수 있습니다. 즉 : 이제

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

, 당신은 (여기에, 같은 크기의 * 12 1500) data.frame 당신의 subset'd의 각각이 행렬을 곱할 수 그들을 na.rm = TRUE로 (벡터화되어) 그들의 "rowSums"를 취할. 이것은 단지 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] 

이제 1의 위치에 해당하는 30 개의 열이 남게됩니다. 내 시스템에서는 약 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) 
} 
} 

원본을 참조하여 열을 추가하는 것뿐입니다.

주뿐만 아니라 data.frames에 set 작품 ....이 기본 R와 함께 할 수

Answer 4

또 다른 방법은 단순히 새로운 매트릭스에 넣을 값을 받고 직접 행렬 인덱스와 그들을 작성 함께 .

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!