在矩阵中填充对角线和对角线+1答案

【问题标题】：Fill the diagonal and diagonal+1 in a matrix在矩阵中填充对角线和对角线+1
【发布时间】：2019-09-21 08:30:58
【问题描述】：

我想要一个到处都是 0 的矩阵，对角线和对角线 +1 有 0.5 个值。

我使用以下代码创建矩阵：

n = 10
transProbs = matrix(0, nrow = n, ncol = n)

然后，用以下内容填充对角线：

diag(transProbs) = 0.5

矩阵现在如下所示：

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

但是，我希望它是：

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

编辑：

此矩阵将在library(HMM)、initHMM 中用作transProbs 矩阵。

emissionProbs 我想要的输出是：

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

请注意，用 0.2 填充的是 diag +/-2。在第一个矩阵中，diag +1 用 0.5 填充。这意味着最终，概率可能会“重叠”并进入左下角。

【问题讨论】：

我相信diag的第二个参数是k，你可以用它来做非对角线
@MichaelChirico 不幸的是……

标签： r matrix

【解决方案1】：

diag(transProbs[,-1]) = 0.5 会做到的

在我的终端中，输出是：

transProbs
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
[10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

之后，您可以添加最后一个“突然出现”0.5： transProbs[10, 1] = 0.5

【讨论】：

现在的问题是我们在第 10 行第 1 列中缺少 0.5。也许使用 for 循环会更好...... :(
因为那个似乎没有遵循任何规则（它只是“无处不在”），我建议手动添加它，使用transProbs[10, 1] = 0.5。实际上，我相信即使使用 for 循环，您也需要手动添加它。为方便起见，我进行了编辑
谢谢，不过我现在已经更新了这个问题，因为我需要一个更通用的形式来创建这些矩阵。
@Jesper.Lindberg 问题的更新应该澄清原始问题的一些细节，但不能修改它并显着扩大其范围。如果人们试图帮助您解决特定问题，他们可能会在稍后得知您实际上在寻找不同的东西时感到沮丧。
@RHertel 我完全明白了，我应该更清楚地知道我想要一个通用的形式。

【解决方案2】：

使用矩阵是具有dim 属性的向量这一事实的另一种解决方案。

n <- 10
m <- 10
transProbs = matrix(0.0, nrow = n, ncol = m)

diag(transProbs) <- 0.5
transProbs[(1:(m - 1)) * (n + 1)] <- 0.5
transProbs
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#>  [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#>  [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
#>  [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
#> [10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

^{由reprex package (v0.3.0) 于 2019 年 9 月 21 日创建}

序列(1:(m - 1)) * (n + 1) 从对角线上选择所有矩阵元素。

编辑

您可以实现您在编辑中提出的要求，将同一序列的其余模数（加上一个移位）与总和中的元素总数相结合，即

n <- 10
m <- 10
transProbs = matrix(0.0, nrow = n, ncol = m)

diag(transProbs) <- 0.2
transProbs[((1:m) * (n + 1)) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + m) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + 7 * m) %% (n * m)] <- 0.2
transProbs[((1:m) * (n + 1) + 8 * m) %% (n * m)] <- 0.2

transProbs
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
#>  [2,]  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
#>  [3,]  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2   0.2
#>  [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2   0.2
#> [10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.2

^{由reprex package (v0.3.0) 于 2019 年 9 月 21 日创建}

您可以确定移位的值（即+m、+7m 和+8m）查看序列开始的列并减去 2。例如，要生成从第三列开始的序列必须求和(3 - 2)*m，这就是m。

我希望它清楚。

【讨论】：

谢谢，不过我现在已经更新了这个问题，因为我需要一个更通用的形式来创建这些矩阵。
@Jesper.Lindberg，我根据您的编辑修改了答案。

【解决方案3】：

我不喜欢这个解决方案，但它确实有效：

element_on_diagonal <- 0.5
element_above_and_below_diaginal <- 0.2

a <- diag(x = element_on_diagonal,
          nrow = 10)

for(i in seq_len(length.out = ncol(x = a)))
{
  temp <- sapply(X = setdiff(x = seq(from = (i - 2),
                                     to = (i + 2)),
                             y = i),
                 FUN = function(j) if (j %in% 1:10) j else if (j != 0) j %% 10 else 10)
  a[temp, i] <- element_above_and_below_diaginal
}

a
#>       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#>  [1,]  0.5  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
#>  [2,]  0.2  0.5  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
#>  [3,]  0.2  0.2  0.5  0.2  0.2  0.0  0.0  0.0  0.0   0.0
#>  [4,]  0.0  0.2  0.2  0.5  0.2  0.2  0.0  0.0  0.0   0.0
#>  [5,]  0.0  0.0  0.2  0.2  0.5  0.2  0.2  0.0  0.0   0.0
#>  [6,]  0.0  0.0  0.0  0.2  0.2  0.5  0.2  0.2  0.0   0.0
#>  [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.5  0.2  0.2   0.0
#>  [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.5  0.2   0.2
#>  [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.5   0.2
#> [10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.5

【讨论】：

请注意，您现在混合了 0.5 和 0.2，它们应该是不同的矩阵。但是，通过一些修改，这将起作用。
@Jesper.Lindberg 我从你原来的问题开始，它有0.5，然后你改变了你的问题。无论如何，您需要的唯一“修改”是在element_on_diagonal 的第一行，以便在您的问题中获得第二个矩阵。要获得第一个矩阵，您所要做的就是将setdiff(...) 替换为i - 1，而sapply 对于这种情况来说有点太多了。最好做个函数。

【解决方案4】：

首先创建一个函数来左右移动一个向量（注意 - 几乎可以肯定有一个库或函数已经这样做了，但我找不到它！）

shiftSeq <- function(n, shift){
    #return vector 1:n, but start shifted
    # e.g. shiftSeq(5,shift=1) returns c(2,3,4,5,1)
    # e.g. shiftSeq(5,shift=-1) returns c(5,1,2,3,4)

    if(shift>=1){
        res <- c((shift+1):n, 1:(shift))
    } else if(shift==0){
        res <- 1:n
    } else{
        res <- c((n+1+shift):n, 1:(n+shift))
    }

    return(res)
}

> shiftSeq(5,shift=1)
[1] 2 3 4 5 1

我们将在另一个函数中使用这个shiftSeq 函数（如下）。这个想法是使用apply 和shiftSeq 来上下移动“积木”对角矩阵中的每一列，我们做了几次，每次在结果矩阵中累积这个移动的矩阵。

关键是正确设置rowShift和colShift参数...

createTranProb <- function(n, prob, rowShift, colShift){
    # create transition probability matrix of size nxn
    #  - prob is non-zero prob
    #  - rowShift is number of rows to move prob down
    #  - colShift is number of cols to move prob to right

    shifts = setdiff(c(-rowShift:colShift), 0)
    matDiag <- diag(n)*prob
    matRes <- matDiag

    for(i in shifts){
        matRes <- matRes +
            apply(matDiag, 2, 
                  function(x) x[shiftSeq(n,i)])
    }
    return(matRes)
}

它适用于 prob=0.5 的情况：

> createTranProb(10, 0.5, rowShift=0, colShift=1)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
 [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
 [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
[10,]  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

如果我们设置rowShift=2 和colShift=2，就像prob=0.2 一样：

> createTranProb(10, 0.2, 2, 2)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2   0.2
 [2,]  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0  0.0   0.2
 [3,]  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0  0.0   0.0
 [4,]  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0  0.0   0.0
 [5,]  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0  0.0   0.0
 [6,]  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2  0.0   0.0
 [7,]  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2  0.2   0.0
 [8,]  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2  0.2   0.2
 [9,]  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2  0.2   0.2
[10,]  0.2  0.2  0.0  0.0  0.0  0.0  0.0  0.2  0.2   0.2

只是为了好玩，我添加了一个 prob=0.33333：

> createTranProb(10, 0.33333, 1, 1)
         [,1]    [,2]    [,3]    [,4]    [,5]    [,6]    [,7]    [,8]    [,9]   [,10]
 [1,] 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333
 [2,] 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000
 [3,] 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000
 [4,] 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000
 [5,] 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000 0.00000
 [6,] 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000 0.00000
 [7,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000 0.00000
 [8,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333 0.00000
 [9,] 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333 0.33333
[10,] 0.33333 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.00000 0.33333 0.33333

【讨论】：

【解决方案5】：

我会使用矩阵索引（允许您根据“坐标”替换行）；如果您查看diag<- (print(`diag<-`)) 的源代码，您会发现它针对更简单的仅对角线的情况执行此操作。

NN = nrow(transProbs)
idx = seq_len(NN)
transProbs[cbind(idx, idx)] = .5 # replace diagonal
transProbs[cbind(idx[-NN], idx[-NN] + 1L)] = .5 # replace off-diagonal

transProbs
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#  [1,]  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#  [2,]  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0  0.0   0.0
#  [3,]  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0  0.0   0.0
#  [4,]  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0  0.0   0.0
#  [5,]  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0  0.0   0.0
#  [6,]  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0  0.0   0.0
#  [7,]  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5  0.0   0.0
#  [8,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5  0.5   0.0
#  [9,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.5   0.5
# [10,]  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0   0.5

您也可以在一个 [<- 调用中执行此操作，但它有点难看/更难阅读：

transProbs[cbind(c(idx, idx[-NN]), c(idx, idx[-NN] + 1L))] = .5

这可能稍微更有效率，但因为只有第一个 [<- 调用复制了 transProbs（参见 ?tracemem 和 .Internal(inspect(transProbs))），我认为他的差异应该很小。

【讨论】：