2017-05-03 8 views
3

次のような対角線に沿った値を持つ大きな行列で作業しています。R - 行列の対角線に沿って 'n'以下の長さのデータギャップを埋める

ontrack <- matrix(c(
     runif(1),NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     runif(1),NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,runif(1),NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,runif(1),runif(1),NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,runif(1),NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 
     NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,runif(1)), 
     nrow=14, byrow=T 
     ) 

私は対角線のセグメントを接続するために長さ 'n'以下のデータギャップを埋めたいと思います。例えば、上記の行列を用いて3以下のデータギャップを埋める、私はこのから行きたい:

ためのこの

 row col 
     1 1 
     2 1 
newV 3 2 
     3 3 
    new 4 4 
    new 5 4 
    new 6 4 
     7 5 
     7 6 
    new 8 7 
     9 8 
     14 13 

 row col 
[1,] 1 1 
[2,] 2 1 
[3,] 3 3 
[4,] 7 5 
[5,] 7 6 
[6,] 9 8 
[7,] 14 13 

を与える

diag_indx <- which(!is.na(ontrack), arr.ind=T) 

newVのようなインスタンスの場合、結果は(2,2)または(3,2)になります。後のコードではdiag_indxの行列を使用していますが、より効率的であればデータギャップはontrack行列に直接書き込まれます(任意の値を使用)。溶液をうまくしようとする際に

、私はこのsequence length equation

seqle <- function(x, incr=1) { 
    if(!is.integer(x)) x <- as.integer(x) 
    n <- length(x) 
    y <- x[-1L] != x[-n] + incr 
    i <- c(which(y|is.na(y)),n) 
    list(lengths = diff(c(0L,i)), 
     values = x[head(c(0L,i)+1L,-1L)]) 
} 

を用いdiag_indxマトリクスにおけるデータのギャップを発見した後seq()を使用して、データのギャップを埋める想定しました。効率的にまとめていく方法がわかりません。ご協力ありがとうございました。

答えて

1

いくつかの試行錯誤の後、私はベースのR関数しか必要としない(それほどきれいではない)ソリューションを考え出しました。

diagFillSeq <- function(diag_indx, fillgap=1){ 
    repeat{ 
    for(cols in 1:2){ 
     diag_indx <- diag_indx[order(diag_indx[, cols]), ] #Sort by selected column 
     repeat{ 
     diffs <- diff(diag_indx[, cols]) 
     #Find breaks in sequence with differences >1 (diffs==1 are in sequence) and less than or equal to fillgap 
     gap_indx <- which(diffs > 1 & diffs <= (fillgap +1)) #need +1 because fencepost error: 3rd & 7th post diffs=4 but fillgap=3) 
     if(length(gap_indx) == 0){break} 
     insert_indx <- gap_indx[1] 
     seq_length <- diffs[gap_indx[1]] - 1 #need -1 because fencepost error 
     #Subset diag_indx and insert filling sequence 
     diag_indx <- rbind(diag_indx[1:insert_indx, ], 
         cbind(
         as.integer(seq(from=diag_indx[insert_indx, 1] +1, to=diag_indx[insert_indx+1, 1] -1, length.out=seq_length)), 
         as.integer(seq(from=diag_indx[insert_indx, 2] +1, to=diag_indx[insert_indx+1, 2] -1, length.out=seq_length)) 
        ), 
         diag_indx[(insert_indx+1):nrow(diag_indx), ]) 
     } 
    } 
    #Recheck first column to see if any new sequence gaps were created 
    diffs <- diff(diag_indx[, 1]) 
    gap_indx <- which(diffs > 1 & diffs <= (fillgap +1)) 
    if(length(gap_indx) == 0){return(unname(diag_indx))} 
    } 
} 

そしてdiag_indx

whatIwant <- matrix(as.integer(c(1,2,3,3,4,5,6,7,7,8,9,14, 1,1,2,3,4,4,4,5,6,7,8,13)), ncol=2) 
whatIwant 
#  [,1] [,2] 
# [1,] 1 1 
# [2,] 2 1 
# [3,] 3 2 
# [4,] 3 3 
# [5,] 4 4 
# [6,] 5 4 
# [7,] 6 4 
# [8,] 7 5 
# [9,] 7 6 
#[10,] 8 7 
#[11,] 9 8 
#[12,] 14 13 

identical(diagFillSeq(diag_indx, fillgap=3), whatIwant) 
#TRUE 

上記のテスト
関連する問題