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
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
A reproducible example:
mat1 <- matrix(c(1,0,0,0,0,0,1,0,1,0,0,0), nrow = 3, ncol = 4, byrow = T)
mat2 <- matrix(c(0,1,0,0,0,0,1,0,0,0,0,1), nrow = 3, ncol = 4, byrow = T)
ex.list <- list(mat1,mat2)
> ex.list
[[1]]
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 0 0 1 0
[3,] 1 0 0 0
[[2]]
[,1] [,2] [,3] [,4]
[1,] 0 1 0 0
[2,] 0 0 1 0
[3,] 0 0 0 1
ex.list consists of binary matrices and row of each of these matrices contain only a single 1 and rest are filled with zeros.
For each matrix I am trying to return a vector that indicates the column number with 1 for each rows.
Expected output:
[,1] [,2] [,3]
[1,] 1 3 1
[2,] 2 3 4
In its simplest form,
sapply(ex.list, max.col)
# [,1] [,2]
# [1,] 1 2
# [2,] 3 3
# [3,] 1 4
You can transpose it to get the dimensions you seek.
Another version is using Vectorize over max.col
> Vectorize(max.col)(ex.list)
[,1] [,2]
[1,] 1 2
[2,] 3 3
[3,] 1 4
I have a matrix that contains all the info necessary to construct 5x5 adjacency matrices. Each row represents one matrix:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 1 1 1 0 1 0
[2,] 0 0 0 1 1 1 1 0 1 0
...
I want to create an adjacency matrix from the nth row of data. For the first row of have, the want matrix would look like this:
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 1 1 1
[2,] 1 0 1 1 1
[3,] 1 1 0 0 1
[4,] 1 1 0 0 0
[5,] 1 1 1 0 0
How do I get from have to want?
Here is an option using lower.tri and upper.tri
unlist(apply(mat, 1, function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
list(m)
}), recursive = F)
#[[1]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 1 1 1
#[2,] 1 0 1 1 0
#[3,] 1 1 0 1 1
#[4,] 1 1 0 0 0
#[5,] 1 1 1 0 0
#
#[[2]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 1 1
#[2,] 0 0 0 1 0
#[3,] 0 1 0 1 1
#[4,] 0 1 0 0 0
#[5,] 1 1 1 0 0
The unlist(..., recursive = F) part seems somewhat awkward but is necessary to prevent apply from simplifying the result and dropping dims. An alternative would be to use lapply on a data.frame instead of a matrix:
lapply(as.data.frame(t(mat)), function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
return(m)
})
giving the same result.
Sample data
mat <- as.matrix(read.table(text =
"1 1 1 1 1 1 1 0 1 0
0 0 0 1 1 1 1 0 1 0", header = F))
colnames(mat) <- NULL
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])