데이터를 파티션하는 R 함수

Question

누군가가 함수 디버깅을 도울 수 있습니다. 그것을하기위한 것입니다

dat3 <- c(4,7,5,7,8,4,4,4,4,4,4,7,4,4,8,8,5,5,5,5) 

myfunc(dat3, chunksize = 8) 
## [1] 4 7 5 8 4 4 4 4 4 7 5 8 4 4 5 5 4 

사이퍼의 청크에서 데이터를 분할하고 모든 수준이 모든 청크에 있는지 확인하십시오. 이 함수는 문제는 내가 (최종 지수 여기라고 그래서) 함수에서 재 배열 indixes을 얻고 싶은 것입니다 장난감 예를

myfunc <- function(x, chunksize = 8) { 
    numChunks <- ceiling(length(x)/chunksize) 
    uniqx <- unique(x) 
    lastChunkSize <- chunksize * (1 - numChunks) + length(x) 
    ## check to see if it is mathematically possible 
    if (length(uniqx) > chunksize) 
     stop('more factors than can fit in one chunk') 
    if (any(table(x) < numChunks)) 
     stop('not enough of at least one factor to cover all chunks') 
    if (lastChunkSize < length(uniqx)) 
     stop('last chunk will not have all factors') 
    ## actually arrange things in one feasible permutation 
    allIndices <- sapply(uniqx, function(z) which(z == x)) 
    ## fill one of each unique x into chunks 
    chunks <- lapply(1:numChunks, function(i) sapply(allIndices, `[`, i)) 
    remainder <- unlist(sapply(allIndices, tail, n = -3)) 
    remainderCut <- split(remainder, ceiling(seq_along(remainder)/4)) 
    ## combine them all together, wary of empty lists 
    finalIndices <- sapply(1:numChunks, 
      function(i) { 
       if (i <= length(remainderCut)) 
        c(chunks[[i]], remainderCut[[i]]) 
       else 
        chunks[[i]] 
      }) 
      save(finalIndices,file="finalIndices") 
    x[unlist(finalIndices)] 

} 

작동합니다. 문제는 더 많은 관찰 (https://www.dropbox.com/s/n3wc5qxaoavr4ta/j.RData?dl=0)을 가진 내 실제 데이터 세트에 대해 기능이 작동하지 않는다는 것입니다. 계수 https://www.dropbox.com/s/0ue2xzv5e6h858q/t.RData?dl=0

같은

데이터 I)는 함수의 첫 번째 줄에 9,847 I에 본 레벨의 수에 따라 chunkszie 있었던 파라미터의 변경. 문제는 저장된 파일에서 finalIndices에 액세스 할 때 희미한 137의 행렬을 얻는 것입니다 60. 모든 관측치 (거의 600k)에 대한 색인을 제공하지 않습니다. 누군가 내가 뭘 잘못하고 있는지 말해 줄 수 있니? 나는 60이 덩어리 (nrows/chunksize)의 숫자이지만 137은 맞지 않는 것으로 알고있다.

Answer 1

행 remainderCut <- split(remainder, ceiling(seq_along(remainder)/4))은 장난감 데이터 세트에 하드 코딩되어 각 청크에 4 개의 요소를 추가하기 만하면 다른 데이터 세트에 대해 잘못된 결과가 생성됩니다. 이 문제가 코드를 수정하여 고정 할 수있는 반면

, 나는이 문제에 대한 약간 다른 접근 방식으로 올라와있다 :

library(data.table) 

generate.chunks <- function(dat3, chunksize = 8) { 
    # get number of unique values 
    freqs <- table(dat3) 

    # get chunk sizes 
    chunk.sizes <- rep(chunksize,length(dat3) %/% chunksize)  
    last.chunk.size <- length(dat3) %% chunksize 
    if (last.chunk.size > 0) chunk.sizes <- c(chunk.sizes,last.chunk.size) 

    # few checks 
    if (chunksize < length(freqs)) 
     stop(sprintf('Chunk size is smaller than the number of factors: %i elements in a chunk, %i factors. Increase the chunk size',chunksize,length(freqs))) 
    if (chunk.sizes[length(chunk.sizes)] < length(freqs)) 
     stop(sprintf('Last chunk size is smaller than the number of factors: %i elements in the chunk, %i factors. Use a different chunk size',chunksize,length(freqs))) 
    if (min(freqs) < length(chunk.sizes)) 
     stop(sprintf('Not enough values in a factor to populate every chunk: %i < %i. Increase the chunk size',min(freqs),length(chunk.sizes))) 

    # make sure that each chunk has at least one factor 
    d.predefined <- data.frame(
      chunk = rep(1:length(chunk.sizes),each=length(freqs)), 
      i  = rep(1:length(freqs),length(chunk.sizes)) 
    ) 

    # randomly distribute the remaining values 
    d.sampled <- data.frame(
     chunk = unlist(mapply(rep,1:length(chunk.sizes),chunk.sizes - length(freqs),SIMPLIFY=F)), 
     i  = sample(unlist(mapply(rep,1:length(freqs),freqs - length(chunk.sizes)))) 
    ) 

    # put the predefined and sampled results together and split 
    d.result <- rbind(d.predefined,d.sampled) 

    # calculate indices 
    indices <- sapply(names(freqs),function(s) which(dat3==s)) 
    dt <- as.data.table(d.result) 
    dt[,ind:=indices[[i]],by=i] 
    finalIndices <- split(dt$ind,dt$chunk) 
    save(finalIndices,file="finalIndices") 

    names(freqs)[d.result$i] 
}