I have identity matrix which can be generated via diag(5)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 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
I want to convert it to the matrix wherein series starts after 1. For example 1st column, values 1 through 5. Second column - values 1 through 4.
Desired Output
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
Try the code below (given m <- diag(5))
> (row(m) - col(m) + 1)*lower.tri(m,diag = TRUE)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
Another option is using apply + cumsum
> apply(lower.tri(m, diag = TRUE), 2, cumsum)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
1) If d <- diag(5) is the identity matrix then:
pmax(row(d) - col(d) + 1, 0)
giving:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
2) This alternative is slightly longer (though still a one-liner) but also works if the columns of d are rearranged and/or some columns are missing. For example,
dd <- d[, 4:1] # test data
pmax(outer(1:nrow(dd) + 1, max.col(t(dd)), `-`), 0)
giving the same result for d and this for dd:
[,1] [,2] [,3] [,4]
[1,] 0 0 0 1
[2,] 0 0 1 2
[3,] 0 1 2 3
[4,] 1 2 3 4
[5,] 2 3 4 5
A solution based on nested cumsum:
n <- 5
m <- diag(n)
apply(m, 2, function(x) cumsum(cumsum(x)))
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1 0 0 0 0
#> [2,] 2 1 0 0 0
#> [3,] 3 2 1 0 0
#> [4,] 4 3 2 1 0
#> [5,] 5 4 3 2 1
One option could be:
x <- 1:5
embed(c(rep(0, length(x) - 1), x), length(x))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
Related
Suppose I have a matrix, mat. Suppose further that the sum of one row of this matrix is equal to zero. Then, I need to set all the coming rows (the rows after the zero row) to zero. For example,
mat <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,1,0,
1,2,0,0,0,
0,1,0,1,0)
mat <- matrix(mat,5,5)
mat
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 2 1 0 1
[5,] 0 1 0 0 0
All the entries of row 3 are zero. Hence, I want rows 4, and 5 to become zeros as well. I have a list of matrices and would like to apply the same to all the matrices using the lapply function. For simplicity, I make a list of 3 matrices similar to the mat.
mat <- c(1,2,0,0,0,
3,3,0,2,1,
0,0,0,4,0,
1,3,0,0,0,
0,1,0,1,0)
mat <- matrix(mat,5,5)
mat1 <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,1,0,
1,2,0,0,0,
0,1,0,1,0)
mat1 <- matrix(mat1,5,5)
mat2 <- c(1,2,0,0,0,
3,4,0,2,1,
0,0,0,2,0,
1,2,0,0,0,
0,2,0,3,0)
mat2 <- matrix(mat2,5,5)
Mat <- list(mat1, mat2, mat3)
You did not actually post mat3 in your data so I just used mat3 <- matrix(1, 5, 5), i.e. a 5x5 matrix of ones. This was to ensure it could handle cases where there is no row where all values are zero.
This will return a list of matrices where all rows are zero after the first row of zeroes:
lapply(Mat, \(mat) {
first_zero_row <- which(rowSums(mat)==0)[1]
if(!is.na(first_zero_row)) {
mat[first_zero_row:nrow(mat),] <- 0
}
mat
})
Output:
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 2
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[3]]
[,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
Another option could be:
lapply(Mat, function(x) {x[cumsum(rowSums(x != 0) == 0) != 0, ] <- 0; x})
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 3 0 3 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 1
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 0 1 0
[2,] 2 4 0 2 2
[3,] 0 0 0 1 0
[4,] 0 2 2 0 3
[5,] 0 1 0 0 0
Suppose I have a list of matrices. Suppose further that I would like to find the smallest value across each value of the matrices. For example,
y <- c(3,2,4,5,6, 4,5,5,6,7)
x[lower.tri(x,diag=F)] <- y
> x
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 3 0 0 0 0
[3,] 2 6 0 0 0
[4,] 4 4 5 0 0
[5,] 5 5 6 7 0
k <- c(1,4,5,2,5,-4,4,4,4,5)
z[lower.tri(z,diag=F)] <- k
> z
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 4 5 0 0 0
[4,] 5 -4 4 0 0
[5,] 2 4 4 5 0
d <- list(k, x)
The expected output:
dd <– matrix(0,5,5)
dd
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 2 5 0 0 0
[4,] 4 -4 4 0 0
[5,] 2 4 4 5 0
We could use pmin to get the corresponding min value for each element across the list
do.call(pmin, d)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 0 0
#[2,] 1 0 0 0 0
#[3,] 2 5 0 0 0
#[4,] 4 -4 4 0 0
#[5,] 2 4 4 5 0
data
d <- list(z, x)
Consider the 8 by 6 binary matrix, M:
M <- matrix(c(0,0,1,1,0,0,1,1,
0,1,1,0,0,1,1,0,
0,0,0,0,1,1,1,1,
0,1,0,1,1,0,1,0,
0,0,1,1,1,1,0,0,
0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is the M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 1 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 0 1 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
The following matrix contains the column index of the 1's in matrix M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 2 5 2 3 2
[2,] 4 3 6 4 4 3
[3,] 7 6 7 5 5 5
[4,] 8 7 8 7 6 8
Let's denote that
ind <- matrix(c(3,4,7,8,
2,3,6,7,
5,6,7,8,
2,4,5,7,
3,4,5,6,
2,3,5,8),nrow = 4, ncol=6)
I'm trying to change a single position of 1 into 0only in SOME columns of M.
For an example, consider the case for changing two ones in every two columns. One possibility is given changing two positions in first two columns. Let N be the resulting matrices. This will produce the following matrix N
N <- matrix(c(0,0,0,1,0,0,1,1,
0,1,1,0,0,0,1,0,
0,0,0,0,1,1,1,1,
0,1,0,1,1,0,1,0,
0,0,1,1,1,1,0,0,
0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is that N
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 0 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 0 0 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
For EACH of the resulting matrices of N, I do the following calculations.
X <- cbind(c(rep(1,nrow(N))),N)
ans <- sum(diag(solve(t(X)%*%X)[-1,-1]))
Then, I want to obtain the matrix N, which produce the smallest value of ans. This 8 by 6 matrix is just one example. How do I do this?
I asked a question similar to this one before which changes positions in every column. Here is the link to that.
I want to do a matrix multiplication with a twist.
I have this matrix:
A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1), nrow = 6, ncol = 5)
A
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 0 1
[2,] -1 0 1 -1 -1
[3,] -1 0 -1 1 -1
[4,] 0 1 1 0 1
[5,] -1 0 -1 1 -1
[6,] 0 0 0 0 1
And I want to get two different matrices. The first matrix is this:
C
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 2 0 1
[2,] 0 0 2 1 2 0
[3,] 0 2 0 0 4 0
[4,] 2 1 0 0 0 1
[5,] 0 2 4 0 0 0
[6,] 1 0 0 1 0 0
This "convergence matrix" is something like the multiplication of A for its transpose (in R is something like this A%*%t(A)), but with a little twist, during the sum to obtain each cell I only want de sum of the positives values. For example, for the cell C23 the regular sum would be:
(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0
, but I only want the sum of the positive products, in this example the first [(-1)(-1)] and the last [(-1)(-1)] to obtain 2.
The second matrix is this:
D
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
This "divergence matrix" is similar to the previous one, with the difference that I only want to sum de absolute values of the negative values. For example, for the cell D23 the regular sum would be:
(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0
, but I only want the sum of the absolute values of negative products, in this example the third abs [(1)(-1)] and the fourth abs[(-1)(-1)] to obtain 2.
I've been trying with apply, sweep and loops but I can't get it.
Thanks for your responses.
Another take:
D <- A
D[D<0] = -1i*D[D<0]
D <- Im(tcrossprod(D))
C <- tcrossprod(A) + D
A is defined in the question.
Output:
> D
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
> C
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 0 0 2 0 1
[2,] 0 4 2 1 2 0
[3,] 0 2 4 0 4 0
[4,] 2 1 0 3 0 1
[5,] 0 2 4 0 4 0
[6,] 1 0 0 1 0 1
This is a try in base R. So basically you follow the matrix cross-product approach but you try to manage the sum step manually:
f <- function(A, convergence=TRUE){
sapply(seq_len(nrow(A)), function(i) {
r <- t(matrix(A[i,],ncol(A),nrow(A)))*A
if(convergence)
r[r<0] <- 0
else
r[r>0] <- 0
rowSums(abs(r))
})
}
> f(A, convergence = TRUE)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 0 0 2 0 1
[2,] 0 4 2 1 2 0
[3,] 0 2 4 0 4 0
[4,] 2 1 0 3 0 1
[5,] 0 2 4 0 4 0
[6,] 1 0 0 1 0 1
> f(A, convergence = FALSE)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
It will be significantly less efficient, but you could break the matrix into a list of row vectors, which are easier to calculate with. Using purrr, which is handy for lists,
library(purrr)
A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1),
nrow = 6, ncol = 5)
C <- seq(nrow(A)) %>% # generate a sequence of row indices
map(~A[.x, ]) %>% # subset matrix into a list of rows
cross2(., .) %>% # do a Cartesian join to get pairs of rows
# calculate products, then subset before summing. Simplify to vector
map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(ij[ij >= 0])}) %>%
matrix(nrow(A)) # reassemble to matrix
C
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 3 0 0 2 0 1
#> [2,] 0 4 2 1 2 0
#> [3,] 0 2 4 0 4 0
#> [4,] 2 1 0 3 0 1
#> [5,] 0 2 4 0 4 0
#> [6,] 1 0 0 1 0 1
# same except subsetting and `-` to make negatives positive
D <- seq(nrow(A)) %>%
map(~A[.x, ]) %>%
cross2(., .) %>%
map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(-ij[ij <= 0])}) %>%
matrix(nrow(A))
D
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 2 2 0 2 0
#> [2,] 2 0 2 1 2 1
#> [3,] 2 2 0 2 0 1
#> [4,] 0 1 2 0 2 0
#> [5,] 2 2 0 2 0 1
#> [6,] 0 1 1 0 1 0
I'm looking to generate all possible 4x4 matrices, where each element can either be a 0 or a 1.
Is there a function in R to do this?
Here is a function that would create such matrices for indices from 0 to 2^16-1:
num2mat = function(num){ matrix(as.integer(intToBits(num)),4,4) }
Here is what it produces:
> num2mat(0)
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 0 0 0 0
[3,] 0 0 0 0
[4,] 0 0 0 0
> num2mat(2^15+2^13+2^10+2^8+2^7+2^5+2^2+1)
[,1] [,2] [,3] [,4]
[1,] 1 0 1 0
[2,] 0 1 0 1
[3,] 1 0 1 0
[4,] 0 1 0 1
> num2mat(2^16-1)
[,1] [,2] [,3] [,4]
[1,] 1 1 1 1
[2,] 1 1 1 1
[3,] 1 1 1 1
[4,] 1 1 1 1