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)
Related
I want to make all combinations of my Matrix.
Ex. a binary 5 X 5 matrix where I only have two 1 rows (see below)
Com 1:
1 1 0 0 0
1 1 0 0 0
1 1 0 0 0
1 1 0 0 0
1 1 0 0 0
Com 2:
1 0 1 0 0
1 1 0 0 0
1 1 0 0 0
1 1 0 0 0
1 1 0 0 0
.
.
.
Com ?:
0 0 0 1 1
0 0 0 1 1
0 0 0 1 1
0 0 0 1 1
0 0 0 1 1
I tried using Combination package in R, but couldn't find a solution.
Using RcppAlgos (I am the author) we can accomplish this with 2 calls. It's quite fast as well:
library(tictoc)
library(RcppAlgos)
tic("RcppAlgos solution")
## First we generate the permutations of the multiset c(1, 1, 0, 0, 0)
binPerms <- permuteGeneral(1:0, 5, freqs = c(2, 3))
## Now we generate the permutations with repetition choose 5
## and select the rows from binPerms above
allMatrices <- permuteGeneral(1:nrow(binPerms), 5,
repetition = TRUE,
FUN = function(x) {
binPerms[x, ]
})
toc()
RcppAlgos solution: 0.108 sec elapsed
Here is the output:
allMatrices[1:3]
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 0 0
[2,] 1 1 0 0 0
[3,] 1 1 0 0 0
[4,] 1 1 0 0 0
[5,] 1 1 0 0 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 0 0
[2,] 1 1 0 0 0
[3,] 1 1 0 0 0
[4,] 1 1 0 0 0
[5,] 1 0 1 0 0
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 0 0
[2,] 1 1 0 0 0
[3,] 1 1 0 0 0
[4,] 1 1 0 0 0
[5,] 1 0 0 1 0
len <- length(allMatrices)
len
[1] 100000
allMatrices[(len - 2):len]
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 1 1
[2,] 0 0 0 1 1
[3,] 0 0 0 1 1
[4,] 0 0 0 1 1
[5,] 0 0 1 1 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 1 1
[2,] 0 0 0 1 1
[3,] 0 0 0 1 1
[4,] 0 0 0 1 1
[5,] 0 0 1 0 1
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 1 1
[2,] 0 0 0 1 1
[3,] 0 0 0 1 1
[4,] 0 0 0 1 1
[5,] 0 0 0 1 1
The code I've written below worked for me. A list of 100,000 5x5 matrices. Each of the rows has two places set to 1.
n <- 5 # No of columns
k <- 2 # No. of ones
m <- 5 # No of rows in matrix
nck <- combn(1:n,k,simplify = F)
possible_rows <-lapply(nck,function(x){
arr <- numeric(n)
arr[x] <- 1
matrix(arr,nrow=1)
})
mat_list <- possible_rows
for(i in 1:(m-1)){
list_of_lists <- lapply(mat_list,function(x){
lapply(possible_rows,function(y){
rbind(x,y)
})
})
mat_list <- Reduce(c,list_of_lists)
print(c(i,length(mat_list)))
}
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
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
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.
I have number of strings in an idiosyncratic format, representing sets. In R, I'd like to convert them into a similarity matrix.
For example, a string showing that 1+2 comprise a set, 3 is alone in a set, and 4,5, and 6 comprise a set is:
"1+2,3,4+5+6"
For the example above, I'd like to be able to produce
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 0 0 0 0
[2,] 1 1 0 0 0 0
[3,] 0 0 1 0 0 0
[4,] 0 0 0 1 1 1
[5,] 0 0 0 1 1 1
[6,] 0 0 0 1 1 1
It seems like this should be a painfully simple task. How would I go about it?
Here's an approach:
out <- lapply(unlist(strsplit("1+2,3,4+5+6", ",")), function(x) {
as.numeric(unlist(strsplit(x, "\\+")))
})
x <- table(unlist(out), rep(seq_along(out), sapply(out, length)))
matrix(x %*% t(x), nrow(x))
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 1 0 0 0 0
## [2,] 1 1 0 0 0 0
## [3,] 0 0 1 0 0 0
## [4,] 0 0 0 1 1 1
## [5,] 0 0 0 1 1 1
## [6,] 0 0 0 1 1 1
Pseudocode:
Split at , to get an array of strings, each describing a set.
For each element of the array:
Split at + to get an array of set members
Mark every possible pairing of members of this set on the matrix
You can create a matrix in R with:
m = mat.or.vec(6, 6)
By default, the matrix should initialize with all entries 0. You can assign new values with:
m[2,3] = 1
Here's another approach:
# write a simple function
similarity <- function(string){
sets <- gsub("\\+", ":", strsplit(string, ",")[[1]])
n <- as.numeric(tail(strsplit(gsub("[[:punct:]]", "", string), "")[[1]], 1))
mat <- mat.or.vec(n, n)
ind <- suppressWarnings(lapply(sets, function(x) eval(parse(text=x))))
for(i in 1:length(ind)){
mat[ind[[i]], ind[[i]]] <- 1
}
return(mat)
}
# Use that function
> similarity("1+2,3,4+5+6")
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 1 0 0 0 0
[2,] 1 1 0 0 0 0
[3,] 0 0 1 0 0 0
[4,] 0 0 0 1 1 1
[5,] 0 0 0 1 1 1
[6,] 0 0 0 1 1 1
# Using other string
> similarity("1+2,3,5+6+7, 8")
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 1 1 0 0 0 0 0 0
[2,] 1 1 0 0 0 0 0 0
[3,] 0 0 1 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 1 1 1 0
[6,] 0 0 0 0 1 1 1 0
[7,] 0 0 0 0 1 1 1 0
[8,] 0 0 0 0 0 0 0 1