R：替換隨機矩陣的「非對角線」元素

Question

我使用下面的代碼來生成一個元素= 1的對角線附近的隨機矩陣，其餘= 0（這基本上是一個隨機行走主對角線）

n <- 20 
rw <- matrix(0, ncol = 2, nrow = n) 
indx <- cbind(seq(n), sample(c(1, 2), n, TRUE)) 
rw[indx] <- 1 
rw[,1] <- cumsum(rw[, 1])+1 
rw[,2] <- cumsum(rw[, 2])+1 
rw2 <- subset(rw, (rw[,1] <= 10 & rw[,2] <= 10)) 
field <- matrix(0, ncol = 10, nrow = 10) 
field[rw2] <- 1 
field 

    [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 0 1 1 1 0 0 0 0 0  0 
[2,] 0 0 0 1 0 0 0 0 0  0 
[3,] 0 0 0 1 0 0 0 0 0  0 
[4,] 0 0 0 1 1 1 1 0 0  0 
[5,] 0 0 0 0 0 0 1 1 0  0 
[6,] 0 0 0 0 0 0 0 1 0  0 
[7,] 0 0 0 0 0 0 0 1 0  0 
[8,] 0 0 0 0 0 0 0 1 1  1 
[9,] 0 0 0 0 0 0 0 0 0  0 
[10,] 0 0 0 0 0 0 0 0 0  0 

接下來的事情，我想通過1.以取代0個元素到1-元件的右手/上側對於上述矩陣所需的輸出將是：

 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 0 1 1 1 1 1 1 1 1  1 
[2,] 0 0 0 1 1 1 1 1 1  1 
[3,] 0 0 0 1 1 1 1 1 1  1 
[4,] 0 0 0 1 1 1 1 1 1  1 
[5,] 0 0 0 0 0 0 1 1 1  1 
[6,] 0 0 0 0 0 0 0 1 1  1 
[7,] 0 0 0 0 0 0 0 1 1  1 
[8,] 0 0 0 0 0 0 0 1 1  1 
[9,] 0 0 0 0 0 0 0 0 0  0 
[10,] 0 0 0 0 0 0 0 0 0  0 

我已經試過

fill <- function(row) {first = match(1, row); if (is.na(first)) {row = rep(1, 10)} else {row[first:10] = 1}; return(row)} 
field2 <- apply(field, 1, fill) 
field2 

但是，讓我來代替：

 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 0 0 0 0 0 0 0 0 1  1 
[2,] 1 0 0 0 0 0 0 0 1  1 
[3,] 1 0 0 0 0 0 0 0 1  1 
[4,] 1 1 1 1 0 0 0 0 1  1 
[5,] 1 1 1 1 0 0 0 0 1  1 
[6,] 1 1 1 1 0 0 0 0 1  1 
[7,] 1 1 1 1 1 0 0 0 1  1 
[8,] 1 1 1 1 1 1 1 1 1  1 
[9,] 1 1 1 1 1 1 1 1 1  1 
[10,] 1 1 1 1 1 1 1 1 1  1 

誰能幫助我解決這個問題？

乾杯，

MCE

PS：如果第一行是全零（因爲它可以與上面的代碼發生），應當改變爲全1。

Answer 1

這應該工作：

MaxFull <- which.max((apply(field,1,sum) > 0) * (1:10)) 
rbind(t(apply(field[1:MaxFull,], 1, fill)),matrix(0,ncol=10,nrow=10-MaxFull)) 

通知你定義它，它使用填充。

Answer 2

在apply的值的幫助中，「如果對FUN的每次調用都返回一個長度爲n的向量，則apply將返回一個維數爲c（n，dim（X）[MARGIN]）的數組」。所以，你需要這個轉置。打印語句已添加到填充功能以確認操作。你可能想要檢查你的函數是否隱藏了另一個函數，有一個名爲fill的函數，但在這種情況下並不重要。

n <- 20 
rw <- matrix(0, ncol = 2, nrow = n) 
indx <- cbind(seq(n), sample(c(1, 2), n, TRUE)) 
rw[indx] <- 1 
rw[,1] <- cumsum(rw[, 1])+1 
rw[,2] <- cumsum(rw[, 2])+1 
rw2 <- subset(rw, (rw[,1] <= 10 & rw[,2] <= 10)) 
field <- matrix(0, ncol = 10, nrow = 10) 
field[rw2] <- 1 
field 
myfill <- function(row) { 
    print("Function start") 
    print(row) 
    first = match(1, row) 
    print(paste("Match", first)) 
    if (is.na(first)) { 
    row = rep(1, 10) 
    } else { 
    row[first:10] = 1 
    }; 
    print(row) 
    flush.console() 
    return(row) 
} 
field2 = t(apply(field, 1, myfill)) 
field2 

Answer 3

爲什麼不乾脆：

t(apply(field,1,cummax)) 

一個實例：

dput(field) 
structure(c(0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0), .Dim = c(10L, 
10L)) 

> field 
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 0 0 0 0 0 0 0 0 0  0 
[2,] 1 1 1 1 1 1 0 0 0  0 
[3,] 0 0 0 0 0 1 0 0 0  0 
[4,] 0 0 0 0 0 1 0 0 0  0 
[5,] 0 0 0 0 0 1 1 1 1  1 
[6,] 0 0 0 0 0 0 0 0 0  0 
[7,] 0 0 0 0 0 0 0 0 0  0 
[8,] 0 0 0 0 0 0 0 0 0  0 
[9,] 0 0 0 0 0 0 0 0 0  0 
[10,] 0 0 0 0 0 0 0 0 0  0 

輸出：

> t(apply(field,1,cummax)) 
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
[1,] 0 0 0 0 0 0 0 0 0  0 
[2,] 1 1 1 1 1 1 1 1 1  1 
[3,] 0 0 0 0 0 1 1 1 1  1 
[4,] 0 0 0 0 0 1 1 1 1  1 
[5,] 0 0 0 0 0 1 1 1 1  1 
[6,] 0 0 0 0 0 0 0 0 0  0 
[7,] 0 0 0 0 0 0 0 0 0  0 
[8,] 0 0 0 0 0 0 0 0 0  0 
[9,] 0 0 0 0 0 0 0 0 0  0 
[10,] 0 0 0 0 0 0 0 0 0  0