I am trying to learn different ways to use to the objects inside a list as the FUN arguments in lapply. Take this data:
A <- list(a = matrix(0, ncol = 3, nrow = 3), b = matrix(0, ncol = 3, nrow = 3))
B <- list(a = matrix(1, ncol = 1, nrow = 3), b = matrix(1, ncol = 1, nrow = 3))
D <- mapply(FUN="list", A, B, SIMPLIFY=F, USE.NAMES=F)
D <- lapply(D, `names<-`, c("first", "second"))
D
[[1]]
[[1]]$`first`
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
[[1]]$second
[,1]
[1,] 1
[2,] 1
[3,] 1
[[2]]
[[2]]$`first`
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
[[2]]$second
[,1]
[1,] 1
[2,] 1
[3,] 1
Desired result:
[[1]]
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
[4,] 1 1 1
[[2]]
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 0 0
[3,] 0 0 0
[4,] 1 1 1
This is how I would normally do it:
lapply(D, function(x) rbind(x$first, as.numeric(x$second)))
Now I am wondering whether there is a way to avoid using function(x) and repeating all those xs. Something like:
lapply(D, "rbind", <args>)
How can I let rbind (or any other function) know that I am referring to objects within the frame of lapply?
Thank you,
K.
To "avoid using function(x) and repeating all those xs", we could use with():
lapply(D, with, rbind(first, as.numeric(second)))
Update
As per the commments changed the code to keep only the right solution.
As some of the commentators said, the problem is that B would need to be transposed, to find an elegant solution. You should have a look to library(purrr) because with that the whole problem reduces to:
map2(A, B, ~ rbind(.x, t(.y)))
# $`a`
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 0 0 0
# [3,] 0 0 0
# [4,] 1 1 1
# $b
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 0 0 0
# [3,] 0 0 0
# [4,] 1 1 1
What map2 does is that it takes 2 lists and applies the function to each element of these lists. The ~ syntax is a shortcut for function(.)
Related
I am trying to generate matrices of m*n elements with binary data on the condition that the sum of the rows must equal 1.
For example, all the possible 2*2 matrices of binary data on condition that the row sums equal 1 are:
[,1] [,2]
[1,] 1 0
[2,] 1 0
[,1] [,2]
[1,] 0 1
[2,] 0 1
[,1] [,2]
[1,] 0 1
[2,] 1 0
[,1] [,2]
[1,] 1 0
[2,] 0 1
Can anyone help out with some neat code to achieve such an output? Or is there a function that can help with this?
A straightforward approach involves generating all vectors of length n containing n - 1 zeros and 1 one. This is reduced to all permutations of the multiset {0, 0, ... ,0, 1}. Let's say that there are K such permutations.
Once we have all of these, we generate the permutations of K with repetition of size m, where m is the desired number of rows. We use each of these results to subset the permutations of the zeros and ones.
Below, we have implemented this using the library RcppAlgos (disclosure: I am the author). The first part (i.e. generating permutations of multisets) is accomplished using the freqs parameter. The second part is accomplished using the FUN parameter, which allows one to pass arbitrary functions that act on each permutation.
library(RcppAlgos)
binMat <- function(m, n, row_sum = 1) {
perms <- if (n == row_sum) {
permuteGeneral(1, n, repetition = TRUE)
} else {
permuteGeneral(0:1, n, freqs = c(n - row_sum, row_sum))
}
permuteGeneral(nrow(perms), m, repetition = TRUE, FUN = function(x) {
perms[x, ]
})
}
Note, in the above that one can generate matrices with different row sums using the row_sum parameter.
Here is an example:
binMat(3, 2)
[[1]]
[,1] [,2]
[1,] 0 1
[2,] 0 1
[3,] 0 1
[[2]]
[,1] [,2]
[1,] 0 1
[2,] 0 1
[3,] 1 0
[[3]]
[,1] [,2]
[1,] 0 1
[2,] 1 0
[3,] 0 1
[[4]]
[,1] [,2]
[1,] 0 1
[2,] 1 0
[3,] 1 0
[[5]]
[,1] [,2]
[1,] 1 0
[2,] 0 1
[3,] 0 1
[[6]]
[,1] [,2]
[1,] 1 0
[2,] 0 1
[3,] 1 0
[[7]]
[,1] [,2]
[1,] 1 0
[2,] 1 0
[3,] 0 1
[[8]]
[,1] [,2]
[1,] 1 0
[2,] 1 0
[3,] 1 0
It's efficient as well:
system.time(testMany <- binMat(7, 7))
user system elapsed
1.936 0.062 1.999
testMany[[1]]
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 0 0 0 0 0 0 1
[2,] 0 0 0 0 0 0 1
[3,] 0 0 0 0 0 0 1
[4,] 0 0 0 0 0 0 1
[5,] 0 0 0 0 0 0 1
[6,] 0 0 0 0 0 0 1
[7,] 0 0 0 0 0 0 1
length(testMany)
[1] 823543
With base R this can be a solution,
# m : number of columns
# n : number of rows
my_fun <- function(m,n) {
a <- max(m,n)
mat <- diag(1, a, a)
x <- 1:nrow(mat)
y <- paste0(rep("x",n),collapse=",")
exp <- paste0("expand.grid(",y,")")
all_com <- eval(parse(text=exp ))
out <- lapply(1:nrow(all_com),function(x){
if(m>n) {
mat[as.numeric(all_com[x,]),]
}else{
mat <- mat[as.numeric(all_com[x,]),][,1:m]
mat <- mat[rowSums(mat)==1,]
}
})
out <- out[lapply(out,length) == m*n]
return(unique(out))
}
my_fun(2,2)
gives,
[[1]]
[,1] [,2]
[1,] 1 0
[2,] 1 0
[[2]]
[,1] [,2]
[1,] 0 1
[2,] 1 0
[[3]]
[,1] [,2]
[1,] 1 0
[2,] 0 1
[[4]]
[,1] [,2]
[1,] 0 1
[2,] 0 1
I would like to convert a frequency vector (i.e. the colSums() of a matrix) to one of the possible versions of the original logical matrix in R.
Something like:
s <- c(1,2,3)
# Some function of s
# Example output:
[,1] [,2] [,3]
[1,] 0 0 1
[2,] 1 0 0
[3,] 0 1 0
[4,] 0 0 1
[5,] 0 0 1
[6,] 0 1 0
The order of rows is not important.
Could someone give me a hint on how to do this?
Edit: Rowsums are always 1. The output can be considered a multinomial dataset where each row reflects an observation.
set.seed(523)
s <- c(1, 2, 3)
n <- 6
sapply(s, function(i) sample(c(rep(1, i), rep(0, n - i))))
# [,1] [,2] [,3]
# [1,] 0 1 1
# [2,] 1 0 0
# [3,] 0 1 0
# [4,] 0 0 1
# [5,] 0 0 0
# [6,] 0 0 1
s <- c(1,2,3)
result = matrix(0, nrow = max(s), ncol = length(s))
for (i in seq_along(s)) result[1:s[i], i] = 1
result
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 0 1 1
# [3,] 0 0 1
Keeping rowsums as 1
s <- c(1,2,3)
result = matrix(0, nrow = sum(s), ncol = length(s))
result[cbind(1:sum(s), rep(seq_along(s), times = s))] = 1
result
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 1 0
# [3,] 0 1 0
# [4,] 0 0 1
# [5,] 0 0 1
# [6,] 0 0 1
# Input:
s <- c(1,2,3)
# ...
set.seed(1) # For reproducibility
nr <- sum(s)
nc <- length(s)
mat <- matrix(0L, nrow = nr, ncol = nc)
mat[cbind(seq_len(nr), sample(rep(seq_len(nc), s)))] <- 1L
# Output:
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 1
[3,] 0 1 0
[4,] 0 0 1
[5,] 0 1 0
[6,] 0 0 1
I am trying to apply the Reduce function with | (OR) and accumulate = TRUE on the columns of a matrix.
Example input:
m <- matrix(c(1,0,0,0,1,0,0,0,1), nrow = 3)
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 1 0
[3,] 0 0 1
The result should be
m2 <- matrix(c(1,0,0,1,1,0,1,1,1), nrow = 3)
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 0 1 1
[3,] 0 0 1
Suppose I have three matrices:
Mat1 = matrix(0,4,4)
Mat2 = matrix(0,4,4)
Mat3 = matrix(0,4,4)
Then suppose that I need to create numbers of matrix is very difficult to do that manually. Also, I want to make these function as a low triangle matrix using low.tri(Mat1), so is there any way to do that easly.
I search lapply families but could not find the answer for my question.
lapply is used on lists. First, you insert all your matrices in a list. lower.tri is a logical function. If you want to get a lower triangle, you should create a function similar to f below. Then you can use lapply like so:
Mat1 = matrix(0,4,4)
Mat2 = matrix(0,4,4)
Mat3 = matrix(0,4,4)
l <- list(Mat1,Mat2,Mat3)
f <- function(m) {
m[lower.tri(m)] <- 1
m
}
lapply(l,f)
[[1]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
[[2]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
[[3]]
[,1] [,2] [,3] [,4]
[1,] 0 0 0 0
[2,] 1 0 0 0
[3,] 1 1 0 0
[4,] 1 1 1 0
I have a matrix (really, a 3-D array) that I would like to "threshold" based on the values in another matrix (which is completely binarized). So, e.g.
set.seed(1234)
M <- matrix(1:9, nrow=3, byrow=F)
M
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
set.seed(1234)
N <- matrix(sample(c(0, 0, 1), 9, replace=T), nrow=3)
N
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 1 0
[3,] 0 0 0
I would like to keep only the values in M that are in the same location as where N equals 1; turn the rest into 0's. Output should be:
M.thresh
[,1] [,2] [,3]
[1,] 0 0 0
[2,] 0 5 0
[3,] 0 0 0
Just replace with matrix indexing.
N[N == 1] <- M[N == 1]
N
# [,1] [,2] [,3]
# [1,] 0 0 0
# [2,] 0 5 0
# [3,] 0 0 0
Or replace(N, N == 1, M[N == 1])