I have a list of which consists of list of matrices as follows:
$A
$A[[1]]
$A[[1]][[1]]
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
$A[[2]]
$A[[2]][[1]]
[,1] [,2]
[1,] 2 7
[2,] 3 8
[3,] 4 9
[4,] 5 10
[5,] 6 11
$B
$B[[1]]
$B[[1]][[1]]
[,1] [,2]
[1,] 11 16
[2,] 12 17
[3,] 13 18
[4,] 14 19
[5,] 15 20
$B[[2]]
$B[[2]][[1]]
[,1] [,2]
[1,] 12 17
[2,] 13 18
[3,] 14 19
[4,] 15 20
[5,] 16 21
$C
$C[[1]]
$C[[1]][[1]]
[,1] [,2]
[1,] 0 0
[2,] 0 0
[3,] 0 0
[4,] 0 0
[5,] 0 0
$C[[2]]
$C[[2]][[1]]
[,1] [,2]
[1,] 0 0
[2,] 0 0
[3,] 0 0
[4,] 0 0
[5,] 0 0
The above list of matrices was created using the codes below:
A_mat1 <- matrix(as.numeric(c(1:10)), nrow = 5, ncol = 2)
B_mat1 <- matrix(as.numeric(c(11:20)), nrow = 5, ncol = 2)
C_mat1 <- matrix(as.numeric(0), nrow = 5, ncol = 2)
A_mat2 <- matrix(as.numeric(c(2:11)), nrow = 5, ncol = 2)
B_mat2 <- matrix(as.numeric(c(12:21)), nrow = 5, ncol = 2)
C_mat2 <- matrix(as.numeric(0), nrow = 5, ncol = 2)
my_matrix_name <- as.vector(c("A_mat1", "B_mat1", "C_mat1", "A_mat2", "B_mat2", "C_mat2"))
my_list = list(A_mat1, B_mat1, C_mat1, A_mat2, B_mat2, C_mat2)
names(my_list) <- my_matrix_name
my_A <- as.vector(my_matrix_name[substring(my_matrix_name,1,1) == "A"])
my_B <- as.vector(my_matrix_name[substring(my_matrix_name,1,1) == "B"])
my_C <- as.vector(my_matrix_name[substring(my_matrix_name,1,1) == "C"])
A = list()
for(i in seq_len(length(my_A))){
A[[i]] <- list(my_list[[paste0(my_A[[i]])]])
}
B = list()
for(i in seq_len(length(my_B))){
B[[i]] <- list(my_list[[paste0(my_B[[i]])]])
}
C = list()
for(i in seq_len(length(my_C))){
C[[i]] <- list(my_list[[paste0(my_C[[i]])]])
}
my_group = list(A,B,C)
names(my_group) <- c("A", "B", "C")
my_group
Where group C matrices have values of 0. Now I want to create a formula to overwrite group C equals to group A minus group B i.e. C = A - B
I have tried using
my_group[[3]] = my_group[[1]] - my_group[[2]]
and
my_group[[3]] = Map("-", my_group[[1]] , my_group[[2]])
but it gives error message: non-numeric argument to binary operator. Can anyone help me please? Thanks!
Because you have nested lists, your Map function is actually trying to subtract a list from another list. You need your mapping function to extract the first element of each list and subtract those
Map(function(A, B) A[[1]] - B[[1]], my_group$A , my_group$B)
#> [[1]]
#> [,1] [,2]
#> [1,] -10 -10
#> [2,] -10 -10
#> [3,] -10 -10
#> [4,] -10 -10
#> [5,] -10 -10
#>
#> [[2]]
#> [,1] [,2]
#> [1,] -10 -10
#> [2,] -10 -10
#> [3,] -10 -10
#> [4,] -10 -10
#> [5,] -10 -10
An option with pmap
library(purrr)
pmap(my_group[c('A', 'B')], ~ ..1[[1]] - ..2[[1]])
#[[1]]
# [,1] [,2]
#[1,] -10 -10
#[2,] -10 -10
#[3,] -10 -10
#[4,] -10 -10
#[5,] -10 -10
#[[2]]
# [,1] [,2]
#[1,] -10 -10
#[2,] -10 -10
#[3,] -10 -10
#[4,] -10 -10
#[5,] -10 -10
Related
Do you know an R function that sort each column of a matrix without using apply like this:
mat= matrix(c(1,2,0,-7,-4,7,8,3,12,15,23,-21),nrow = 4,ncol = 3)
apply(mat,2,sort)
##
[,1] [,2] [,3]
[1,] -7 -4 -21
[2,] 0 3 12
[3,] 1 7 15
[4,] 2 8 23
Do you also know a R function that return a vector of max of each column of a matrix without using apply like this?
mat2=matrix(c(2,1,0,-7,-4,7,8,3,12,15,23,-21),nrow = 3,ncol = 4)
apply(mat2,2,max)
##
[1] 2 7 12 23
Thanks.
If you really want to avoid using *apply family, here are several alternatives you can try
order method
> `dim<-`(mat[order(col(mat), mat)], dim(mat))
[,1] [,2] [,3]
[1,] -7 -4 -21
[2,] 0 3 12
[3,] 1 7 15
[4,] 2 8 23
> `dim<-`(mat2[order(col(mat2), -mat2)], dim(mat2))[1, ]
[1] 2 7 12 23
ave method
> ave(mat, col(mat), FUN = sort)
[,1] [,2] [,3]
[1,] -7 -4 -21
[2,] 0 3 12
[3,] 1 7 15
[4,] 2 8 23
> unique(ave(mat2, col(mat2), FUN = max))
[,1] [,2] [,3] [,4]
[1,] 2 7 12 23
> ave(mat2, col(mat2), FUN = max)[1, ]
[1] 2 7 12 23
aggregate method
> `dim<-`(unlist(aggregate(mat, list(rep(1, nrow(mat))), sort)[-1]), dim(mat))
[,1] [,2] [,3]
[1,] -7 -4 -21
[2,] 0 3 12
[3,] 1 7 15
[4,] 2 8 23
> unlist(aggregate(mat2, list(rep(1, nrow(mat2))), max)[-1])
V1 V2 V3 V4
2 7 12 23
One possibility for sorting is to use colSort from Rfast:
Rfast::colSort(mat)
[,1] [,2] [,3]
[1,] -7 -4 -21
[2,] 0 3 12
[3,] 1 7 15
[4,] 2 8 23
We can also use Rfast to get the max for each column:
Rfast::colMaxs(mat2, value = TRUE)
[1] 2 7 12 23
Another option for sorting is to use a simple for loop:
for(i in 1:ncol(mat)){
mat[,i] <- sort(mat[,i])
}
Could also use a simple for loop to get max:
max <- 0
for(i in 1:ncol(mat2)){
max[i] <- max(mat2[,i])
}
I have a list of matrices where most of the matrices are column matrices but some of them are row matrices. How to convert only those row matrices to column matrices? I would like to achieve this using base R.
Here is the list of matrices where the third one is a row matrix
x <- list(`1` = matrix(1:20, nrow=5), `2` = matrix(1:20, nrow=10), `3` = matrix(1:5, nrow=1))
How to convert the list to one like this:
$`1`
[,1] [,2] [,3] [,4] [,5]
[1,] 1 3 5 7 9
[2,] 2 4 6 8 10
$`2`
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
$`3`
[1,] 1
[2,] 2
[3,] 3
[4,] 4
[5,] 5
I have a much larger dataset and so efficient code is preferred!
Check the dimensions of the matrix and transpose it if the row dimension is 1:
(y <- lapply(x, function(x) if(dim(x)[1] == 1) { t(x)} else x))
# $`1`
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
#
# $`2`
# [,1] [,2]
# [1,] 1 11
# [2,] 2 12
# [3,] 3 13
# [4,] 4 14
# [5,] 5 15
# [6,] 6 16
# [7,] 7 17
# [8,] 8 18
# [9,] 9 19
# [10,] 10 20
#
# $`3`
# [,1]
# [1,] 1
# [2,] 2
# [3,] 3
# [4,] 4
# [5,] 5
Let's start with an exemplary multi-dimensional array like
a <- array(1:24, dim = c(3, 2, 2, 2)); a
, , 1, 1
[,1] [,2]
[1,] 1 4
[2,] 2 5
[3,] 3 6
, , 2, 1
[,1] [,2]
[1,] 7 10
[2,] 8 11
[3,] 9 12
, , 1, 2
[,1] [,2]
[1,] 13 16
[2,] 14 17
[3,] 15 18
, , 2, 2
[,1] [,2]
[1,] 19 22
[2,] 20 23
[3,] 21 24
Now I want to cbind or rbind the first two dimensions, which are matrices over the remaining dimensions 3 and 4, to an entire data.frame.
The resulting data.frame should like this using rbind:
[,1] [,2]
[1, ] 1 4
[2, ] 2 5
[3, ] 3 6
[4, ] 7 10
[5, ] 8 11
[6, ] 9 12
...
What would be an efficient way to bind the first two dimensions of a multi-dimensional array to an entire structure like data.frame? Please consider that the array can have any number of dimensions greater than 2, and not only 4 like in the above given example.
Thanks in advance
You can use apply:
apply(a, 2, identity)
# [,1] [,2]
# [1,] 1 4
# [2,] 2 5
# [3,] 3 6
# [4,] 7 10
# [5,] 8 11
# [6,] 9 12
# [7,] 13 16
# [8,] 14 17
# [9,] 15 18
#[10,] 19 22
#[11,] 20 23
#[12,] 21 24
Permuting and modifying dimensions is quite efficient:
a <- array(1:24, dim = c(3, 2, 2, 2))
a <- aperm(a, c(2, 1, 3, 4))
dim(a) <- c(dim(a)[1], prod(dim(a)[-1]))
t(a)
# [,1] [,2]
# [1,] 1 4
# [2,] 2 5
# [3,] 3 6
# [4,] 7 10
# [5,] 8 11
# [6,] 9 12
# [7,] 13 16
# [8,] 14 17
# [9,] 15 18
#[10,] 19 22
#[11,] 20 23
#[12,] 21 24
I am trying to do conditional subtraction of matrices in R. Let's say I have a list of matrices A, B, C. If my selection = 1, then C = A - B. Here are my codes:
selection = 1
A <- matrix(c(1:10), nrow = 5, ncol = 2)
A
B <- matrix(c(11:20), nrow = 5, ncol = 2)
B
C <- matrix(0, nrow = 5, ncol = 2)
C
my_matrix_name <- as.vector(c("A", "B", "C"))
my_list = list(A, B, C)
names(my_list) <- my_matrix_name
my_list$C <- ifelse(selection == 1, my_list$A - my_list$B, "Error")
The above codes yield the following results for my_list:
> my_list
$A
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
$B
[,1] [,2]
[1,] 11 16
[2,] 12 17
[3,] 13 18
[4,] 14 19
[5,] 15 20
$C
[1] -10
But my desired output is like this:
> my_list
$A
[,1] [,2]
[1,] 1 6
[2,] 2 7
[3,] 3 8
[4,] 4 9
[5,] 5 10
$B
[,1] [,2]
[1,] 11 16
[2,] 12 17
[3,] 13 18
[4,] 14 19
[5,] 15 20
$C
[,1] [,2]
[1,] -10 -10
[2,] -10 -10
[3,] -10 -10
[4,] -10 -10
[5,] -10 -10
Please help! Thanks!
Use if since the condition that you are checking is scalar and not a vector.
my_list$C <- if(selection == 1) my_list$A - my_list$B else 'Error'
my_list
#$A
# [,1] [,2]
#[1,] 1 6
#[2,] 2 7
#[3,] 3 8
#[4,] 4 9
#[5,] 5 10
#$B
# [,1] [,2]
#[1,] 11 16
#[2,] 12 17
#[3,] 13 18
#[4,] 14 19
#[5,] 15 20
#$C
# [,1] [,2]
#[1,] -10 -10
#[2,] -10 -10
#[3,] -10 -10
#[4,] -10 -10
#[5,] -10 -10
I am trying to draw a variable number of samples for each of n attempts. In this example n = 8 because length(n.obs) == 8. Once all of the samples have been drawn I want to combine them into a matrix.
Here is my first attempt:
set.seed(1234)
n.obs <- c(2,1,2,2,2,2,2,2)
my.samples <- sapply(1:8, function(x) sample(1:4, size=n.obs[x], prob=c(0.1,0.2,0.3,0.4), replace=TRUE))
my.samples
This approach produces a list.
class(my.samples)
#[1] "list"
I identify the number of columns needed in the output matrix using:
max.len <- max(sapply(my.samples, length))
max.len
#[1] 2
The output matrix can be created using:
corrected.list <- lapply(my.samples, function(x) {c(x, rep(NA, max.len - length(x)))})
output.matrix <- do.call(rbind, corrected.list)
output.matrix[is.na(output.matrix)] <- 0
output.matrix
# [,1] [,2]
#[1,] 4 3
#[2,] 3 0
#[3,] 3 2
#[4,] 3 4
#[5,] 4 3
#[6,] 3 3
#[7,] 3 4
#[8,] 1 4
The above approach seems to work fine as along as n.obs includes multiple values and at least one element in n.obs > 1. However, I want the code to be flexible enough to handle each of the following n.obs:
The above sapply statement returns a 2 x 8 matrix with the following n.obs.
set.seed(1234)
n.obs <- c(2,2,2,2,2,2,2,2)
The above sapply statement returns an integer with the following n.obs.
set.seed(3333)
n.obs <- c(1,1,1,1,1,1,1,1)
The above sapply statement returns a list with the following n.obs.
n.obs <- c(0,0,0,0,0,0,0,0)
Here are example desired results for each of the above three n.obs:
desired.output <- matrix(c(4, 3,
3, 3,
2, 3,
4, 4,
3, 3,
3, 3,
4, 1,
4, 2), ncol = 2, byrow = TRUE)
desired.output <- matrix(c(2,
3,
4,
2,
3,
4,
4,
1), ncol = 1, byrow = TRUE)
desired.output <- matrix(c(0,
0,
0,
0,
0,
0,
0,
0), ncol = 1, byrow = TRUE)
How can I generalize the code so that it always returns a matrix with eight rows regardless of the n.obs used as input? One way would be to use a series of if statements to handle problematic cases, but I thought there might be a simpler and more efficient solution.
We can write a function :
get_matrix <- function(n.obs) {
nr <- length(n.obs)
my.samples <- sapply(n.obs, function(x)
sample(1:4, size=x, prob=c(0.1,0.2,0.3,0.4), replace=TRUE))
max.len <- max(lengths(my.samples))
mat <- matrix(c(sapply(my.samples, `[`, 1:max.len)), nrow = nr, byrow = TRUE)
mat[is.na(mat)] <- 0
mat
}
Checking output :
get_matrix(c(2,1,2,2,2,2,2,2))
# [,1] [,2]
#[1,] 1 4
#[2,] 4 0
#[3,] 4 3
#[4,] 4 4
#[5,] 4 2
#[6,] 4 3
#[7,] 4 4
#[8,] 4 4
get_matrix(c(1,1,1,1,1,1,1,1))
# [,1]
#[1,] 4
#[2,] 4
#[3,] 3
#[4,] 4
#[5,] 2
#[6,] 4
#[7,] 1
#[8,] 4
get_matrix(c(0,0,0,0,0,0,0,0))
# [,1]
#[1,] 0
#[2,] 0
#[3,] 0
#[4,] 0
#[5,] 0
#[6,] 0
#[7,] 0
#[8,] 0
You could Vectorize the sample function on the size= argument.
samplev <- Vectorize(sample, "size", SIMPLIFY=F)
Wrap samplev into a function and assign maximal length using length<- in an lapply.
FUN <- function(n.obs, prob.=c(.1,.2,.3,.4)) {
s <- do.call(rbind, lapply(
samplev(1:4, size=n.obs, prob=prob., replace=TRUE),
`length<-`, max(n.obs)))
if (!all(dim(s))) matrix(0, length(n.obs))
else ({s[is.na(s)] <- 0; s})
}
Results:
set.seed(1234)
FUN(c(2,1,2,2,2,2,2,2))
# [,1] [,2]
# [1,] 4 3
# [2,] 3 0
# [3,] 3 2
# [4,] 3 4
# [5,] 4 3
# [6,] 3 3
# [7,] 3 4
# [8,] 1 4
FUN(c(2,2,2,2,2,2,2,2))
# [,1] [,2]
# [1,] 2 4
# [2,] 4 4
# [3,] 4 4
# [4,] 4 4
# [5,] 4 4
# [6,] 2 3
# [7,] 1 2
# [8,] 4 3
FUN(c(1,1,1,1,1,1,1,1))
# [,1]
# [1,] 4
# [2,] 4
# [3,] 3
# [4,] 4
# [5,] 2
# [6,] 4
# [7,] 4
# [8,] 1
FUN(c(0,0,0,0,0,0,0,0))
# [,1]
# [1,] 0
# [2,] 0
# [3,] 0
# [4,] 0
# [5,] 0
# [6,] 0
# [7,] 0
# [8,] 0
FUN(c(3, 4))
# [,1] [,2] [,3] [,4]
# [1,] 2 3 3 0
# [2,] 4 3 4 3