随机化对称矩阵的非对角元素答案

【问题标题】：Randomize non-diagonal elements of symmetric matrix随机化对称矩阵的非对角元素
【发布时间】：2022-01-12 12:24:51
【问题描述】：

我有一个对称矩阵，我想在保持对角元素不变的同时随机洗牌。这些行的总和为 1，并且在洗牌后仍应为 1。

下面的玩具示例：

A <- rbind(c(0.6,0.1,0.3),c(0.1,0.6,0.3),c(0.1,0.3,0.6))
A
#      [,1] [,2] [,3]
# [1,]  0.6  0.1  0.3
# [2,]  0.1  0.6  0.3
# [3,]  0.1  0.3  0.6

我想要一个矩阵 B，它具有与 A 相同的对角元素并且仍然是对称的，但是元素随机打乱以生成类似的东西

B <- rbind(c(0.6,0.3,0.1), c(0.3,0.6,0.1), c(0.3,0.1,0.6))
B
#      [,1] [,2] [,3]
# [1,]  0.6  0.3  0.1
# [2,]  0.3  0.6  0.1
# [3,]  0.3  0.1  0.6

我的目标是在 24 *24 矩阵上执行此操作，因此代码可能很混乱，并且不需要计算成本低的东西。到目前为止，我已经尝试过使用循环，但代码很快变得过于复杂，我想知道是否有更直接的方法来做到这一点。

【问题讨论】：

标签： r matrix random shuffle

【解决方案1】：

获取非对角元素的索引。子集值和行索引。在每一行中，随机排列值并重新分配。

i = row(A) != col(A)
A[i] = ave(A[i], row(A)[i], FUN = sample)
A
#      [,1] [,2] [,3]
# [1,]  0.6  0.1  0.3
# [2,]  0.3  0.6  0.1
# [3,]  0.3  0.1  0.6

如果您不想覆盖原始矩阵，请改为分配给副本。

A = rbind(c(0.6,0.1,0.3), c(0.1,0.6,0.3), c(0.1,0.3,0.6))
i = row(A) != col(A)
A2 = A

set.seed(1)
A2[i] = ave(A[i], row(A)[i], FUN = sample)
A2
#      [,1] [,2] [,3]
# [1,]  0.6  0.1  0.3
# [2,]  0.1  0.6  0.3
# [3,]  0.3  0.1  0.6

set.seed(12)
A2[i] = ave(A[i], row(A)[i], FUN = sample)
A2
#      [,1] [,2] [,3]
# [1,]  0.6  0.3  0.1
# [2,]  0.3  0.6  0.1
# [3,]  0.1  0.3  0.6

【讨论】：

这个问题/答案配对在这里很奇怪——这个问题要求一个对称的结果，但提供了一个具有不对称预期结果的玩具示例。如何确保生成的矩阵是对称的？

【解决方案2】：

由于您希望将逐行总和保持为 1，因此您只能对每行元素进行洗牌，不包括每行中的对角线元素。

set.seed(2021)

t(sapply(seq(nrow(A)), function(x) {
  tmp <- A[x, ]
  tmp[-x] <- sample(tmp[-x])
  tmp
}))

#     [,1] [,2] [,3]
#[1,]  0.6  0.1  0.3
#[2,]  0.3  0.6  0.1
#[3,]  0.1  0.3  0.6

【讨论】：

单行：t(sapply(seq(nrow(A)), function(x) {A[x, -x] <- A[x, sample(-x)]; A[x,]}))

【解决方案3】：

试试下面的代码

t(mapply(
  function(x, k) replace(x, k, sample(x[k])),
  asplit(A, 1),
  asplit(row(A) != col(A), 1)
))

给了

     [,1] [,2] [,3]
[1,]  0.6  0.1  0.3
[2,]  0.3  0.6  0.1
[3,]  0.1  0.3  0.6

【讨论】：

每一行的总和为 1。
@Maël 感谢您的纠正。请查看我的更新。

【解决方案4】：

一个选项可能是：

set.seed(123)
t(mapply(function(x, y) {
    ind <- which(seq_along(x) != y)
    `[<-`(x, ind, sample(x[ind]))
    },
    x = asplit(A, 1),
    y = 1:nrow(A)))

     [,1] [,2] [,3]
[1,]  0.6  0.1  0.3
[2,]  0.1  0.6  0.3
[3,]  0.1  0.3  0.6

【讨论】：

【解决方案5】：

基础 R 解决方案：

n <- 3

t(apply(cbind(A, 1:n), 1, 
  function(x) {x[-c(x[n+1], n+1)] <- sample(x[-c(x[n+1], n+1)]); x[1:3]}))

另一种解决方案，这次基于tidyverse/purrr：

library(tidyverse)

A <- rbind(c(0.6,0.1,0.3),c(0.1,0.6,0.3),c(0.1,0.3,0.6))
n <- 3

set.seed(23)

t(A) %>% as.data.frame %>% 
  map2_dfr(1:n, ~ {.x[-.y] <- sample(.x[-.y], n-1); .x}) %>%
  unname %>% as.matrix %>% t

#>      [,1] [,2] [,3]
#> [1,]  0.6  0.1  0.3
#> [2,]  0.3  0.6  0.1
#> [3,]  0.3  0.1  0.6

【讨论】：