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
Related
Say I have the following matrix mat3, where column 1 is a variable defining 2 groups:
mat1 <- diag(1, 5, 5)
mat1[,1] <- 1
mat2 <- diag(3, 5, 5)
mat2[,1] <- 3
mat3 <- rbind(mat1, mat2)
mat3
In mat3, how do I copy the diagonals of mat1 and mat2 in their respective first rows (i.e. rows 1 and 6)? The pseudocode would be: diag(mat3) by mat3[,1]
I tried the following but it did not work:
fnc <- function(x) {
res <- x
res[1,] <- diag(x)
res <<- res
}
by(mat3, as.factor(mat3[,1]), fnc)
res
In practice, I need to apply this operation to a dataframe.
Thanks a lot!
do.call(rbind, lapply(split.data.frame(mat3, mat3[,1]), \(x) {
x[1, ] <- diag(x); x
}))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 1 0 0 0
[3,] 1 0 1 0 0
[4,] 1 0 0 1 0
[5,] 1 0 0 0 1
[6,] 3 3 3 3 3
[7,] 3 3 0 0 0
[8,] 3 0 3 0 0
[9,] 3 0 0 3 0
[10,] 3 0 0 0 3
If mat3 is a data.frame, you can revise the anonymous function as
\(x) {
x[1, ] <- diag(as.matrix(x)); x
}
Here's an approch that just finds the start of each matrix assuming they are square:
idx <- seq(from=1, to=nrow(mat3), by=ncol(mat3))
for(i in idx) mat3[i, ] <- rep(mat3[i, 1], ncol(mat3))
mat3
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 1 0 0 0
# [3,] 1 0 1 0 0
# [4,] 1 0 0 1 0
# [5,] 1 0 0 0 1
# [6,] 3 3 3 3 3
# [7,] 3 3 0 0 0
# [8,] 3 0 3 0 0
# [9,] 3 0 0 3 0
# [10,] 3 0 0 0 3
Here is Matlab code to form the matrix of logical values of '0' and '1'
A=[1 2 3 4 5 6 7 8 9 10 ];
N = numel(A);
step = 2; % Set this to however many zeros you want to add each column
index = N:-step:1;
val = (1:N+step).' <= index;
Which result in
val=
1 1 1 1 1
1 1 1 1 1
1 1 1 1 0
1 1 1 1 0
1 1 1 0 0
1 1 1 0 0
1 1 0 0 0
1 1 0 0 0
1 0 0 0 0
1 0 0 0 0
0 0 0 0 0
0 0 0 0 0
How to do same task in r ,particularly val = (1:N+step).' <= indexthis step?
One option is
i <- seq_len(ncol(m1))
sapply(rev(i), function(.i) {
m1[,.i][sequence(.i *2)] <- 1
m1[,.i]
})
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 1 1 1 1
# [3,] 1 1 1 1 0
# [4,] 1 1 1 1 0
# [5,] 1 1 1 0 0
# [6,] 1 1 1 0 0
# [7,] 1 1 0 0 0
# [8,] 1 1 0 0 0
# [9,] 1 0 0 0 0
#[10,] 1 0 0 0 0
#[11,] 0 0 0 0 0
#[12,] 0 0 0 0 0
Or vectorize it
i1 <- rep(i, rev(2*i))
m1[cbind(ave(i1, i1, FUN = seq_along), i1)] <- 1
m1
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 1 1 1 1
# [3,] 1 1 1 1 0
# [4,] 1 1 1 1 0
# [5,] 1 1 1 0 0
# [6,] 1 1 1 0 0
# [7,] 1 1 0 0 0
# [8,] 1 1 0 0 0
# [9,] 1 0 0 0 0
#[10,] 1 0 0 0 0
#[11,] 0 0 0 0 0
#[12,] 0 0 0 0 0
Or another option without creating a matrix beforehand
n <- 5
i1 <- seq(10, 2, by = -2)
r1 <- c(rbind(i1, rev(i1)))
matrix(rep(rep(c(1, 0), n), r1), ncol = n)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 1 1 1 1 1
# [2,] 1 1 1 1 1
# [3,] 1 1 1 1 0
# [4,] 1 1 1 1 0
# [5,] 1 1 1 0 0
# [6,] 1 1 1 0 0
# [7,] 1 1 0 0 0
# [8,] 1 1 0 0 0
# [9,] 1 0 0 0 0
#[10,] 1 0 0 0 0
#[11,] 0 0 0 0 0
#[12,] 0 0 0 0 0
data
m1 <- matrix(0, 12, 5)
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
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
>
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