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
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
I want to have a triangle matrix by a vector when length of vector is less than replacement length.
for example:
v<- c(1,2,3,4,5,6)
and
mat<- matrix(0,5,5).
If I use
mat[upper.tri(mat, diag=FALSE)]<- v
,the result is:
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 4 1
[2,] 0 0 3 5 2
[3,] 0 0 0 6 3
[4,] 0 0 0 0 4
[5,] 0 0 0 0 0
But i don't want to replace more than length of vector in matrix. And i want to have:
[1,] 0 1 2 4 0
[2,] 0 0 3 5 0
[3,] 0 0 0 6 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
You could adjust the length of v to that of the upper triangle. This yields some NA values that you can replace with zeroes.
u.tri <- upper.tri(mat, diag=FALSE)
mat[u.tri] <- `length<-`(v, length(u.tri))
mat[is.na(mat)] <- 0
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0 1 2 4 0
# [2,] 0 0 3 5 0
# [3,] 0 0 0 6 0
# [4,] 0 0 0 0 0
# [5,] 0 0 0 0 0
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
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
I am trying to save the row number for values equal to one, for every column seperatly in a matrix (matx). The matrix should contain 0's for every other object. It somehow worked to give me numbers which are just a little bit smaller (1 value smaller in the beginning, two and three later on), but not the right values. The original matrix has just values of 0 and 1.
My try:
matx<-replicate(n=100,rbinom(n= 250, size=1, prob = 0.01))
maty<-apply(!matx, 2, function(x) ifelse(x==0,
which(x %in% 1),
x==0))
also tried:
maty<-apply(!matx, 2, function(x) ifelse(x>0, as.integer(rownames(matx)), 0))
The second attempt just leaves me with NA's and 0's instead of the row number.
Assuming that #akrun's interpretation is correct (it's also how I read the question) you can also use the row function:
matx * row(matx)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0 1 0 0 0
# [2,] 0 0 2 0 0
# [3,] 3 3 3 0 0
# [4,] 4 4 0 0 0
# [5,] 5 0 0 5 0
# [6,] 6 6 6 0 0
# [7,] 0 0 0 7 0
# [8,] 8 0 8 8 0
# [9,] 9 9 9 9 0
# [10,] 0 0 0 10 0
If we need to replace the '1s' (in the binary matrix) with the corresponding row numbers leaving the '0s' as such, we can can which with arr.ind=TRUE to get the row/column index of non-zero numbers, use that index to replace the 1s with the row index column from 'ind'. Here, I created a copy of 'matx' (ie. 'maty') in case the original matrix is needed.
maty <- matx
ind <- which(matx!=0, arr.ind=TRUE)
maty[ind] <- ind[,1]
maty
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 0 0 2 0 0
#[3,] 3 3 3 0 0
#[4,] 4 4 0 0 0
#[5,] 5 0 0 5 0
#[6,] 6 6 6 0 0
#[7,] 0 0 0 7 0
#[8,] 8 0 8 8 0
#[9,] 9 9 9 9 0
#[10,] 0 0 0 10 0
and original matrix
matx
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 0 0 1 0 0
#[3,] 1 1 1 0 0
#[4,] 1 1 0 0 0
#[5,] 1 0 0 1 0
#[6,] 1 1 1 0 0
#[7,] 0 0 0 1 0
#[8,] 1 0 1 1 0
#[9,] 1 1 1 1 0
#[10,] 0 0 0 1 0
NOTE: This could be also used for non-numeric elements
Or a base R modification of apply solution in #eipi's post would be
apply(matx, 2,function(x) ifelse(x!=0, seq_along(x), 0) )
data
set.seed(24)
matx <- matrix(sample(0:1, 10*5, replace=TRUE), nrow=10)
If your original matx is purely 0s and 1s then this show work:
maty <- matx * row(matx)
an example:
> matx # stealing from akrun
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 0 0 0
[2,] 0 0 1 0 0
[3,] 1 1 1 0 0
[4,] 1 1 0 0 0
[5,] 1 0 0 1 0
[6,] 1 1 1 0 0
[7,] 0 0 0 1 0
[8,] 1 0 1 1 0
[9,] 1 1 1 1 0
[10,] 0 0 0 1 0
> matx * row(matx)
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 0 0 0
[2,] 0 0 2 0 0
[3,] 3 3 3 0 0
[4,] 4 4 0 0 0
[5,] 5 0 0 5 0
[6,] 6 6 6 0 0
[7,] 0 0 0 7 0
[8,] 8 0 8 8 0
[9,] 9 9 9 9 0
[10,] 0 0 0 10 0
Here's a way to do it using apply:
library(zoo) # For index function
apply(matx, 2, function(x) ifelse(x==1, index(x), 0))