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])
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
vec_length <- 4
nonzero_ind <- c(1, 3)
zero_ind <- c(2, 4)
Vector:
I currently have a vector called vec that contains 2 elements.
vec <- c(22, -5)
I want to obtain a vector of length vec_length that expands vec by adding 0s. The position of these 0s are specified by zero_ind. That is, I want a vector that looks like:
> expanded_vec
[1] 22 0 -5 0
Matrix
I currently have a 2x2 matrix called mat that corresponds to vec.
> mat
[,1] [,2]
[1,] 1 2
[2,] 2 3
I want to obtain a vec_length by vec_length matrix where there are 0s in the (i,j)-th position if either i OR j is one of the nonzero_ind. That is, I want a matrix that looks like:
> expected_mat
[,1] [,2] [,3] [,4]
[1,] 1 0 2 0
[2,] 0 0 0 0
[3,] 2 0 3 0
[4,] 0 0 0 0
For the vector:
"[<-"(numeric(vec_length), nonzero_ind, vec)
#[1] 22 0 -5 0
"[<-"(numeric(vec_length), seq_len(vec_length)[-zero_ind], vec)
#[1] 22 0 -5 0
x <- numeric(vec_length)
(x[nonzero_ind] <- vec)
#[1] 22 0 -5 0
x <- numeric(vec_length)
(x[-zero_ind] <- vec)
#[1] 22 0 -5 0
and the Matrix:
i <- "[<-"(rep(NA,vec_length), nonzero_ind, seq_along(nonzero_ind))
mat <- mat[i, i]
mat[is.na(mat)] <- 0
mat
# [,1] [,2] [,3] [,4]
#[1,] 1 0 2 0
#[2,] 0 0 0 0
#[3,] 2 0 3 0
#[4,] 0 0 0 0
or
mat_out <- matrix(0, vec_length, vec_length)
mat_out[nonzero_ind, nonzero_ind] <- mat
mat_out
# [,1] [,2] [,3] [,4]
#[1,] 1 0 2 0
#[2,] 0 0 0 0
#[3,] 2 0 3 0
#[4,] 0 0 0 0
Maybe you can try kronecker like below
> kronecker(vec,c(1,0))
[1] 22 0 -5 0
> kronecker(mat,matrix(c(1,0,0,0),nrow(mat)))
[,1] [,2] [,3] [,4]
[1,] 1 0 2 0
[2,] 0 0 0 0
[3,] 2 0 3 0
[4,] 0 0 0 0
One example:
# Input data
vec_inp <- c(22, -5)
mat_inp <- matrix(c(1, 2, 2, 3), ncol = 2)
# Vector case
update_vec <- function(inp, len, nzi) {
replace(x = vector(mode = 'double', length = len), list = nzi, values = inp)
}
update_vec(vec_inp, vec_length, nonzero_ind)
# [1] 22 0 -5 0
# Matrix case, work column by column
mat_out <- matrix(vector(mode = 'double', length = vec_length^2), ncol = vec_length)
for (i in seq_along(nonzero_ind)) {
mat_out[, nonzero_ind[i]] <- update_vec(mat_inp[, i], vec_length, nonzero_ind)
}
mat_out
# [,1] [,2] [,3] [,4]
# [1,] 1 0 2 0
# [2,] 0 0 0 0
# [3,] 2 0 3 0
# [4,] 0 0 0 0
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
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(.)
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