I have a matrix M, I want to create 3 additional matrices where each additional matrix has certain 3x3 column-slices of M multiplied by values in a vector, I will then store the resulting 3 new matrices in a list.
##create the initial matrix
M <- matrix(1:20, nrow = 4)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 5 9 13 17
[2,] 2 6 10 14 18
[3,] 3 7 11 15 19
[4,] 4 8 12 16 20
## coordinates in the matrix I want to alter
iy <- c(1, 2, 3)
ix <- c(1, 4, 5)
coords <- as.data.frame(cbind(ix, iy))
## multiplier values
multis <- c(0.1, 2, 100)
Pseudo code of what I want to do
mapply (function(multis, cords) {multis * M[coords$iy, coords$ix]})
what the result should look like
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 0.1 5 9 13.0 17.0
[2,] 2.0 6 10 1.4 18.0
[3,] 3.0 7 11 15.0 1.1
[4,] 4.0 8 12 16.0 20.0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 2 5 9 13 17
[2,] 2 6 10 28 18
[3,] 3 7 11 15 38
[4,] 4 8 12 16 20
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 100 5 9 13 17
[2,] 2 6 10 1400 18
[3,] 3 7 11 15 1900
[4,] 4 8 12 16 20
First you need to coerce coords to a matrix for indexing, then reverse the column order. Then it's just a simple lapply() loop.
coords <- as.matrix(coords)[, 2:1]
lapply(multis, function(x) {
M[coords] <- M[coords] * x
M
})
resulting in
[[1]]
[,1] [,2] [,3] [,4] [,5]
[1,] 0.1 5 9 13.0 17.0
[2,] 2.0 6 10 1.4 18.0
[3,] 3.0 7 11 15.0 1.9
[4,] 4.0 8 12 16.0 20.0
[[2]]
[,1] [,2] [,3] [,4] [,5]
[1,] 2 5 9 13 17
[2,] 2 6 10 28 18
[3,] 3 7 11 15 38
[4,] 4 8 12 16 20
[[3]]
[,1] [,2] [,3] [,4] [,5]
[1,] 100 5 9 13 17
[2,] 2 6 10 1400 18
[3,] 3 7 11 15 1900
[4,] 4 8 12 16 20
Another solution is to use a defined function and use a sapply for each multis:
##create the initial matrix
M <- matrix(1:20, nrow = 4)
## coordinates in the matrix I want to alter
Y <- c(1, 2, 3)
X <- c(1, 4, 5)
coords <- as.data.frame(cbind(X, Y))
## multiplier values
multis <- c(0.1, 2, 100)
## Modifying the specific coordinates.
modif.one.matrix <- function(one_multis, coords, M) {
M_out <- M
for(one_coord in 1:nrow(coords)) {
M_out[coords$Y[one_coord], coords$X[one_coord]] <- M[coords$Y[one_coord], coords$X[one_coord]] * one_multis
}
return(M_out)
}
## Modifying one matrix
modif.one.matrix(multis[1], coords, M)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0.1 5 9 13.0 17.0
#[2,] 2.0 6 10 1.4 18.0
#[3,] 3.0 7 11 15.0 1.9
#[4,] 4.0 8 12 16.0 20.0
## Modifying all the matrices
sapply(multis, modif.one.matrix, coords, M, simplify = FALSE)
#[[1]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0.1 5 9 13.0 17.0
#[2,] 2.0 6 10 1.4 18.0
#[3,] 3.0 7 11 15.0 1.9
#[4,] 4.0 8 12 16.0 20.0
#
#[[2]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 2 5 9 13 17
#[2,] 2 6 10 28 18
#[3,] 3 7 11 15 38
#[4,] 4 8 12 16 20
#
#[[3]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 100 5 9 13 17
#[2,] 2 6 10 1400 18
#[3,] 3 7 11 15 1900
#[4,] 4 8 12 16 20
Related
Good afternoon!
Assume we have a vector and a matrix :
v = c(2,3,4)
[1] 2 3 4
m=matrix(1:9,ncol=3)
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
I'm searching an efficient way ( or built-in function ) to get three matrices m1 , m2 , m3 such that :
m1=v[1]*m
m2=v[2]*m
m3=v[3]*m
We could obtain this using a 3d-array :
my_fct<-function(m,v){
f=array(data=rep(NA,nrow(m)*ncol(m)*length(v)),dim = c(nrow(m),ncol(m),length(v)))
for (j in c(1:length(v))){
f[,,j]=v[j]*m
}
return(f)
}
my_fct(m,v)
, , 1
[,1] [,2] [,3]
[1,] 2 8 14
[2,] 4 10 16
[3,] 6 12 18
, , 2
[,1] [,2] [,3]
[1,] 3 12 21
[2,] 6 15 24
[3,] 9 18 27
, , 3
[,1] [,2] [,3]
[1,] 4 16 28
[2,] 8 20 32
[3,] 12 24 36
I hope my request is clear!
Thank you a lot for help !
As 'v' is a vector and we want each element to be multiplied by the same matrix 'm', an option is to loop over the element of 'v' and do the multiplication
lapply(v, `*`, m)
-output
[[1]]
[,1] [,2] [,3]
[1,] 2 8 14
[2,] 4 10 16
[3,] 6 12 18
[[2]]
[,1] [,2] [,3]
[1,] 3 12 21
[2,] 6 15 24
[3,] 9 18 27
[[3]]
[,1] [,2] [,3]
[1,] 4 16 28
[2,] 8 20 32
[3,] 12 24 36
Another base R option
> Map(`*`, list(m), v)
[[1]]
[,1] [,2] [,3]
[1,] 2 8 14
[2,] 4 10 16
[3,] 6 12 18
[[2]]
[,1] [,2] [,3]
[1,] 3 12 21
[2,] 6 15 24
[3,] 9 18 27
[[3]]
[,1] [,2] [,3]
[1,] 4 16 28
[2,] 8 20 32
[3,] 12 24 36
I am trying to put a list of matrices together in a list and then do summation inside of each list. Below are the simple example of the codes:
Let's say if I have 4 matrices:
x1 <- matrix(1:9, nrow = 3)
x2 <- matrix(2:10, nrow = 3)
x3 <- matrix(3:11, nrow = 3)
x4 <- matrix(4:12, nrow = 3)
And I want to put them into a list() in a way like this:
[[1]]
[[1]][[1]]
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
[[1]][[2]]
[,1] [,2] [,3]
[1,] 2 5 8
[2,] 3 6 9
[3,] 4 7 10
[[2]]
[,1] [,2] [,3]
[1,] 3 6 9
[2,] 4 7 10
[3,] 5 8 11
[[3]]
[,1] [,2] [,3]
[1,] 4 7 10
[2,] 5 8 11
[3,] 6 9 12
And how do I perform summation of each element inside the list()?
For example, my desired output is as below:
[[1]]
[,1] [,2] [,3]
[1,] 3 9 15
[2,] 5 11 17
[3,] 7 13 19
[[2]]
[,1] [,2] [,3]
[1,] 3 6 9
[2,] 4 7 10
[3,] 5 8 11
[[3]]
[,1] [,2] [,3]
[1,] 4 7 10
[2,] 5 8 11
[3,] 6 9 12
I have tried using list(Reduce(`+`, x)) however it does not work.
Since you want to keep top-level list use lapply :
lapply(x, function(l) if(is.list(l)) Reduce(`+`, l) else l)
#[[1]]
# [,1] [,2] [,3]
#[1,] 3 9 15
#[2,] 5 11 17
#[3,] 7 13 19
#[[2]]
# [,1] [,2] [,3]
#[1,] 3 6 9
#[2,] 4 7 10
#[3,] 5 8 11
#[[3]]
# [,1] [,2] [,3]
#[1,] 4 7 10
#[2,] 5 8 11
#[3,] 6 9 12
A corresponding purrr version of #RonakShah's answer with map_if():
library(purrr)
map_if(x, is.list, reduce, `+`)
# [[1]]
# [,1] [,2] [,3]
# [1,] 3 9 15
# [2,] 5 11 17
# [3,] 7 13 19
#
# [[2]]
# [,1] [,2] [,3]
# [1,] 3 6 9
# [2,] 4 7 10
# [3,] 5 8 11
#
# [[3]]
# [,1] [,2] [,3]
# [1,] 4 7 10
# [2,] 5 8 11
# [3,] 6 9 12
I have a matrix with size 18000 x 54. I would like to reshape it as a matrix with size 54000 x 18, in which each row of my initial matrix becomes a matrix which has 3 rows.
Let's take an example. I have a matrix as follow:
a = matrix(1:18, nrow = 2, ncol = 9, byrow = T)
a
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
1 2 3 4 5 6 7 8 9
10 11 12 13 14 15 16 17 18
I would like to reshape this matrix so that it becomes:
[,1] [,2] [,3]
1 4 7
2 5 8
3 6 9
10 13 16
11 14 17
12 15 18
I tried two following ways, but they do not work. The first is as follows:
dim(a) = c(6,3)
The second one is to create a function and then apply to each row:
reshapeX = function(x){
dim(x) = c(3,as.integer(length(x)/3))
return(as.matrix(x))
}
rbind(apply(a, 1, reshapeX))
But it does not work neither. Can someone help please?
You can do:
do.call(rbind, lapply(1:nrow(a), function(i) matrix(a[i, ], nrow=3)))
with your data:
a <- matrix(1:18, nrow = 2, ncol = 9, byrow = TRUE)
do.call(rbind, lapply(1:nrow(a), function(i) matrix(a[i, ], nrow=3)))
# [,1] [,2] [,3]
# [1,] 1 4 7
# [2,] 2 5 8
# [3,] 3 6 9
# [4,] 10 13 16
# [5,] 11 14 17
# [6,] 12 15 18
Here is a loop free method,
m1 <- matrix(c(a), ncol = 3, nrow = 6)
rbind(m1[c(TRUE, FALSE),], m1[c(FALSE, TRUE),])
# [,1] [,2] [,3]
#[1,] 1 4 7
#[2,] 2 5 8
#[3,] 3 6 9
#[4,] 10 13 16
#[5,] 11 14 17
#[6,] 12 15 18
An option would be
out <- sapply(split.default(as.data.frame(a), as.integer(gl(ncol(a), 3,
ncol(a)))), function(x) c(t(x)))
colnames(out) <- NULL
out
# [,1] [,2] [,3]
#[1,] 1 4 7
#[2,] 2 5 8
#[3,] 3 6 9
#[4,] 10 13 16
#[5,] 11 14 17
#[6,] 12 15 18
Or in shorter form of the above
sapply(split(a,(col(a)-1) %/%3), function(x) c(matrix(x, nrow = 3, byrow = TRUE)))
Or this can be done more compactly with array
apply(array(c(t(a)), c(3, 3, 2)), 2, c)
# [,1] [,2] [,3]
#[1,] 1 4 7
#[2,] 2 5 8
#[3,] 3 6 9
#[4,] 10 13 16
#[5,] 11 14 17
#[6,] 12 15 18
For, example I if a had matrix like this:
realmatrix=matrix(1:16,ncol=4,nrow=4)
Which would give this:
[,1] [,2] [,3] [,4]
[1,] 1 5 9 13
[2,] 2 6 10 14
[3,] 3 7 11 15
[4,] 4 8 12 16
And I would like to make a function that would replace the two columns with a certain value ( for example 1:4) if it has a even number of colums, then the result should be something like this:
[,1] [,2] [,3] [,4]
[1,] 1 1 1 13
[2,] 2 2 2 14
[3,] 3 3 3 15
[4,] 4 4 4 16
And if the matrix has odd numbers of colums, the function should replace only the odd column, that is to say the central one:
This is the matrix with odd numbers of columns:
realmatrix2=matrix(1:12,ncol=3,nrow=4)
The final result:
[,1] [,2] [,3]
[1,] 1 1 9
[2,] 2 2 10
[3,] 3 3 11
[4,] 4 4 12
Thanks a lot!
Try:
fun2 <- function(mat, val){
stopifnot(length(val)==nrow(mat))
n <- ncol(mat)
if( (n/2) %%2 ==0){
mat[, c(n/2, n/2+1)] <- val
}
else {
mat[, ceiling(n/2)] <- val
}
mat
}
fun2(realmatrix, 1:4)
# [,1] [,2] [,3] [,4]
#[1,] 1 1 1 13
#[2,] 2 2 2 14
#[3,] 3 3 3 15
#[4,] 4 4 4 16
fun2(realmatrix2,1:4)
# [,1] [,2] [,3]
#[1,] 1 1 9
#[2,] 2 2 10
#[3,] 3 3 11
#[4,] 4 4 12
realmatrix5=matrix(1:32, ncol=8,nrow=4)
fun2(realmatrix5, 1:4)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#[1,] 1 5 9 1 1 21 25 29
#[2,] 2 6 10 2 2 22 26 30
#[3,] 3 7 11 3 3 23 27 31
#[4,] 4 8 12 4 4 24 28 32
Update
If you want to change the rows:
funR <- function(mat, val){
stopifnot(length(val)==ncol(mat))
n <- nrow(mat)
if((n/2) %%2==0){
mat[c(n/2, n/2+1),] <- rep(val, each=2)
}
else {
mat[ceiling(n/2),] <- val
}
mat
}
funR(realmatrix, 1:4)
# [,1] [,2] [,3] [,4]
#[1,] 1 5 9 13
#[2,] 1 2 3 4
#[3,] 1 2 3 4
#[4,] 4 8 12 16
realmatrix3 <- matrix(1:15, ncol=5)
funR(realmatrix3, 1:5)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 4 7 10 13
#[2,] 1 2 3 4 5
#[3,] 3 6 9 12 15
I have a matrix:
R> pippo.m
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
[3,] 9 10 11 12
[4,] 13 14 15 16
[5,] 17 18 19 20
[6,] 21 22 23 24
and I would like to transform this matrix in a 3D array with dim=(2,4,3). Passing through the transponse of pippo.m I am able to obtain a similar result but with columns and rows rotated.
> pippo.t <- t(pippo.m)
> pippo.vec <- as.vector(pippo.t)
> pippo.arr <- array(pippo.vec,dim=c(4,2,3),dimnames=NULL)
> pippo.arr
, , 1
[,1] [,2]
[1,] 1 5
[2,] 2 6
[3,] 3 7
[4,] 4 8
, , 2
[,1] [,2]
[1,] 9 13
[2,] 10 14
[3,] 11 15
[4,] 12 16
, , 3
[,1] [,2]
[1,] 17 21
[2,] 18 22
[3,] 19 23
[4,] 20 24
Actually, I would prefer to mantain the same distribution of the original data, as rows and colums represent longitude and latitude and the third dimension is time. So I would like to obtain something like this:
pippo.a
, , 1
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
, , 2
[,1] [,2] [,3] [,4]
[1,] 9 10 11 12
[2,] 13 14 15 16
, , 3
[,1] [,2] [,3] [,4]
[1,] 17 18 19 20
[2,] 21 22 23 24
How can I do?
Behold the magic of aperm!
m <- matrix(1:24,6,4,byrow = TRUE)
> aperm(array(t(m),c(4,2,3)),c(2,1,3))
, , 1
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 5 6 7 8
, , 2
[,1] [,2] [,3] [,4]
[1,] 9 10 11 12
[2,] 13 14 15 16
, , 3
[,1] [,2] [,3] [,4]
[1,] 17 18 19 20
[2,] 21 22 23 24