8

I have a symmetric matrix that I want to randomly shuffle while keeping the diagonal elements unchanged. The rows all sum to 1 and should still sum to 1 after shuffling.

Toy example below:

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

I would like a matrix B with the same diagonal elements as A and still symmetric, but with the elements randomly shuffled to generate something like

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

My aim is to do that on a 24 *24 matrix, so the code can be messy and no need to have something with a low computational cost. So far, I have tried with a loop but the code quickly gets excessively complicated and I was wondering whether there was a more straightforward way to do it.

Henrik
  • 65,555
  • 14
  • 143
  • 159
Ajmal
  • 137
  • 7

5 Answers5

3

Get indices of non-diagonal elements. Subset values and row indices. Within each row, shuffle values and assign back.

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

If you don't want to overwrite the original matrix, assign to a copy instead.

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
Henrik
  • 65,555
  • 14
  • 143
  • 159
  • This question/answer pairing is weird here--the question asks for a result that is symmetric and yet provides a toy example with an intended result that isn't symmetric. How would one ensure the resulting matrix is symmetric? – Bajcz Feb 16 '22 at 15:16
2

Since you want to keep rowwise sum as 1 you can only shuffle each row elements excluding diagonal elements in each row.

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
Ronak Shah
  • 377,200
  • 20
  • 156
  • 213
  • A one-liner: `t(sapply(seq(nrow(A)), function(x) {A[x, -x] <- A[x, sample(-x)]; A[x,]}))` – Maël Jan 12 '22 at 14:45
2

Try the code below

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

which gives

     [,1] [,2] [,3]
[1,]  0.6  0.1  0.3
[2,]  0.3  0.6  0.1
[3,]  0.1  0.3  0.6
ThomasIsCoding
  • 96,636
  • 9
  • 24
  • 81
1

One option could be:

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
tmfmnk
  • 38,881
  • 4
  • 47
  • 67
1

A base R solution:

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

Another solution, this time based on 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
PaulS
  • 21,159
  • 2
  • 9
  • 26