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?

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?

• r
• matrix

Share Improve this question Follow edited Jan 11 at 21:37 ThomasIsCoding 104k99 gold badges3737 silver badges103103 bronze badges asked Jan 11 at 15:47 GeoffGeoff 1,00755 gold badges1515 silver badges4141 bronze badges 3

• Do you mean "randomly" as in each possible configuration that satisfies those constraints has a uniform chance of being the value of Assignment once the code finishes, or just that Assignment should be some arbitrary value that satisfies those constraints once the code finishes? – sillycone Commented Jan 11 at 15:53
• I don't need it to be so perfect in the way you say, but random enough that I can play with it for simple simulations. – Geoff Commented Jan 11 at 15:58
• 1 cran.r-project.org/web/packages/incidentally/vignettes/… : incidence.from.vector(rep(2, 10), rep(4, 5)) – user20650 Commented Jan 11 at 20:19

Add a comment  | 

2 Answers 2

Sorted by: Reset to default 4

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

I found that your strategy works if you just tell it to retry if the column sums aren't right, until it succeeds. Since the matrix is so small, this only takes about a second to run (on my machine).

generate_matrix <- function() {
  rows <- 10
  cols <- 5
  target_row_ones <- 2
  target_col_ones <- 4
  
  # Initialize the matrix with zeros
  matrix <- matrix(0, nrow = rows, ncol = cols)
  
  # Track the number of ones in each column
  col_count <- rep(0, cols)
  
  for (row in 1:rows) {
    # Identify columns that can accept more ones
    available_cols <- which(col_count < target_col_ones)
    
    # Randomly select 2 columns for the current row
    selected_cols <- sample(available_cols, target_row_ones)
    
    # Place ones in the selected columns and update column counts
    matrix[row, selected_cols] <- 1
    col_count[selected_cols] <- col_count[selected_cols] + 1
  }
  
  # Verify column constraints
  if (all(col_count == target_col_ones)) {
    return(matrix)
  } else {
    # Retry if constraints are not satisfied
    return(generate_matrix())
  }
}

# Generate and print the matrix
Assignment <- generate_matrix()
print(Assignment)