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
Related
I would create in R a square matrix where the values on main diagonal and anti-diagonal is the same. It's 2. The otherwise value is 0.
I would use the function "for" but I have no idea how to apply it.
This is that i would, but the way is wrong because i must use the function "for"
a <- matrix(0 , 10,10)
diag(a) <- 2
a <- data.frame(a)
a <- as.matrix(data.frame(lapply(a , rev)))
diag(a) <- 2
colnames(a) <- NULL
a
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 2 0 0 0 0 0 0 0 0 2
#> [2,] 0 2 0 0 0 0 0 0 2 0
#> [3,] 0 0 2 0 0 0 0 2 0 0
#> [4,] 0 0 0 2 0 0 2 0 0 0
#> [5,] 0 0 0 0 2 2 0 0 0 0
#> [6,] 0 0 0 0 2 2 0 0 0 0
#> [7,] 0 0 0 2 0 0 2 0 0 0
#> [8,] 0 0 2 0 0 0 0 2 0 0
#> [9,] 0 2 0 0 0 0 0 0 2 0
#> [10,] 2 0 0 0 0 0 0 0 0 2
Here's possibly the quickest way to do it with a for-loop.
m <- matrix(0, 10, 10)
for(i in 0:9) m[11*i+1] <- m[10+i*9] <- 2
m
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 2 0 0 0 0 0 0 0 0 2
#> [2,] 0 2 0 0 0 0 0 0 2 0
#> [3,] 0 0 2 0 0 0 0 2 0 0
#> [4,] 0 0 0 2 0 0 2 0 0 0
#> [5,] 0 0 0 0 2 2 0 0 0 0
#> [6,] 0 0 0 0 2 2 0 0 0 0
#> [7,] 0 0 0 2 0 0 2 0 0 0
#> [8,] 0 0 2 0 0 0 0 2 0 0
#> [9,] 0 2 0 0 0 0 0 0 2 0
#> [10,] 2 0 0 0 0 0 0 0 0 2
This works because a matrix can be indexed with a single number representing the entries in column 1 (1:10), then column 2 (11:20) and so on. The diagonal starts at position 1 and repeats every 11 entries. The anti-diagonal starts at 10 and repeats every 9 entries.
If this is a homework assignment, your teacher will probably want you to use the [row, column] notation for subsetting and use nested for loops, so you would be safer submitting this:
m <- matrix(0, 10, 10)
for(i in 1:10) {
for(j in 1:10) {
if(i == j || i == 11 - j) {
m[i, j] <- 2
}
}
}
m
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] 2 0 0 0 0 0 0 0 0 2
#> [2,] 0 2 0 0 0 0 0 0 2 0
#> [3,] 0 0 2 0 0 0 0 2 0 0
#> [4,] 0 0 0 2 0 0 2 0 0 0
#> [5,] 0 0 0 0 2 2 0 0 0 0
#> [6,] 0 0 0 0 2 2 0 0 0 0
#> [7,] 0 0 0 2 0 0 2 0 0 0
#> [8,] 0 0 2 0 0 0 0 2 0 0
#> [9,] 0 2 0 0 0 0 0 0 2 0
#> [10,] 2 0 0 0 0 0 0 0 0 2
Though it would be fun watching your teacher getting their head around the first version...
Created on 2022-06-08 by the reprex package (v2.0.1)
Is there a way to use apply family functions instead of the for loop in the code below?
m <- matrix(0, 10, 5)
m
for (i in 2:5) m[,i] <- m[,(i-1)] + 1
m
Does this answer:
> t(apply(m, 1, function(x) x = 0:4))
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 0 1 2 3 4
[3,] 0 1 2 3 4
[4,] 0 1 2 3 4
[5,] 0 1 2 3 4
[6,] 0 1 2 3 4
[7,] 0 1 2 3 4
[8,] 0 1 2 3 4
[9,] 0 1 2 3 4
[10,] 0 1 2 3 4
>
Data used:
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 0 0 0 0 0
[3,] 0 0 0 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
[6,] 0 0 0 0 0
[7,] 0 0 0 0 0
[8,] 0 0 0 0 0
[9,] 0 0 0 0 0
[10,] 0 0 0 0 0
> for(i in 2:5) m[,i] <- m[,(i-1)] + 1
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 0 1 2 3 4
[3,] 0 1 2 3 4
[4,] 0 1 2 3 4
[5,] 0 1 2 3 4
[6,] 0 1 2 3 4
[7,] 0 1 2 3 4
[8,] 0 1 2 3 4
[9,] 0 1 2 3 4
[10,] 0 1 2 3 4
>
This question already has an answer here:
Set diagonal of a matrix to zero in R
(1 answer)
Closed 2 years ago.
I tried using the rbern function in R but I realized that the diagonal entries are not all 0's.
This would be a possible way:
m <- 10
n <- 10
mat <- matrix(sample(0:1,m*n, replace=TRUE),m,n)
diag(mat) <- 0
#> mat
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 0 1 1 0 1 0 0 0 1 0
# [2,] 1 0 1 1 0 0 1 0 0 1
# [3,] 0 0 0 1 0 1 0 0 1 0
# [4,] 0 1 0 0 0 0 0 0 1 0
# [5,] 0 1 1 1 0 0 1 1 0 0
# [6,] 1 0 1 0 1 0 0 0 1 0
# [7,] 1 1 1 0 0 0 0 0 1 1
# [8,] 1 0 1 1 1 1 1 0 1 1
# [9,] 1 1 1 1 1 1 0 0 0 1
#[10,] 1 0 1 0 1 0 0 0 1 0
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))