Creating matrix with probabilities depending on index column - r

How do I create a matrix 10x10, with only 1's (heads), and 0's (tails), with the probability of a heads is 1 divided by the index of the column.
I tried several things but it won't work which is really frustrating. I tried to do it with a vector and a for loop.
mat <- matrix(sample(c(0,1), 100, replace=TRUE, prob=c(1/h, 1-(1/h)), 10))
But now the only question is how to define h.

Here is an option using sapply
n_col <- 10
n_row <- 10
mat <- matrix(nrow = n_row,
ncol = n_col)
set.seed(1)
sapply(1:n_col, function(x) {
mat[, x] <- sample(x = c(1, 0),
size = n_row,
replace = TRUE,
prob = c(1/x, 1 - 1/x))
})
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 0 1 0 1 0 1 0 0 0
# [2,] 1 0 0 0 0 1 0 0 0 0
# [3,] 1 1 0 0 0 0 0 0 0 0
# [4,] 1 0 0 0 0 0 0 0 0 0
# [5,] 1 1 0 1 0 0 0 0 0 0
# [6,] 1 0 0 0 0 0 0 1 0 0
# [7,] 1 1 0 1 0 0 0 0 0 0
# [8,] 1 1 0 0 0 0 0 0 0 0
# [9,] 1 0 1 0 0 0 0 0 0 0
#[10,] 1 1 0 0 0 0 1 1 0 0
Hope it helps.

Related

Set values along a diagonal in a matrix

I am trying to use the matrix() and diag() functions to create the following pattern, but with a 100 x 100 matrix rather than 5 x 5.
5 x 5 matrix:
| 0 1 0 0 0 |
| 1 0 1 0 0 |
| 0 1 0 1 0 |
| 0 0 1 0 1 |
| 0 0 0 1 0 |
In other words, I want to have two diagonals with values of 1, one to the left of the main diagonal, and one to the right of the main diagonal.
The diag() function (actually the diag<- function) can be used for assignment:
mat <- matrix( 0, 100,100)
diag(mat) <- 1
mat[1:10,1:10]
#-----------
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 0 0 0 0 0 0 0 0 0
[2,] 0 1 0 0 0 0 0 0 0 0
[3,] 0 0 1 0 0 0 0 0 0 0
[4,] 0 0 0 1 0 0 0 0 0 0
[5,] 0 0 0 0 1 0 0 0 0 0
[6,] 0 0 0 0 0 1 0 0 0 0
[7,] 0 0 0 0 0 0 1 0 0 0
[8,] 0 0 0 0 0 0 0 1 0 0
[9,] 0 0 0 0 0 0 0 0 1 0
[10,] 0 0 0 0 0 0 0 0 0 1
You, however, want the sub-diagonal and super-diagonal to be assigned values, so use logical expressions with col and row:
mat <- matrix( 0, 100,100)
mat[row(mat)==col(mat)-1] <- 1
mat[row(mat)==col(mat)+1] <- 1
mat[1:10,1:10]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 0 0 0 0 0 0 0 0
[2,] 1 0 1 0 0 0 0 0 0 0
[3,] 0 1 0 1 0 0 0 0 0 0
[4,] 0 0 1 0 1 0 0 0 0 0
[5,] 0 0 0 1 0 1 0 0 0 0
[6,] 0 0 0 0 1 0 1 0 0 0
[7,] 0 0 0 0 0 1 0 1 0 0
[8,] 0 0 0 0 0 0 1 0 1 0
[9,] 0 0 0 0 0 0 0 1 0 1
[10,] 0 0 0 0 0 0 0 0 1 0
(This method does not depend on having a square matrix. I have a vague memory that there is a faster method that does not require using row and col. For very large objects each of those functions returns a matrix of the same dimensions as their arguments.)
For the main diagonal, the row and column indices are the same. For the other diagonals, there is a difference of 1 between the row index and column index. Generate those indices directly and assign values in those indices.
sz = 5
m = matrix(0, sz, sz)
inds1 = cbind(r = 1:(sz-1), c = 2:sz)
inds2 = cbind(r = 2:sz, c = 1:(sz-1))
m[inds1] = 1
m[inds2] = 1
m
# OR, to make it concise
m = matrix(0, sz, sz)
inds = rbind(cbind(1:(sz-1), 2:sz), cbind(2:sz, 1:(sz-1)))
replace(m, inds, 1)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
We could create a function using a math trick which would work for all square matrix.
get_off_diagonal_1s <- function(n) {
#Create a matrix with all 0's
mat <- matrix(0, ncol = n, nrow = n)
#Subtract row indices by column indices
inds = row(mat) - col(mat)
#Replace values where inds is 1 or -1
mat[inds == 1 | inds == -1] = 1
mat
}
get_off_diagonal_1s(5)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
get_off_diagonal_1s(8)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#[1,] 0 1 0 0 0 0 0 0
#[2,] 1 0 1 0 0 0 0 0
#[3,] 0 1 0 1 0 0 0 0
#[4,] 0 0 1 0 1 0 0 0
#[5,] 0 0 0 1 0 1 0 0
#[6,] 0 0 0 0 1 0 1 0
#[7,] 0 0 0 0 0 1 0 1
#[8,] 0 0 0 0 0 0 1 0

How can I make a loop in R that produces these matrices?

I am trying to solve large scale assignment problems with Gurobi in R. I need a loop that will produce the constraint matrices for any n I specify since I will not be able to manually enter them for very large problems. I pasted sample matrices for n=2 and n=3 and also the code I have come up with for n=2. I need the n-i part to continue as 1, 2, 3, 4, etc. but each new row needs to be cumulative. I know I have a long way to go and I am very new to R. Any help would be appreciated, thanks.
n=2
1 1 0 0
0 0 1 1
1 0 1 0
0 1 0 1
n=3
1 1 1 0 0 0 0 0 0
0 0 0 1 1 1 0 0 0
0 0 0 0 0 0 1 1 1
1 0 0 1 0 0 1 0 0
0 1 0 0 1 0 0 1 0
0 0 1 0 0 1 0 0 1
library("gurobi")
model <- list()
n=2
i=0
while (i <= n-2) {
print(i)
i = i+1
}
i
a=rep(1,n)
b=rep(0,(n-i)*n)
c=rep(0,n)
d=rep(1,n)
e=rep(0,(n-i)*n)
f=rep(1:0, times=n)
g=rep(0:1, times=n)
model$A <- matrix(c(a,b,c,d,e,f,g), nrow=4, ncol=4, byrow=T)
model$obj <- c(1,2,3,4)
model$modelsense <- "min"
model$rhs <- c(1,1,1,1)
model$sense <- c('=', '=','=','=')
model$vtype <- 'B'
params <- list(OutputFlag=0)
result <- gurobi(model, params)
print('Solution:')
print(result$objval)
print(result$x)
Use kronecker products as shown:
make_mat <- function(k) {
d <- diag(k)
ones <- t(rep(1, k))
rbind( d %x% ones, ones %x% d )
}
lapply(2:3, make_mat)
giving:
[[1]]
[,1] [,2] [,3] [,4]
[1,] 1 1 0 0
[2,] 0 0 1 1
[3,] 1 0 1 0
[4,] 0 1 0 1
[[2]]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 1 1 0 0 0 0 0 0
[2,] 0 0 0 1 1 1 0 0 0
[3,] 0 0 0 0 0 0 1 1 1
[4,] 1 0 0 1 0 0 1 0 0
[5,] 0 1 0 0 1 0 0 1 0
[6,] 0 0 1 0 0 1 0 0 1

Create a binary adjacency matrix from a vector of indices

Suppose I have a vector that looks like this:
x <- sample(5, 500, replace = TRUE)
so that each element corresponds to some index from 1 through 5.
What's an efficient way to create a binary adjacency matrix from this vector? To elaborate, the matrix A should be such that A[i,j] = 1 if x[i] = x[j] and 0 otherwise.
In one line, you could do
outer(x, x, function(x, y) as.integer(x==y))
which returns
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 0 0 0 0 0 1 0 0 0
[2,] 0 1 1 1 0 1 0 0 1 0
[3,] 0 1 1 1 0 1 0 0 1 0
[4,] 0 1 1 1 0 1 0 0 1 0
[5,] 0 0 0 0 1 0 0 0 0 0
[6,] 0 1 1 1 0 1 0 0 1 0
[7,] 1 0 0 0 0 0 1 0 0 0
[8,] 0 0 0 0 0 0 0 1 0 0
[9,] 0 1 1 1 0 1 0 0 1 0
[10,] 0 0 0 0 0 0 0 0 0 1
or, in two lines
myMat <- outer(x, x, "==")
myMat[] <- as.integer(myMat)
Check that they're the same.
identical(myMat, outer(x, x, function(x, y) as.integer(x==y)))
[1] TRUE
data
set.seed(1234)
x <- sample(5, 10, replace = TRUE)

How to convert matrix elements from 0|1 to 1|0 in R?

I have a graph that converted to matrix.
g = sample_k_regular(10,3)
m =get.adjacency(g)
I want to select randomly some elements and convert to 0|1.(if it is 0 to become 1 and if it is 1 to become 0).
How to do this work?
You can make sample of n elements (10 in example) and change it
m1=as.matrix(m)
m1
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 1 1 0 0 0 0 1 0
[2,] 0 0 0 0 1 0 0 0 1 1
[3,] 1 0 0 0 0 0 0 1 0 1
[4,] 1 0 0 0 1 0 1 0 0 0
[5,] 0 1 0 1 0 1 0 0 0 0
[6,] 0 0 0 0 1 0 1 0 0 1
[7,] 0 0 0 1 0 1 0 1 0 0
[8,] 0 0 1 0 0 0 1 0 1 0
[9,] 1 1 0 0 0 0 0 1 0 0
[10,] 0 1 1 0 0 1 0 0 0 0
set.seed(1)
ss=sample(length(m1),size = 10)
m1[ss]=1-m1[ss]
m1
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 1 1 0 0 0 0 1 0
[2,] 0 0 0 0 1 0 1 0 1 1
[3,] 1 0 0 0 0 0 0 1 0 1
[4,] 1 0 0 0 1 0 1 0 0 0
[5,] 0 1 0 1 0 1 0 0 0 0
[6,] 1 0 0 0 1 0 1 0 1 1
[7,] 0 0 1 0 0 0 0 1 0 1
[8,] 0 0 1 0 0 1 1 0 1 0
[9,] 1 1 0 0 0 0 0 1 1 0
[10,] 0 0 1 0 0 1 0 0 0 0
For exclude diagonal as #ZheyuanLi told
you can calculate diad position and exlude it from data for sample :
m1=as.matrix(m)
m1
set.seed(1)
m_l=1:length(m1)
m_l=m_l[-which(diag(1,nrow = nrow(m1))==1)]
ss=sample(m_l,size = 10)
m1[ss]=1-m1[ss]
m1
For big matrix beter use seq.int than diag
n=1000
Unit: microseconds
expr min lq mean median uq max neval
{ which(diag(1, nrow = n) == 1) } 8976.718 9422.967 14397.44991 10489.0520 16001.550 190959.200 100
{ seq(1, by = n + 1, length = n) } 12.941 17.404 37.90449 31.9075 56.004 83.448 100
{ seq.int(1, by = n + 1, length = n) } 5.355 6.248 8.90736 7.1405 12.272 16.512 100
{ 1 + { (1:n) - 1 } * (1 + n) } 5.355 6.248 9.77758 8.9255 11.826 25.437 100

R : Updating a matrix given a set of indices

I have a matrix(initialized to zeros) and a set of indices. If the i'th value in indices is j, then I want to set the (j,i)th entry of the matrix to 1.
For eg:
> m = matrix(0, 10, 7)
> indices
[1] 2 9 3 4 5 1 10
And the result should be
> result
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 0 0 0 0 0 1 0
[2,] 1 0 0 0 0 0 0
[3,] 0 0 1 0 0 0 0
[4,] 0 0 0 1 0 0 0
[5,] 0 0 0 0 1 0 0
[6,] 0 0 0 0 0 0 0
[7,] 0 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0
[9,] 0 1 0 0 0 0 0
[10,] 0 0 0 0 0 0 1
I asked a somewhat related question a little while back, which used a vector instead of a matrix. Is there a similar simple solution to this problem?
## OP's example data
m = matrix(0, 10, 7)
j <- c(2, 9, 3, 4, 5, 1, 10)
## Construct a two column matrix of indices (1st column w. rows & 2nd w. columns)
ij <- cbind(j, seq_along(j))
## Use it to subassign into the matrix
m[ij] <- 1
m
# [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] 0 0 0 0 0 1 0
# [2,] 1 0 0 0 0 0 0
# [3,] 0 0 1 0 0 0 0
# [4,] 0 0 0 1 0 0 0
# [5,] 0 0 0 0 1 0 0
# [6,] 0 0 0 0 0 0 0
# [7,] 0 0 0 0 0 0 0
# [8,] 0 0 0 0 0 0 0
# [9,] 0 1 0 0 0 0 0
# [10,] 0 0 0 0 0 0 1
For the record, the answer in your linked question can easily be adapted to suit this scenario too by using sapply:
indices <- c(2, 9, 3, 4, 5, 1, 10)
sapply(indices, tabulate, nbins = 10)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] 0 0 0 0 0 1 0
# [2,] 1 0 0 0 0 0 0
# [3,] 0 0 1 0 0 0 0
# [4,] 0 0 0 1 0 0 0
# [5,] 0 0 0 0 1 0 0
# [6,] 0 0 0 0 0 0 0
# [7,] 0 0 0 0 0 0 0
# [8,] 0 0 0 0 0 0 0
# [9,] 0 1 0 0 0 0 0
# [10,] 0 0 0 0 0 0 1
For small datasets you might not notice the performance difference, but Josh's answer, which uses matrix indexing, would definitely be much faster, even if you changed my answer here to use vapply instead of sapply.

Resources