Supppose I have the following block diagonal matrix:
a <- matrix(1:6, 2, 3)
b <- matrix(7:10, 2, 2)
library(magic)
Block <- adiag(a,b)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 3 5 0 0
#[2,] 2 4 6 0 0
#[3,] 0 0 0 7 9
#[4,] 0 0 0 8 10
And I need to multiply each block by one part of the following vector. This means the first block "a" times 2 and the block "b" times 1.
v1=c(2,1)
So that at the end I have:
# [,1] [,2] [,3] [,4] [,5]
#[1,] 2 6 10 0 0
#[2,] 4 8 12 0 0
#[3,] 0 0 0 7 9
#[4,] 0 0 0 8 10
How could I do that in the most efficient way?
Until there is a better solution or an improvement of this one.
a <- matrix(1:9, 3, 3)
b <- matrix(7:10, 2, 2)
c <- matrix(9:24, 4, 4)
library(magic)
Block <- adiag(a,b,c)
Block
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 1 4 7 0 0 0 0 0 0
# [2,] 2 5 8 0 0 0 0 0 0
# [3,] 3 6 9 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 9 13 17 21
# [7,] 0 0 0 0 0 10 14 18 22
# [8,] 0 0 0 0 0 11 15 19 23
# [9,] 0 0 0 0 0 12 16 20 24
v1 <- c(2,1,4)
apply(Block, 2, "*", rep(v1, c(NROW(a),NROW(b),NROW(c))))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 2 8 14 0 0 0 0 0 0
# [2,] 4 10 16 0 0 0 0 0 0
# [3,] 6 12 18 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 36 52 68 84
# [7,] 0 0 0 0 0 40 56 72 88
# [8,] 0 0 0 0 0 44 60 76 92
# [9,] 0 0 0 0 0 48 64 80 96
Or as suggested by Ven Yao in the comments:
adiag(a*v1[1], b*v1[2], c*v1[3])
Another option is bdiag from library(Matrix) (using #Pascal's example). We place the individual vectors i.e. 'a', 'b', 'c' in a list (using mget), multiply with corresponding elements of 'v1' using Map and wrap with bdiag.
library(Matrix)
as.matrix(bdiag(Map(`*`,mget(letters[1:3]), v1)))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 2 8 14 0 0 0 0 0 0
# [2,] 4 10 16 0 0 0 0 0 0
# [3,] 6 12 18 0 0 0 0 0 0
# [4,] 0 0 0 7 9 0 0 0 0
# [5,] 0 0 0 8 10 0 0 0 0
# [6,] 0 0 0 0 0 36 52 68 84
# [7,] 0 0 0 0 0 40 56 72 88
# [8,] 0 0 0 0 0 44 60 76 92
# [9,] 0 0 0 0 0 48 64 80 96
Related
My matrice is like this:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 0 0 0 0 0 0 0 0 0
[2,] 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 1 1
[5,] 0 0 0 0 0 0 1 1 0
[6,] 0 0 0 0 0 1 0 0 0
[7,] 0 0 0 0 1 1 0 0 0
[8,] 0 0 0 0 1 0 0 0 0
[9,] 0 0 0 0 1 0 0 0 0
[10,] 0 0 0 0 1 1 0 0 0
[11,] 0 0 0 0 0 1 0 0 0
[12,] 0 0 0 0 0 1 1 1 1
[13,] 0 0 0 0 0 0 0 0 0
[14,] 0 0 0 0 0 0 0 0 0
[15,] 0 0 0 0 0 0 0 0 0
[16,] 0 0 0 0 0 0 0 0 0
[17,] 0 0 0 0 0 0 0 0 0
[,10] [,11] [,12] [,13] [,14] [,15] [,16] [,17]
[1,] 0 0 0 0 0 0 0 0
[2,] 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0
[4,] 1 1 0 0 0 0 0 0
[5,] 0 1 0 0 0 0 0 0
[6,] 0 1 0 0 0 0 0 0
[7,] 0 1 0 0 0 0 0 0
[8,] 0 1 0 0 0 1 0 0
[9,] 0 1 0 0 0 1 0 0
[10,] 1 1 0 0 0 1 0 0
[11,] 1 1 0 1 1 0 0 0
[12,] 1 1 1 1 0 0 0 0
[13,] 0 0 0 0 0 0 0 0
[14,] 0 0 0 0 0 0 0 0
[15,] 0 0 0 0 0 0 0 0
[16,] 0 0 0 0 0 0 0 0
[17,] 0 0 0 0 0 0 0 0
[,18]
[1,] 0
[2,] 0
[3,] 0
[4,] 0
[5,] 0
[6,] 0
[7,] 0
[8,] 0
[9,] 0
[10,] 0
[11,] 0
[12,] 0
[13,] 0
[14,] 0
[15,] 0
[16,] 0
[17,] 0
How can I find the number of values which has 1 in neighbour? (neighbour of a pixel is the value above the value, below the value, to the right, to the left, top right, top left, below left, below right).
I just need to get a way of devising how I can even find the number of values which has 1 above/below it. If I get that, I'll be able to solve the other variables of the problem (top right and such).
I've been experimenting around with which such as which(imageMatrix == 1, arr.ind = TRUE)[1,1]. But I cannot figure it out. (ImageMatrix is the name of the matrix)
Can anyone lend me a hand on how I can begin with the problem so I get a jump?
In the following we use the example matrix m generated reproducibly in the Note at the end.
1) Append a row and column of zeros on each end and then apply rollsum , transpose, apply it again and transpose again. Finally subtract the original matrix so that only neighbors are counted. This solution is the most compact of those here.
library(zoo)
m2 <- rbind(0, cbind(0, m, 0), 0)
t(rollsum(t(rollsum(m2, 3)), 3)) - m
## [,1] [,2] [,3] [,4] [,5]
## [1,] 2 3 5 3 2
## [2,] 3 5 6 4 2
## [3,] 2 6 5 5 2
## [4,] 2 5 2 2 1
## [5,] 1 3 2 2 1
2) A second approach is the following. It would be much faster than the others here.
nr <- nrow(m)
nc <- ncol(m)
mm <- cbind(m[, -1], 0) + m + cbind(0, m[, -nc])
rbind(mm[-1, ], 0) + mm + rbind(0, mm[-nr, ]) - m
## [,1] [,2] [,3] [,4] [,5]
## [1,] 2 3 5 3 2
## [2,] 3 5 6 4 2
## [3,] 2 6 5 5 2
## [4,] 2 5 2 2 1
## [5,] 1 3 2 2 1
3) Using loops we can write the following. It is probably the most straight forward. Note that subscripting by 0 omits that element and i %% 6 equals i if i is in 1, 2, 3, 4, 5 and equals 0 if i equals 0 or 6.
nr <- nrow(m); nr1 <- nr + 1
nc <- ncol(m); nc1 <- nc + 1
mm <- 0 * m # initialize result
for(i in seq_len(nr))
for(j in seq_len(nc))
mm[i, j] <- sum(m[seq(i-1, i+1) %% nr1, seq(j-1, j+1) %% nc1]) - m[i,j]
mm
## [,1] [,2] [,3] [,4] [,5]
## [1,] 2 3 5 3 2
## [2,] 3 5 6 4 2
## [3,] 2 6 5 5 2
## [4,] 2 5 2 2 1
## [5,] 1 3 2 2 1
Note
set.seed(123)
m <- +matrix(rnorm(25) > 0, 5)
m
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 1 1 1 0
## [2,] 0 1 1 1 0
## [3,] 1 0 1 0 0
## [4,] 1 0 1 1 0
## [5,] 1 0 0 0 0
Given a matrix
a <- matrix(c(15,2,11,16,7,12,1,8,3), nrow=3, ncol=3, byrow=T)
I'd like to row bind three copies of the matrix, but in each copy all rows but one should have zero values. The desired result:
15 2 11
0 0 0
0 0 0
0 0 0
16 7 12
0 0 0
0 0 0
0 0 0
1 8 3
I can do this by rbind(a[1,],0,0,0,a[2,],0,0,0,a[3,]), but is there a better way when dealing with a large matrix?
matrix(t(cbind(a,matrix(0,3,9))),ncol=3,byrow=T)[1:9,]
[,1] [,2] [,3]
[1,] 15 2 11
[2,] 0 0 0
[3,] 0 0 0
[4,] 0 0 0
[5,] 16 7 12
[6,] 0 0 0
[7,] 0 0 0
[8,] 0 0 0
[9,] 1 8 3
How about this:
apply(a, 2, function(r) rbind(r, matrix(rep(0,9), nrow=3)))[1:9, ]
[,1] [,2] [,3]
[1,] 15 2 11
[2,] 0 0 0
[3,] 0 0 0
[4,] 0 0 0
[5,] 16 7 12
[6,] 0 0 0
[7,] 0 0 0
[8,] 0 0 0
[9,] 1 8 3
I have a vector given and want to transform it into a certain block matrix. Consider this simple example:
k <- c(1,2,3)
a <- rep(apply(expand.grid(k, k), 1, prod), each=3)
a
[1] 1 1 1 2 2 2 3 3 3 2 2 2 4 4 4 6 6 6 3 3 3 6 6 6 9 9 9
This vector should be aligned in a block matrix of the form:
rbind(
cbind(diag(a[1:3]), diag(a[4:6]), diag(a[7:9])),
cbind(diag(a[10:12]), diag(a[13:15]), diag(a[16:18]) ),
cbind(diag(a[19:21]), diag(a[22:24]), diag(a[25:27]) )
)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 0 0 2 0 0 3 0 0
[2,] 0 1 0 0 2 0 0 3 0
[3,] 0 0 1 0 0 2 0 0 3
[4,] 2 0 0 4 0 0 6 0 0
[5,] 0 2 0 0 4 0 0 6 0
[6,] 0 0 2 0 0 4 0 0 6
[7,] 3 0 0 6 0 0 9 0 0
[8,] 0 3 0 0 6 0 0 9 0
[9,] 0 0 3 0 0 6 0 0 9
Now this is of course a small and simple example and I would like to do this for much larger vectors/matrices. Thus my question: Is there a general way to align a vector in a block matrix of certain form (without looping)?
Instead of manually doing the split, we can use %/%
k <- 3
lst <- split(a, (seq_along(a)-1)%/%k + 1)
do.call(rbind, lapply(split(lst, (seq_along(lst)-1) %/% k + 1),
function(x) do.call(cbind, lapply(x, function(y) diag(y)))))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
# [1,] 1 0 0 2 0 0 3 0 0
# [2,] 0 1 0 0 2 0 0 3 0
# [3,] 0 0 1 0 0 2 0 0 3
# [4,] 2 0 0 4 0 0 6 0 0
# [5,] 0 2 0 0 4 0 0 6 0
# [6,] 0 0 2 0 0 4 0 0 6
# [7,] 3 0 0 6 0 0 9 0 0
# [8,] 0 3 0 0 6 0 0 9 0
# [9,] 0 0 3 0 0 6 0 0 9
An alternative using the Kronecker product on a slightly different vector is as follows.
# create initial vector
aNew <- rep(1:3, 3) * rep(1:3, each=3)
aNew
[1] 1 2 3 2 4 6 3 6 9
Note that aNew is the unique values of the vector a in the same order, that is, it is equivalent to unique(a). Convert aNew into a 3X3 matrix and then perform the Kronecker product against it and the 3X3 identity matrix.
matrix(aNew, 3, 3) %x% diag(3)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
[1,] 1 0 0 2 0 0 3 0 0
[2,] 0 1 0 0 2 0 0 3 0
[3,] 0 0 1 0 0 2 0 0 3
[4,] 2 0 0 4 0 0 6 0 0
[5,] 0 2 0 0 4 0 0 6 0
[6,] 0 0 2 0 0 4 0 0 6
[7,] 3 0 0 6 0 0 9 0 0
[8,] 0 3 0 0 6 0 0 9 0
[9,] 0 0 3 0 0 6 0 0 9
When fitting a unbalanced longitudinal data with mixed model: y = X α + Z a + ξ, we usually organize the design matrix Z like ablock matrix. Take n = 3, q = 2 for example,
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 10 0 0 0 0
[2,] 2 11 0 0 0 0
[3,] 0 0 3 12 0 0
[4,] 0 0 4 13 0 0
[5,] 0 0 5 14 0 0
[6,] 0 0 0 0 6 15
[7,] 0 0 0 0 7 16
[8,] 0 0 0 0 8 17
[9,] 0 0 0 0 9 18
However, if have
[,1] [,2]
[1,] 1 10
[2,] 2 11
[3,] 3 12
[4,] 4 13
[5,] 5 14
[6,] 6 15
[7,] 7 16
[8,] 8 17
[9,] 9 18
at hand, how could we transfer a long format matrix to block matrix efficiently in r besides for loops? I recently tried this way,
> library("magic")
> (Zmat <- matrix(1:18, nrow=9))
[,1] [,2]
[1,] 1 10
[2,] 2 11
[3,] 3 12
[4,] 4 13
[5,] 5 14
[6,] 6 15
[7,] 7 16
[8,] 8 17
[9,] 9 18
> row_cuts <- c(2,3,4)
> cut_num <- length(row_cuts)
> cut_up <- cumsum(row_cuts)
> cut_lo <- cut_up - row_cuts +1
> (Reduce("adiag", mapply(function(i) Zmat[(cut_lo[i]):(cut_up[i]), ], 1:cut_num, SIMPLIFY=FALSE)))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 10 0 0 0 0
[2,] 2 11 0 0 0 0
[3,] 0 0 3 12 0 0
[4,] 0 0 4 13 0 0
[5,] 0 0 5 14 0 0
[6,] 0 0 0 0 6 15
[7,] 0 0 0 0 7 16
[8,] 0 0 0 0 8 17
[9,] 0 0 0 0 9 18
I am trying to cut a number in layers by mean the next code:
X <- matrix(c(6,7,9,9,9,17,19,4,12,2,3,6,7,7),ncol=2)
layers <- c(5,10,15,20,25,30,35,40)
partitions <- function(u) {cbind(pmin(layers[1],u),t(diff(pmin(layers,u))))}
X <- cbind(X,lapply(X[,2], partitions))
The function returns an integer partitioned in the layers.
A = a1 + a2 + .... + a8
Example
A <- 19
partitions(A)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 5 5 5 4 0 0 0 0
But the results does not have the matrix I need. The final matrix would be of 7 x (2 (cols from X) + 8 (num of layers in points))
[,1] [,2] [,3]
[1,] 6 Numeric,8 NULL
[2,] 7 Numeric,8 NULL
[3,] 9 Numeric,8 NULL
[4,] 9 Numeric,8 NULL
[5,] 9 Numeric,8 NULL
[6,] 17 Numeric,8 NULL
[7,] 19 Numeric,8 NULL
> dim(X)
[1] 7 3
I tried different forms and ever had errors of dimensions.
Regards
One of these two should be what you want
> rbind(t(X),sapply(X[,2], partitions))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 6 7 9 9 9 17 19
[2,] 4 12 2 3 6 7 7
[3,] 4 5 2 3 5 5 5
[4,] 0 5 0 0 1 2 2
[5,] 0 2 0 0 0 0 0
[6,] 0 0 0 0 0 0 0
[7,] 0 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0
> cbind(X,t(sapply(X[,2], partitions)))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 6 4 4 0 0 0 0 0 0 0
[2,] 7 12 5 5 2 0 0 0 0 0
[3,] 9 2 2 0 0 0 0 0 0 0
[4,] 9 3 3 0 0 0 0 0 0 0
[5,] 9 6 5 1 0 0 0 0 0 0
[6,] 17 7 5 2 0 0 0 0 0 0
[7,] 19 7 5 2 0 0 0 0 0 0