Q1=c(0,1,0,1,0,1,0,1)
Q2=c(1,0,0,0,1,1,1,0)
Q3=c(0,0,0,0,0,0,0,0)
Q4=c(1,0,0,0,1,1,1,0)
Q = cbind(Q1,Q2, Q3, Q4)
Q = matrix(Q, 8, 4)
[,1] [,2] [,3] [,4]
[1,] 0 1 0 1
[2,] 1 0 0 0
[3,] 0 0 0 0
[4,] 1 0 0 0
[5,] 0 1 0 1
[6,] 1 1 0 1
[7,] 0 1 0 1
[8,] 1 0 0 0
I want to write a function
ifelse(Q[1]==1||Q[2]==1, 1,0)
and then keep increasing for column 3 and 4
ifelse(Q[3]==1||Q[4]==1, 1,0)
Return matrix
This is my code:
n = function(n){
x <- matrix(n row= 8,n col=n)
for(i in 1:n){
for (j in 1: 4){
i = 1
j = 1
x[,i]= apply(Q, 1, function(x)if else(x[j]==1||x[j+1]==1, 1,0))
j = j+2
}
return(x)
}
}
n(1)
n(2)
[,1] [,2]
[1,] 1 NA
[2,] 1 NA
[3,] 0 NA
[4,] 1 NA
[5,] 1 NA
[6,] 1 NA
[7,] 1 NA
I think I did something wrong,the new matrix suppose, plus I have over 100 columns, so I have to write increase loop every 2 columns
[,1] [,2]
[1,] 1 1
[2,] 1 0
[3,] 0 0
[4,] 1 0
[5,] 1 1
[6,] 1 1
[7,] 1 1
Thanks guys,now this time I got right. We can group by how many variables you want. I have 2 ways to do that, the first one is not good, the second one is better
> Q1=c(0,1,0,1,0,1,0,1)
> Q2=c(1,0,0,0,1,1,1,0)
> Q3=c(0,0,0,0,0,0,0,0)
> Q4=c(1,0,0,0,1,1,1,0)
> Q5=c(1,0,0,0,1,1,1,0)
> Q6=c(0,0,0,0,0,0,0,0)
> Q7=c(1,0,0,0,1,1,1,0)
> Q8=c(0,0,0,0,0,0,0,0)
> Q9=c(1,0,0,0,1,1,1,0)
> Q = cbind(Q1,Q2, Q3, Q4, Q5, Q6, Q7, Q8, Q9)
> Q = matrix(Q, 8, 9)
> Q
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 0 1 0 1 1 0 1 0 1
[2,] 1 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0 0
[4,] 1 0 0 0 0 0 0 0 0
[5,] 0 1 0 1 1 0 1 0 1
[6,] 1 1 0 1 1 0 1 0 1
[7,] 0 1 0 1 1 0 1 0 1
[8,] 1 0 0 0 0 0 0 0 0
This is the first way
> x <- list(1:3,4:6,7:9)
> do.call(cbind, lapply(x, function(i) ifelse(rowSums(Q[,i]>=1), 1,0)))
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 1 0 0
[3,] 0 0 0
[4,] 1 0 0
[5,] 1 1 1
[6,] 1 1 1
[7,] 1 1 1
[8,] 1 0 0
>
This is the second way, it's better
> Q.t <- data.frame(t(Q))
> n <- 3
> Q.t$groups <- rep(seq(1:(ncol(Q)/n)), each = n, len = (ncol(Q)))
> QT <- data.table(Q.t)
> setkey(QT, groups)
> Q.level <- QT[,lapply(.SD,sum), by = groups]
> Q.level <- t(Q.level)
> Q.level <- Q.level[-1,]
> apply(Q.level,2, function(x) ifelse(x>=1,1,0))
[,1] [,2] [,3]
X1 1 1 1
X2 1 0 0
X3 0 0 0
X4 1 0 0
X5 1 1 1
X6 1 1 1
X7 1 1 1
X8 1 0 0
>
Related
I created the following matrix, in R
P = as.matrix(expand.grid(0:1, 0:1, 0:1, 0:1))
P = P[-1,]
Var1 Var2 Var3 Var4
[1,] 1 0 0 0
[2,] 0 1 0 0
[3,] 1 1 0 0
[4,] 0 0 1 0
[5,] 1 0 1 0
[6,] 0 1 1 0
[7,] 1 1 1 0
[8,] 0 0 0 1
[9,] 1 0 0 1
[10,] 0 1 0 1
[11,] 1 1 0 1
[12,] 0 0 1 1
[13,] 1 0 1 1
[14,] 0 1 1 1
[15,] 1 1 1 1
Is there a way to arrange the rows of P and obtain the following ??
P = matrix(c(1,1,1,1,0,1,1,1,0,0,1,1,0,0,0,1,1,1,1,0,0,1,1,0,0,0,1,0,1,1,0,0,0,1,0,0,1,0,0,0),10,4,byrow=TRUE)
[,1] [,2] [,3] [,4]
[1,] 1 1 1 1
[2,] 0 1 1 1
[3,] 0 0 1 1
[4,] 0 0 0 1
[5,] 1 1 1 0
[6,] 0 1 1 0
[7,] 0 0 1 0
[8,] 1 1 0 0
[9,] 0 1 0 0
[10,] 1 0 0 0
In a generic way? i.e. if I increase the colums of P as as.matrix(expand.grid(0:1, 0:1, 0:1, 0:1, 0:1, 0:1)) I would like to have an equivalent rearrangement.
You can try creating the matrix you want directly by using something like this:
fun <- function(nc = 4) {
out <- lapply(rev(seq.int(nc)), function(x) {
a <- matrix(1L, ncol = x, nrow = x)
a[lower.tri(a)] <- 0L
if (x == nc) {
a
} else {
b <- matrix(0L, ncol = nc - x, nrow = nrow(a))
cbind(a, b)
}
})
do.call(rbind, out)
}
fun(4)
# [,1] [,2] [,3] [,4]
# [1,] 1 1 1 1
# [2,] 0 1 1 1
# [3,] 0 0 1 1
# [4,] 0 0 0 1
# [5,] 1 1 1 0
# [6,] 0 1 1 0
# [7,] 0 0 1 0
# [8,] 1 1 0 0
# [9,] 0 1 0 0
# [10,] 1 0 0 0
Here is a function that creates the matrix in the question and is extensible to any number of columns.
makeMat <- function(n){
f <- function(n){
p <- diag(n)
p[upper.tri(p)] <- 1
p
}
P <- lapply(rev(seq.int(n)), f)
P[-1] <- lapply(seq_along(P)[-1], function(i, n){
Q <- matrix(0, nrow = n - i + 1, ncol = i - 1)
cbind(P[[i]], Q)
}, n = n)
do.call(rbind, P)
}
makeMat(4)
# [,1] [,2] [,3] [,4]
# [1,] 1 1 1 1
# [2,] 0 1 1 1
# [3,] 0 0 1 1
# [4,] 0 0 0 1
# [5,] 1 1 1 0
# [6,] 0 1 1 0
# [7,] 0 0 1 0
# [8,] 1 1 0 0
# [9,] 0 1 0 0
#[10,] 1 0 0 0
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)))
}
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
I'm trying to create a function where at every time step in a matrix, the cells adjacent and diagonal to a 1 become 1 as well.
For example, something like this:
Input
0 0 0 0 0
0 1 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0
Output after first time step
1 1 1 0 0
1 1 1 0 0
1 1 1 0 0
0 0 0 0 0
0 0 0 0 0
So far, I have this:
A = matrix(0,nrow=5,ncol=5)
A[2,2]=1
for (i in 1:5){
for (j in 1:5){
if ((A[i,j]==1)) {
A[,(j+1)]=1
A[,(j-1)]=1
A[(i+1),]=1
A[(i-1),]=1
A[(i+1),(j+1)]=1
A[(i+1),(j-1)]=1
A[(i-1),(j+1)]=1
A[(i-1),(j-1)]=1
}
}
}
I'm not too sure how to integrate a function in there, so I can have the resulting matrix for whatever time step I want.
You could determine if a bit is set either in the matrix or the matrix when it is shifted in any of the 8 legitimate directions (right, left, up, down, up-right, down-right, down-left, up-left):
spread <- function(X) unname(X |
rbind(F, head(X, -1)) |
rbind(tail(X, -1), F) |
cbind(F, X[,-ncol(X)]) |
cbind(X[,-1], F) |
cbind(F, rbind(F, head(X, -1))[,-ncol(X)]) |
cbind(rbind(F, head(X, -1))[,-1], F) |
cbind(F, rbind(tail(X, -1), F)[,-ncol(X)]) |
cbind(rbind(tail(X, -1), F)[,-1], F)) * 1
X <- matrix(rep(c(0, 1, 0), c(6, 1, 18)), nrow=5)
spread(X)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 0 0
# [2,] 1 1 1 0 0
# [3,] 1 1 1 0 0
# [4,] 0 0 0 0 0
# [5,] 0 0 0 0 0
You can apply the function repeatedly to further spread the data:
spread(spread(X))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 0
# [2,] 1 1 1 1 0
# [3,] 1 1 1 1 0
# [4,] 1 1 1 1 0
# [5,] 0 0 0 0 0
spread(spread(spread(X)))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 1 1 1 1
# [3,] 1 1 1 1 1
# [4,] 1 1 1 1 1
# [5,] 1 1 1 1 1
This works for multiple 1's in the initial matrix that also can be in the first/last column/row.
A <- matrix(0, nrow = 5, ncol = 5)
A[2, 2] <- 1
A[5, 5] <- 1
A
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0 0 0 0 0
# [2,] 0 1 0 0 0
# [3,] 0 0 0 0 0
# [4,] 0 0 0 0 0
# [5,] 0 0 0 0 1
spread <- function(x) {
idx <- do.call(rbind, apply(which(x == 1, arr.ind = TRUE), 1,
function(y) expand.grid(y[1] + 1:-1, y[2] + 1:-1)))
idx <- idx[!(idx[, 1] %in% c(0, nrow(x) + 1) | idx[, 2] %in% c(0, ncol(x) + 1)), ]
x[as.matrix(idx)] <- 1
x
}
spread(A)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 0 0
# [2,] 1 1 1 0 0
# [3,] 1 1 1 0 0
# [4,] 0 0 0 1 1
# [5,] 0 0 0 1 1
spread(spread(A))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 0
# [2,] 1 1 1 1 0
# [3,] 1 1 1 1 1
# [4,] 1 1 1 1 1
# [5,] 0 0 1 1 1
Edit:
Here is a function with a parameter k (taking values 1, 2, ...) that denotes the step of spreading 1's:
spread <- function(x, k) {
idx <- do.call(rbind, apply(which(x == 1, arr.ind = TRUE), 1,
function(y) expand.grid(y[1] + k:-k, y[2] + k:-k)))
idx <- idx[idx[, 1] %in% 1:nrow(x) & idx[, 2] %in% 1:ncol(x), ]
x[as.matrix(idx)] <- 1
x
}
spread(A, 2)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 0
# [2,] 1 1 1 1 0
# [3,] 1 1 1 1 1
# [4,] 1 1 1 1 1
# [5,] 0 0 1 1 1
This works but might need some retooling for more general cases, i.e. your going to run into problems with multiple 1 in the initial matrix. If such a generalization is required please let me know and I'll gladly attempt to produce one. Or just use either josilber's or Julius's answer.
M <- as.matrix(read.table(textConnection("0 0 0 0 0
0 1 0 0 0
0 0 0 0 0
0 0 0 0 0
0 0 0 0 0")))
my_spread <- function(m){
e <- which(m == 1, arr.ind = TRUE)
r <- c(e[, 1] - 1, e[, 1], e[, 1] + 1)
l <- c(e[, 2] - 1, e[, 2], e[, 2] + 1)
#dealing with border cases
r <- r[nrow(m) >= r]
l <- l[ncol(m) >= l]
m[as.matrix(expand.grid(r,l))] <- 1
m
}
my_spread(M)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 0 0
[2,] 1 1 1 0 0
[3,] 1 1 1 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
my_spread(my_spread(M))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 0
[2,] 1 1 1 1 0
[3,] 1 1 1 1 0
[4,] 1 1 1 1 0
[5,] 0 0 0 0 0
my_spread(my_spread(my_spread(M)))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 1 1 1 1
[3,] 1 1 1 1 1
[4,] 1 1 1 1 1
[5,] 1 1 1 1 1
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