R：替换随机矩阵的“非对角线”元素答案

【问题标题】：R: Replace "off-diagonal" elements of a random matrixR：替换随机矩阵的“非对角线”元素
【发布时间】：2014-12-07 04:58:49
【问题描述】：

我正在使用以下代码生成一个随机矩阵，其中一些元素在对角线附近 = 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。

【问题讨论】：

upper.tri 和 lower.tri 能派上用场吗？
为什么不转置field2？
@Roman Luštrik：不是真的，因为那些不是真正的对角线元素，只是在主对角线附近的某个地方。
@jimifiki：这仍然不是我需要的。
@mce 为什么？您需要一种方法来区分开头的一个零和底部的一个，不是吗？

标签： r matrix replace

【解决方案1】：

为什么不只是：

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

【讨论】：

真正的 R 优雅！谢谢！
+1 很好地使用了cummax。反正输出的第一行是错误的。
@BondedDust Result[i,j] = 0 仅当（不存在 i' >= i 这样 field[i',j] = 1 AND 不存在 j'
您能否更具体地说明一下输出有什么问题？在这种情况下，正确的输出是什么？或者如何构建一个反例？
@BondedDust 据我了解，您示例的第一行应该用 1 填充。因为与第一行关联的格子元素位于路径的左上角。

【解决方案2】：

这应该有效：

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))

注意它使用你定义的填充。

【讨论】：

你是对的！您需要区分矩阵顶部或底部的零行！您的代码完成了这项工作！非常感谢，mce

【解决方案3】：

在 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

【讨论】：