Randomly fill an zero matrix with some ones with row and column constraints

Question

I create a matrix using r as follows:

Assignment <- matrix(rep(0,50), nrow = 10, ncol = 5)

I would like to randomly fill this matrix with 20 ones such that every row has 2 ones and every column has 4 ones.

I tried looping through row by row, keeping track of how often a 1 is put in the columns. This gives me correct row sums, but the column sums are not equally distributed.

How can one achieve this?

Answer 1

Option 1

Using igraph::sample_degseq

library(igraph)

set.seed(0)
sample_degseq(
  c(rep(2, 10), rep(0, 5)),
  c(rep(0, 10), rep(4, 5)),
  method = "simple.no.multiple"
) %>%
  set_vertex_attr(name = "type", value = degree(., mode = "out") == 0) %>%
  as_biadjacency_matrix()

gives a desired matrix like

   11 12 13 14 15
1   1  0  0  1  0
2   0  0  1  1  0
3   0  1  1  0  0
4   1  0  1  0  0
5   0  0  1  0  1
6   0  0  0  1  1
7   1  0  0  0  1
8   0  1  0  0  1
9   1  1  0  0  0
10  0  1  0  1  0

---

Option 2

Using r2dtable

set.seed(0)
repeat {
  mat <- r2dtable(1, rep(2, 10), rep(4, 5))[[1]]
  if (max(mat) == 1) break
}

gives

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

---

Option 3

Using pracma::circshift + sample.int

set.seed(0)
v <- c(rep(1, 4), rep(0, 6))
m <-sapply(2 * (0:4), pracma::circshift, a = v)
m[sample.int(10),sample.int(5)]

gives

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

---

Option 4

Following the same idea from Option 3 but using outer + %%

set.seed(0)
nr <- 10
nc <- 5
(+matrix((outer(
  seq(nr),
  (seq(nc) - 1) * nr / nc, `-`
) %% nr) %in% seq(2 * nr / nc), nr))[
  sample.int(nr),
  sample.int(nc)
]

gives

> set.seed(0)

> nr <- 10

> nc <- 5

> (+matrix((outer(
+   seq(nr),
+   (seq(nc) - 1) * nr / nc, `-`
+ ) %% nr) %in% seq(2 * nr / nc), nr))[
+   sample.int(nr),
+   sample.int(nc)
+ ]
      [,1] [,2] [,3] [,4] [,5]
 [1,]    0    1    0    1    0
 [2,]    0    0    1    0    1
 [3,]    1    0    0    1    0
 [4,]    0    1    1    0    0
 [5,]    0    1    1    0    0
 [6,]    1    0    0    0    1
 [7,]    0    0    1    0    1
 [8,]    0    1    0    1    0
 [9,]    1    0    0    0    1
[10,]    1    0    0    1    0