Apply with different argument value - r

I wanted to do apply on a matrix
val=c(1,2,3,4,5,6)
cpm <- apply(mat,2,function(x) (x/val[x])*1000000)
I need to use val matrix which contains 6 values, same as column number, I should use each number of val matrix for each columns.
How can I handle it?

Suppose you matrix mat is:
mat <- matrix(1:30,ncol=6)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 6 11 16 21 26
[2,] 2 7 12 17 22 27
[3,] 3 8 13 18 23 28
[4,] 4 9 14 19 24 29
[5,] 5 10 15 20 25 30
and
val=c(1,2,3,4,5,6)
A solution to your problem is:
cpm <- lapply(1:ncol(mat),
function(k, mtx, vec) (mtx[,k]/vec[k])*1000000, mtx=mat, vec=val)
matrix(unlist(cpm),ncol=ncol(mat))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1e+06 3000000 3666667 4000000 4200000 4333333
[2,] 2e+06 3500000 4000000 4250000 4400000 4500000
[3,] 3e+06 4000000 4333333 4500000 4600000 4666667
[4,] 4e+06 4500000 4666667 4750000 4800000 4833333
[5,] 5e+06 5000000 5000000 5000000 5000000 5000000

Related

Switch rows between two matrices in R

Let the matrices A and B.
A=c(1:5)*matrix(1,5,5)
B=10*A
that is,
> A
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
> B
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 20 20 20 20 20
[3,] 30 30 30 30 30
[4,] 40 40 40 40 40
[5,] 50 50 50 50 50
I would like, for example, to switch the first rows between the matrices A and B, that is
> A
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
> B
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 20 20 20 20 20
[3,] 30 30 30 30 30
[4,] 40 40 40 40 40
[5,] 50 50 50 50 50
using a function, and without using any indermediate vector or a for loop.
Update
As per you update in the comment, you can try
lapply(
1:nrow(B),
function(k) {
setNames(
Map(
function(x, ind,r) {
x[ind, ] <- r
x
},
list(A, B),
list(1,k),
list(B[k, ], A[1, ])
), c("A", "B")
)
}
)
which gives
[[1]]
[[1]]$A
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
[[1]]$B
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 1 1 1
[2,] 20 20 20 20 20
[3,] 30 30 30 30 30
[4,] 40 40 40 40 40
[5,] 50 50 50 50 50
[[2]]
[[2]]$A
[,1] [,2] [,3] [,4] [,5]
[1,] 20 20 20 20 20
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
[[2]]$B
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 1 1 1 1 1
[3,] 30 30 30 30 30
[4,] 40 40 40 40 40
[5,] 50 50 50 50 50
[[3]]
[[3]]$A
[,1] [,2] [,3] [,4] [,5]
[1,] 30 30 30 30 30
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
[[3]]$B
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 20 20 20 20 20
[3,] 1 1 1 1 1
[4,] 40 40 40 40 40
[5,] 50 50 50 50 50
[[4]]
[[4]]$A
[,1] [,2] [,3] [,4] [,5]
[1,] 40 40 40 40 40
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
[[4]]$B
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 20 20 20 20 20
[3,] 30 30 30 30 30
[4,] 1 1 1 1 1
[5,] 50 50 50 50 50
[[5]]
[[5]]$A
[,1] [,2] [,3] [,4] [,5]
[1,] 50 50 50 50 50
[2,] 2 2 2 2 2
[3,] 3 3 3 3 3
[4,] 4 4 4 4 4
[5,] 5 5 5 5 5
[[5]]$B
[,1] [,2] [,3] [,4] [,5]
[1,] 10 10 10 10 10
[2,] 20 20 20 20 20
[3,] 30 30 30 30 30
[4,] 40 40 40 40 40
[5,] 1 1 1 1 1
You can try the code below
list2env(
setNames(
Map(
function(x, r) {
x[1, ] <- r
x
},
list(A, B),
list(B[1, ], A[1, ])
), c("A", "B")
),
envir = .GlobalEnv
)
replace seems to work without any intermediate
replace(A, cbind(1, 1:ncol(A)), B[1,])
replace(B, cbind(1, 1:ncol(A)), A[1,])
Note that once we do the assignment to the original object, the second assignment is not possible as the original object is changed
A clean way to swap is to create a temporary object and rm it
tmp <- A[1,]
A[1, ] <- B[1, ]
B[1, ] <- tmp
rm(tmp)
gc()
Or probably create a function, and do the swap inside the function, thus the activation record is deleted once it exit the function (as these are pass by value)
f1 <- function(a, b) {
t1 <- a[1,]
a[1,] <- b[1,]
b[1,] <- t1
return(list(a, b))
}
list2env(setNames(f1(A, B), c('A', 'B')), .GlobalEnv)

How to multiply a matrix by a known vector to return an array

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

array_reshape() not reshaping arrays as desired

I have "old_array", I want to reshape it to become "new_array" using array_reshape()
old_array <- array(seq(1,30,1),c(2,3,5))
new_array <- t(array(seq(1,30,1),c(6,5)))
The old_array is:
, , 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
, , 2
[,1] [,2] [,3]
[1,] 7 9 11
[2,] 8 10 12
, , 3
[,1] [,2] [,3]
[1,] 13 15 17
[2,] 14 16 18
, , 4
[,1] [,2] [,3]
[1,] 19 21 23
[2,] 20 22 24
, , 5
[,1] [,2] [,3]
[1,] 25 27 29
[2,] 26 28 30
The new_array is:
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 7 8 9 10 11 12
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 25 26 27 28 29 30
I tried the following code, however the reshaped array is not the way I want:
array_reshape(old_array,c(6,5))
Expected results:
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 7 8 9 10 11 12
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 25 26 27 28 29 30
Actual results:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 7 13 19 25
[2,] 3 9 15 21 27
[3,] 5 11 17 23 29
[4,] 2 8 14 20 26
[5,] 4 10 16 22 28
[6,] 6 12 18 24 30
You can call matrix and specify the dimensions you desire. Given how R fills matrices, you need to specify byrow = TRUE in this scenario:
old_array <- array(seq(1,30,1),c(2,3,5))
matrix(old_array, nrow = dim(old_array)[3], ncol = prod(dim(old_array)[1:2]), byrow = TRUE)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 1 2 3 4 5 6
#> [2,] 7 8 9 10 11 12
#> [3,] 13 14 15 16 17 18
#> [4,] 19 20 21 22 23 24
#> [5,] 25 26 27 28 29 30
Created on 2019-03-31 by the reprex package (v0.2.1)
First, you want a 5x6 matrix. Your current code is asking for a return of 6x5 so you would want to write
array_reshape(old_array, c(5,6))
However, your old_array is returning 5 different matrices all 2x3. Since you are filling it in by row, it looks like array_reshape will take the first value from each row of each separate matrix and then since you are telling it to have 6 columns it then grabs the second value of the first matrix to fill out the first row of the 5x6. It then repeats this pattern to fill in the other 4 rows. This will return:
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 7 13 19 25 3
[2,] 9 15 21 27 5 11
[3,] 17 23 29 2 8 14
[4,] 20 26 4 10 16 22
[5,] 28 6 12 18 24 30
Can you remove c(2,3,5) from your old_array line? It will work fine then. Otherwise array_reshape is not the appropriate function in this case. But, if you really want to use it, you can tell it to fill a 6x5 matrix by column and then transpose the matrix. This will give you the result you want:
t(array_reshape(old_array, c(6,5), "F"))
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 4 5 6
[2,] 7 8 9 10 11 12
[3,] 13 14 15 16 17 18
[4,] 19 20 21 22 23 24
[5,] 25 26 27 28 29 30

Taking the transpose of square blocks in a rectangular matrix r

Suppose I have two square matrices (actually many more) that are bound together:
mat = matrix(1:18,nrow=3,ncol=6)
mat
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 4 7 10 13 16
[2,] 2 5 8 11 14 17
[3,] 3 6 9 12 15 18
I want to take the transpose of each (3x3) matrix and keep them glued side by side, so the result is:
mat2
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 1 2 3 10 11 12
[2,] 4 5 6 13 14 15
[3,] 7 8 9 16 17 18
I do not want to do this manually because it is MANY matrices cbound together, not just 2.
I would like a solution that avoids looping or apply (which is just a wrapper for a loop). I need the efficient solution because this will have to run tens of thousands of times.
One way is to use matrix indexing
matrix(t(m), nrow=nrow(m))[, c(matrix(1:ncol(m), nrow(m), byrow=T)) ]
This takes the transposed matrix and rearanges the columns in the desired order.
m <- matrix(1:18,nrow=3,ncol=6)
matrix(t(m), nrow=nrow(m))
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 10 2 11 3 12
# [2,] 4 13 5 14 6 15
# [3,] 7 16 8 17 9 18
So we want the 1st, 3rd, and 5th columns, and 2, 4, and 6th columns together.
One way is to index these with
c(matrix(1:ncol(m), nrow(m), byrow=T))
#[1] 1 3 5 2 4 6
As an alternative, you could use
idx <- rep(1:ncol(m), each=nrow(m), length=ncol(m)) ;
do.call(cbind, split.data.frame(t(m), idx))
Try on a new matrix
(m <- matrix(1:50, nrow=5))
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 6 11 16 21 26 31 36 41 46
# [2,] 2 7 12 17 22 27 32 37 42 47
# [3,] 3 8 13 18 23 28 33 38 43 48
# [4,] 4 9 14 19 24 29 34 39 44 49
# [5,] 5 10 15 20 25 30 35 40 45 50
matrix(t(m), nrow=nrow(m))[, c(matrix(1:ncol(m), nrow(m), byrow=T)) ]
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 1 2 3 4 5 26 27 28 29 30
# [2,] 6 7 8 9 10 31 32 33 34 35
# [3,] 11 12 13 14 15 36 37 38 39 40
# [4,] 16 17 18 19 20 41 42 43 44 45
# [5,] 21 22 23 24 25 46 47 48 49 50
This might do it:
mat = matrix(1:18,nrow=3,ncol=6)
mat
output <- lapply(seq(3, ncol(mat), 3), function(i) { t(mat[, c((i - 2):i)]) } )
output
do.call(cbind, output)
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 1 2 3 10 11 12
#[2,] 4 5 6 13 14 15
#[3,] 7 8 9 16 17 18
Was curious and timed the two approaches. The matrix approach used by user20650 is much faster than the lapply approach I used:
library(microbenchmark)
mat = matrix(1:1600, nrow=4, byrow = FALSE)
lapply.function <- function(x) {
step1 <- lapply(seq(nrow(mat), ncol(mat), nrow(mat)), function(i) {
t(mat[, c((i - (nrow(mat) - 1) ):i)])
} )
l.output <- do.call(cbind, step1)
return(l.output)
}
lapply.output <- lapply.function(mat)
matrix.function <- function(x) {
m.output <- matrix(t(mat), nrow=nrow(mat))[, c(matrix(1:ncol(mat), nrow(mat), byrow=TRUE)) ]
}
matrix.output <- matrix.function(mat)
identical(lapply.function(mat), matrix.function(mat))
microbenchmark(lapply.function(mat), matrix.function(mat), times = 1000)
#Unit: microseconds
# expr min lq mean median uq max neval
# lapply.function(mat) 735.602 776.652 824.44917 791.443 809.856 2260.834 1000
# matrix.function(mat) 32.298 35.619 37.75495 36.826 37.732 78.481 1000

Transforming a table in a 3D array in R

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

Resources