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
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 have a distance matrix. For example :
d<-matrix(c(0,2,3,7,11,0,13,6,8,5,0,12,6,53,12,0), nrow = 4, ncol = 4)
d
[,1] [,2] [,3] [,4]
[1,] 0 11 8 6
[2,] 2 0 5 53
[3,] 3 13 0 12
[4,] 7 6 12 0
I want to create a neighbor matrix where distance is less than or equal to 5. In matrix nb, 1 indicates not a neighbor. However, they have no neighbor (excluding itself, for example, row 1 and row 4. I would like the one with the smallest distance to be their neighbor.
> nb=(d>=5)
> nb*1
[,1] [,2] [,3] [,4]
[1,] 0 1 1 1
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 1 1 0
Expected result
[,1] [,2] [,3] [,4]
[1,] 0 1 1 0
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 0 1 0
I have tried and I don't know how to get it efficiently without using loop. This is just an example, my actual data has over 9000 rows. Any suggestion would be helpful. Thank you so much!
I believe the following function does what you want.
fun <- function(Dist, n = 5){
nb <- (Dist > n)*1L
for(i in seq_len(nrow(nb))) {
tmp <- Dist[i, ]
tmp[tmp == 0] <- Inf
nb[i, which.min(tmp)] <- 0L
}
nb
}
fun(d)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 1 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 1 0 1 0
fun(d, 10)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 0 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 0 0 1 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(.)
I am trying to create random binary square matrices. However, there are some constraints. I would like the diagonal to = 0. Also, the upper and lower triangles need to be inverse transpositions of each other.
To be clear, what I am looking for would look the below for a random example 5 x 5 matrix. If you look at any row/column pair e.g. 3&5, 1&4, the upper and lower triangles for those pairs have opposite results.
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 1 0
[2,] 1 0 0 0 0
[3,] 1 1 0 1 0
[4,] 0 1 0 0 1
[5,] 1 1 1 0 0
I am running into some problems in making my random matrices asymmetric.
Here's what I have thus far for creating a random binary 12x12 matrix:
function1 <- function(m, n) {
matrix(sample(0:1, m * n, replace = TRUE), m, n)
}
A<-function1(12,12)
A #check the matrix
diag(A)<-0
My attempt at putting the transposed upper triangle into the lower triangle:
A[lower.tri(A)] <- t(A[upper.tri(A)])
A #rechecking the matrix - doesn't seem to do it.
I have tried some variations to see if I got my upper/lower triangles mixed up, but none seem to work.
Hope this question is understandable.
fun <- function(n){
vals <- sample(0:1, n*(n-1)/2, rep = T)
mat <- matrix(0, n, n)
mat[upper.tri(mat)] <- vals
mat[lower.tri(mat)] <- 1 - t(mat)[lower.tri(mat)]
mat
}
And testing it out...
> fun(5)
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 1 0 1
[2,] 1 0 1 0 1
[3,] 0 0 0 0 0
[4,] 1 1 1 0 1
[5,] 0 0 1 0 0
> out <- fun(5)
> out + t(out)
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 1 1 1
[2,] 1 0 1 1 1
[3,] 1 1 0 1 1
[4,] 1 1 1 0 1
[5,] 1 1 1 1 0