I am trying to add two matrices with different dimension in R. Ideally, the system should equate two matrices adding missing rows/columns, filled with zeros. For instance, if we have one matrix with 1:4 rows and another with 1:5 rows and their number of columns is identical. So to add the two matrices we need to add to the first matrix the fifth row full of zeros.
Could you please help.
#Matrix1
a11<-matrix(c(419371623, 10990236, 29346292, 0, 0, 39386246.52, 0, 0,0 ,0,0, 0, 0, 0, 30174248.77,0, 27839925.91, 0 ,0 ,112921829.5),4,5,dimnames = list(c(1,2,3,5),c(1,2,3,4,5)),byrow=TRUE)
#Matrix 2
a22<-matrix(c(853624485, 0, 766111,0, 0, 20240075.89 ,0, 4839059.2,0, 2062687.122 ,0, 0,0 ,0 ,0 ,7282484.458,0, 18738621.67 ,0 ,0),5,4,byrow=TRUE, list(c(1:5),c(1:4)))
#Expected Result:
res<- matrix(c(1272996108, 10990236, 30112402.72, 0, 0,
39386247, 20240075.89, 0, 48390599.21, 0,
0, 2062687.122 ,0, 0, 30174249,
0, 27839926, 0, 7282484.458, 112921830,
0, 18738622, 0, 0, 0), 5, 5, byrow=TRUE, dimnames = list(1:5,1:5)
You could write your own function to perform this:
`%+%` <- function(a, b){
i <- dim(a)
j <- dim(b)
out <- pmax(i,j)
valid <- pmin(i,j)
result <- matrix(0, out[1], out[2])
v_row <- seq(valid[1])
v_col <- seq(valid[2])
result[v_row, v_col] <- a[v_row, v_col] + b[v_row, v_col]
ind1 <- which(result[seq(i[1]), seq(i[2])] == 0 & a!=0, TRUE)
result[ind1] <- a[ind1]
ind2 <- which(result[seq(j[1]), seq(j[2])] == 0 & b!=0, TRUE)
result[ind2] <- b[ind2]
result
}
a11%+%a22
[,1] [,2] [,3] [,4] [,5]
[1,] 1272996108 10990236 30112403 0 0
[2,] 39386247 20240076 0 4839059 0
[3,] 0 2062687 0 0 30174249
[4,] 0 27839926 0 7282484 112921830
[5,] 0 18738622 0 0 0
s1 <- matrix(1,3,5)
s2 <- matrix(2, 5,2)
s1
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 1 1 1 1 1
[3,] 1 1 1 1 1
s2
[,1] [,2]
[1,] 2 2
[2,] 2 2
[3,] 2 2
[4,] 2 2
[5,] 2 2
s1 %+% s2
[,1] [,2] [,3] [,4] [,5]
[1,] 3 3 1 1 1
[2,] 3 3 1 1 1
[3,] 3 3 1 1 1
[4,] 2 2 0 0 0
[5,] 2 2 0 0 0
Maybe there is a shorter/better way to make the dimension of both the matrix equal but here is one way.
n <- max(ncol(a11), ncol(a22))
m <- max(nrow(a11), nrow(a22))
if(m > ncol(a11)) a11 <- cbind(a11, matrix(0, ncol = m - ncol(a11), nrow = nrow(a11)))
if(m > ncol(a22)) a22 <- cbind(a22, matrix(0, ncol = m - ncol(a22), nrow = nrow(a22)))
if(n > nrow(a11)) a11 <- rbind(a11, matrix(0, ncol = ncol(a11), nrow = n - nrow(a11)))
if(n > nrow(a22)) a11 <- rbind(a11, matrix(0, ncol = ncol(a12), nrow = n - nrow(a22)))
Now a11 and a22 are of same dimension so you can add them :
a11 + a22
# 1 2 3 4 5
#1 1272996108 10990236 30112403 0 0
#2 39386247 20240076 0 4839059 0
#3 0 2062687 0 0 30174249
#5 0 27839926 0 7282484 112921830
# 0 18738622 0 0 0
After initializing res to zero, I am adding the matrices by indices.
Easily extendable to add more matrices.
# initilize res
res <- matrix(0, nrow = max(nrow(a11), nrow(a22)),
ncol = max(ncol(a11), ncol(a22)))
# index of a11
inds <- which(!is.na(a11), arr.ind = T)
res[inds] <- res[inds] + a11[inds]
# index of a22
inds <- which(!is.na(a22), arr.ind = T)
res[inds] <- res[inds] + a22[inds]
# repeat for a33 etc if there's more.
Results with a11 and a22
> res
[,1] [,2] [,3] [,4] [,5]
[1,] 1272996108 10990236 30112403 0 0
[2,] 39386247 20240076 0 4839059 0
[3,] 0 2062687 0 0 30174249
[4,] 0 27839926 0 7282484 112921830
[5,] 0 18738622 0 0 0
Related
I am trying to create the following matrix A for n rows and n+1 columns. n will likely be around 20 or 30, but for the purpose of the question I put it at 4 and 5.
Here is what I have so far:
N <- 5 # n+1
n <- 4 # n
columns <- list()
# first column:
columns[1] <- c(-1, 1, rep(0, N-2))
# all other columns:
for(i in N:2) {
columns[i] <- c((rep(0, N-i), 1, -2, 1, rep(0, i-3)))
}
# combine into matrix:
A <- cbind(columns)
I keep getting the following error msg:
In columns[1] <- c(-1, 1, rep(0, N - 2)) :
number of items to replace is not a multiple of replacement length
And later
"for(i in N:2) {
columns[i] <- c((rep(0, N-i),"
}
Error: unexpected '}' in "}"
I guess you can try the for loop below to create your matrix A:
N <- 5
n <- 4
A <- matrix(0,n,N)
for (i in 1:nrow(A)) {
if (i == 1) {
A[i,1:2] <- c(-1,1)
} else {
A[i,i+(-1:1)] <- c(1,-2,1)
}
}
such that
> A
[,1] [,2] [,3] [,4] [,5]
[1,] -1 1 0 0 0
[2,] 1 -2 1 0 0
[3,] 0 1 -2 1 0
[4,] 0 0 1 -2 1
Another solution is to use outer, and this method would be faster and looks more compact than the for loop approach, i.e.,
A <- `diag<-`(replace(z<-abs(outer(1:n,1:N,"-")),!z %in% c(0,1),0),
c(-1,rep(-2,length(diag(z))-1)))
I thought this would be fast compared to the loop, but when I tested on a 5000x5001 example, the loop in ThomasIsCoding's answer was about 5x faster. Go with that one!
N = 5
n = N - 1
A = matrix(0, nrow = n, ncol = N)
delta = row(A) - col(A)
diag(A) = -2
A[delta %in% c(1, -1)] = 1
A[1, 1] = -1
A
# [,1] [,2] [,3] [,4] [,5]
# [1,] -1 1 0 0 0
# [2,] 1 -2 1 0 0
# [3,] 0 1 -2 1 0
# [4,] 0 0 1 -2 1
You could use data.table::shift to shift the vector c(1, -2, 1, 0) by all increments from -1 (backwards shift / lead by 1) to n - 1 (forward shift / lagged by n - 1) and then cbind all the shifted outputs together. The first-row first-column element doesn't follow this pattern so that's fixed at the end.
library(data.table)
out <- do.call(cbind, shift(c(1, -2, 1, 0), seq(-1, n - 1), fill = 0))
out[1, 1] <- -1
out
# [,1] [,2] [,3] [,4] [,5]
# [1,] -1 1 0 0 0
# [2,] 1 -2 1 0 0
# [3,] 0 1 -2 1 0
# [4,] 0 0 1 -2 1
How can I create all binary combinations of matrices with the condition that there can only be a single 1 per column and row. The example will clarify. This particular example must have 6 matrices of combinations, I am showing only the first 2.
c1 <- matrix(c(1, 0, 0, 0, 1, 0, 0, 0, 1), nrow = 3) #First combination
c2 <- matrix(c(0, 1, 0, 1, 0, 0, 0, 0, 1), nrow = 3) #Second combination
What you are asking for is equivalent to finding all permutations of length = n where n = nrow(c1) (or c2 above). Using the FUN argument of permuteGeneral from RcppAlgos (I am the author), we can easily generate the desired outcome:
n <- 3L
myIdentity <- diag(nrow = n)
library(RcppAlgos)
permuteGeneral(n, n, FUN = function(x) myIdentity[x, ])
[[1]]
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1
[[2]]
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 1
[3,] 0 1 0
[[3]]
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 1 0 0
[3,] 0 0 1
[[4]]
[,1] [,2] [,3]
[1,] 0 1 0
[2,] 0 0 1
[3,] 1 0 0
[[5]]
[,1] [,2] [,3]
[1,] 0 0 1
[2,] 1 0 0
[3,] 0 1 0
[[6]]
[,1] [,2] [,3]
[1,] 0 0 1
[2,] 0 1 0
[3,] 1 0 0
There are many other ways of generating the requested output. Most notably, utilizing the tried and true combinat package, we can get a similar result (the output will be in a different order):
combinat::permn(3, fun = function(x) myIdentity[x, ])
Now that we have reduced the problem to simply generating permutations, we can use any of the great packages (arrangements, gtools, multicool, partitions, etc.) for generating permutations to obtain our desired result with the help of lapply:
library(arrangements)
myPerms <- permutations(n)
lapply(1:nrow(myPerms), function(x) myIdentity[myPerms[x,], ])
I've got the question:
Generate the following matrix using a for‐loop over the entries.
structure(c(3, 2, 2, 2, 2, 1, 3, 0, 0, 0, 1, 0, 3, 0, 0, 1, 0,
0, 3, 0, 1, 0, 0, 0, 3), .Dim = c(5L, 5L))
# [,1] [,2] [,3] [,4] [,5]
# [1,] 3 1 1 1 1
# [2,] 2 3 0 0 0
# [3,] 2 0 3 0 0
# [4,] 2 0 0 3 0
# [5,] 2 0 0 0 3
So far my code is:
z<-matrix(NA,ncol=5,nrow=5)
q<-1:5
for(n in 1:nrow(z)){
z[n,] = q
}
print(z)
I'm having trouble forming the matrix. Any suggestions?
This solution uses nested for-loop and if-else statement.
z <- matrix(NA, ncol = 5, nrow = 5)
for (i in 1:nrow(z)){
for (j in 1:nrow(z)){
if (i == j){
z[i, j ] <- 3
} else if (i == 1){
z[i, j ] <- 1
} else if (j == 1){
z[i, j ] <- 2
} else {
z[i, j ] <- 0
}
}
}
print(z)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 3 1 1 1 1
# [2,] 2 3 0 0 0
# [3,] 2 0 3 0 0
# [4,] 2 0 0 3 0
# [5,] 2 0 0 0 3
I have a set of vectors, and would like to stack them on top of each other to create diagonal entries to a matrix.
What would be an easy way to create the example_out matrix from c1 and c2?
c1 <- seq(1, 4)
c2 <- seq(5, 8)
example_out <- matrix(c(1,0,0,0,5,2,0,0,0,6,3,0,0,0,7,4,0,0,0,8), nrow=5, byrow=T)
example_out
Create a matrix out of 0s, then fill main diagonal with c1 and sub diagonal with c2.
example_out <- matrix(rep(0, 20), 5, 4)
diag(example_out) <- c1
diag(example_out[-1, ]) <- c2
Yielding
> example_out
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 5 2 0 0
[3,] 0 6 3 0
[4,] 0 0 7 4
[5,] 0 0 0 8
Data
c1 <- seq(1, 4)
c2 <- seq(5, 8)
Another simple approach, augmenting two diagonal matrices with 0 rows and adding them:
rbind(diag(c1), 0) + rbind(0, diag(c2))
# [,1] [,2] [,3] [,4]
# [1,] 1 0 0 0
# [2,] 5 2 0 0
# [3,] 0 6 3 0
# [4,] 0 0 7 4
# [5,] 0 0 0 8
Here is an alternative approach replaceing entries in a numeric vector before casting as matrix
matrix(unlist(sapply(seq_along(c1), function(i)
replace(rep(0, length(c1) + 1), i:(i+1), c(c1[i], c2[i])))),
ncol = length(c1))
# [,1] [,2] [,3] [,4]
#[1,] 1 0 0 0
#[2,] 5 2 0 0
#[3,] 0 6 3 0
#[4,] 0 0 7 4
#[5,] 0 0 0 8
Update
I was curious to see how the different methods compared in terms of performance/runtime. Here is a short microbenchmark analysis using two larger vectors c1 and c2.
set.seed(2017)
c1 <- sample(1000)
c2 <- sample(1000)
library(microbenchmark)
library(Matrix)
res <- microbenchmark(
method_jaySF = {
example_out <- matrix(0, length(c1) + 1, length(c2))
diag(example_out) <- c1
diag(example_out[-1, ]) <- c2
},
method_Roland = {
bandSparse(length(c1) + 1, length(c2), 0:-1, list(c1, c2))
},
method_Onyambu = {
a = matrix(0,length(c1)+1,length(c2))
a[row(a)==col(a)]=c1
a[row(a)==col(a)+1]=c2
},
method_Gregor = {
rbind(diag(c1), 0) + rbind(0, diag(c2))
},
method_Maurits = {
matrix(unlist(sapply(seq_along(c1), function(i)
replace(rep(0, length(c1) + 1), i:(i+1), c(c1[i], c2[i])))),
ncol = length(c1))
}
)
res;
#Unit: microseconds
# expr min lq mean median uq max
# method_jaySF 31894.439 37850.81 58452.41 40560.992 46224.579 208862.631
# method_Roland 940.535 1342.32 1675.29 1457.928 1869.621 8228.287
# method_Onyambu 55033.797 66083.67 124364.44 73143.798 195886.534 274383.132
# method_Gregor 37784.977 44049.87 69918.85 47539.793 53122.162 243774.715
# method_Maurits 14961.924 21378.77 42834.89 23536.966 27270.953 186088.146
autoplot(res)
You should create a sparse matrix. Use the Matrix package:
c1 <- seq(1, 4)
c2 <- seq(5, 8)
library(Matrix)
bandSparse(5, 4, 0:-1, list(c1, c2))
#5 x 4 sparse Matrix of class "dgCMatrix"
#
#[1,] 1 . . .
#[2,] 5 2 . .
#[3,] . 6 3 .
#[4,] . . 7 4
#[5,] . . . 8
a = matrix(0,length(c1)+1,length(c2))
a[row(a)==col(a)]=c1
a[row(a)==col(a)+1]=c2
a
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 5 2 0 0
[3,] 0 6 3 0
[4,] 0 0 7 4
[5,] 0 0 0 8
I have solution matrix(say A) to the indefinite equation x1+x2+x3+x4 = 6. Also, I have another matrix(say B) with columns are
0 1 0 1
0 0 1 1
I want to generate matrices using rows of A and the columns of B.
For an example, let (2,0,1,3) is the one solution(one row) of the matrix A. Then, the columns of my new matrix are
0 0 0 1 1 1
0 0 1 1 1 1
Columns of this new matrix are the multiples of columns of B. i.e., first column 2-times, third column 1-time and fourth column 3-times. I want to use this procedure all the rows of matrix A.
use rep:
b <- matrix(c(0, 0, 1, 0, 0, 1, 1, 1), nrow = 2)
a <- c(2, 0, 1, 3)
b[, rep(1:ncol(b), a)]
if a has many rows:
lapply(1:nrow(a), function(i) b[, rep(1:ncol(b), a[i, ])])
> B <- rbind(c(0, 1, 0, 1), c( 0, 0, 1, 1))
> A <- rbind(c(2,0,1,3), c(2,0,1,3))
> do.call(rbind, lapply(1:nrow(A), function(jj) t(sapply(1:nrow(B), function(j) do.call(c, lapply(1:4, function(i) rep(B[j,i], A[jj,i]))) ))))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 1 1 1
[2,] 0 0 1 1 1 1
[3,] 0 0 0 1 1 1
[4,] 0 0 1 1 1 1