Convert a string into a similarity matrix - r

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

Related

How to create a matrix from all possible combinations of 2 or more matrices?

Let's say, there are two matrices:
A <- B <- diag(3)
> A
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1
I want to create a new matrix AB, which consists of all the possible combinations of rows of A and B. Expected result:
> AB
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 0 0 1 0 0
[2,] 1 0 0 0 1 0
[3,] 1 0 0 0 0 1
[4,] 0 1 0 1 0 0
[5,] 0 1 0 0 1 0
[6,] 0 1 0 0 0 1
[7,] 0 0 1 1 0 0
[8,] 0 0 1 0 1 0
[9,] 0 0 1 0 0 1
How to do this efficiently? And can it be extended for more than two matrices?
You can use expand.grid() and take its output to index the matrix A and B,
x <- expand.grid(1:3,1:3)
cbind(A[x[,1],], B[x[,2],])
gives,
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 0 0 1 0 0
[2,] 0 1 0 0 1 0
[3,] 0 0 1 0 0 1
[4,] 1 0 0 1 0 0
[5,] 0 1 0 0 1 0
[6,] 0 0 1 0 0 1
[7,] 1 0 0 1 0 0
[8,] 0 1 0 0 1 0
[9,] 0 0 1 0 0 1
EDIT:
For more than two matrices, you can use a function like below,
myfun <- function(...) {
arguments <- list(...)
a <- expand.grid(lapply(arguments, function(x) 1:nrow(x)))
do.call(cbind,lapply(seq(a),function(x) { arguments[[x]][a[,x],] }))
}
out <- myfun(A,B,C)
head(out)
gives,
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 0 0 1 0 0 1 0 0 0
[2,] 0 1 0 1 0 0 1 0 0 0
[3,] 0 0 1 1 0 0 1 0 0 0
[4,] 1 0 0 0 1 0 1 0 0 0
[5,] 0 1 0 0 1 0 1 0 0 0
[6,] 0 0 1 0 1 0 1 0 0 0
Data:
A <- B <- diag(3)
C <- diag(4)

R: Matrix Combination with specific number of values

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

Obtain matrices by switch a one and a zero-Local search

Let's start with the following matrix.
M <- matrix(c(0,0,0,1,0,0,1,1,
0,0,1,0,0,1,1,0,
0,0,0,0,0,1,1,1,
0,0,0,1,1,0,1,0,
0,0,0,1,1,1,0,0,
0,0,1,0,1,0,0,1),nrow = 8,ncol = 6)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 0 0 0 0 0
[3,] 0 1 0 0 0 1
[4,] 1 0 0 1 1 0
[5,] 0 0 0 1 1 1
[6,] 0 1 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
I want to obtain set of matrices by switching ones and zeros. For each column, starting from column 1, I wanna obtain set of matrices by switching 1 in (4,1) with 0 in (1,1), (2,1), (3,1), (5,1), (6,1) and then do the same for 1s in (7,1) and (8,1). Then continue to the other columns. There are altogether
90 matrices (15 for each column, 15*6) after switching. This is just an example. I have bigger size matrices. How do I generalize for other cases?
Here's a solution. You could wrap the whole thing up into a function. It produces a list of lists of matrices, results, where results[[i]] is a list of matrices with the ith column switched.
column_switcher = function(x) {
ones = which(x == 1)
zeros = which(x == 0)
results = matrix(rep(x, length(ones) * length(zeros)), nrow = length(x))
counter = 1
for (one in ones) {
for (zero in zeros) {
results[one, counter] = 0
results[zero, counter] = 1
counter = counter + 1
}
}
return(results)
}
switched = lapply(1:ncol(M), function(col) column_switcher(M[, col]))
results = lapply(seq_along(switched), function(m_col) {
lapply(1:ncol(switched[[m_col]]), function(i) {
M[, m_col] = switched[[m_col]][, i]
return(M)
})
})
results[[1]]
# [[1]]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 0 0 0 0 0
# [2,] 0 0 0 0 0 0
# [3,] 0 1 0 0 0 1
# [4,] 0 0 0 1 1 0
# [5,] 0 0 0 1 1 1
# [6,] 0 1 1 0 1 0
# [7,] 1 1 1 1 0 0
# [8,] 1 0 1 0 0 1
#
# [[2]]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 0 0 0 0 0 0
# [2,] 1 0 0 0 0 0
# [3,] 0 1 0 0 0 1
# [4,] 0 0 0 1 1 0
# [5,] 0 0 0 1 1 1
# [6,] 0 1 1 0 1 0
# [7,] 1 1 1 1 0 0
# [8,] 1 0 1 0 0 1
#
# ...
Checking the length of the list and the lengths of the sublists, they're all there.
length(results)
# [1] 6
lengths(results)
# [1] 15 15 15 15 15 15

use of the [<- operator to modify a line of data

I have some data
data <- diag(5)
I want to use the [<- operator to change a line.
The result should be:
data[1,] <- 2
> data
[,1] [,2] [,3] [,4] [,5]
[1,] 2 2 2 2 2
[2,] 0 1 0 0 0
[3,] 0 0 1 0 0
[4,] 0 0 0 1 0
[5,] 0 0 0 0 1
I know I can do e.g.
`[<-`(data, i=1, j=3, 2)
which gives
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 8 0 0
[2,] 0 1 0 0 0
[3,] 0 0 1 0 0
[4,] 0 0 0 1 0
[5,] 0 0 0 0 1
but how can I operate on line (or column, same issue)?
I tried j=NULL, j=integer(0), it doesn't work. I could do j=1:5 and get what I want but I am wondering how to mimic data[1,] <- 2 and not data[1,1:5] <- 2.
> `[<-`(data, 1, , 2) # blank 2nd argument
[,1] [,2] [,3] [,4] [,5]
[1,] 2 2 2 2 2
[2,] 0 1 0 0 0
[3,] 0 0 1 0 0
[4,] 0 0 0 1 0
[5,] 0 0 0 0 1
You can use ncol to ensure that all columns are set:
`[<-`(data, i = 1, j = 1:ncol(data), 2)

Generate large matrix filled with 0's or 1's in R

In R language, I am trying to generate a large matrix filled with 0's and 1's.
I have generated a large matrix but its filled with values between 0 and 1.
Here is how I did that:
NCols=500
NRows=700
mr<-matrix(runif(NCols*NRows), ncol=NCols)
I think you are asking how to generate a matrix with just zero and 1
Here is how I would do it
onezero <- function(nrow,ncol)
matrix(sample(c(0,1), replace=T, size=nrow*ncol), nrow=nrow)
With nrow and ncol the rows and columns of the matrix
R> onezero(5,5)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 1 0
[2,] 1 1 1 1 0
[3,] 1 1 0 0 0
[4,] 1 0 0 1 0
[5,] 0 0 0 0 0
You can use rbinomtoo. And can change the probability of success on each trial. In this case, it's .5.
nrow<-700
ncol<-500
mat01 <- matrix(rbinom(nrow*ncol,1,.5),nrow,ncol)
> number.of.columns = 5
> number.of.rows = 10
> matrix.size = number.of.columns*number.of.rows
> ones.and.zeros.samples = sample(0:1, matrix.size, replace=TRUE)
> A = matrix(ones.and.zeros.samples, number.of.rows)
> A
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 1 1
[2,] 1 0 0 0 1
[3,] 0 1 1 0 0
[4,] 0 0 1 1 1
[5,] 1 0 1 1 0
[6,] 0 1 0 1 1
[7,] 0 0 1 1 0
[8,] 0 1 0 0 0
[9,] 0 0 0 0 0
[10,] 0 0 0 1 1

Resources