Check if matrix in a matrix - r

I have a matrix
new<-matrix(9,4,4)
new[1,1]<-0
new[2,1]<-0
m1<-matrix(0,2,1)
m2<-matrix(0,1,2)
the matrices thus looks like this:
m1:
0
0
m2:
0 0
new:
0 9 9 9
0 9 9 9
9 9 9 9
9 9 9 9
I now want to check if this matrix contains the matrices m1 or m2.
So I did
m1 %in% new
m2 %in% new
and obtain TRUE TRUE for both
but would like to get TRUE for m1 and FALSE for m2

As your example matrix m1 and m2 can be converted to vectors you can use my previous answer at Check if vector in a matrix.
library(zoo)
any(apply(new, 2, rollapply, length(m1), identical, c(m1)))
#[1] TRUE
any(apply(new, 1, rollapply, length(m2), identical, c(m2)))
#[1] FALSE

A vectorised solution can be to use which with argument of arr.ind = TRUE and play with the rows of the matrix. i.e.
i_new <- which(new == 0, arr.ind = TRUE)[,1]
i_m1 <- which(m1 == 0, arr.ind = TRUE)[,1]
i_m2 <- which(m2 == 0, arr.ind = TRUE)[,1]
Reduce(`-`, i_new) == Reduce(`-`, i_m1)
#[1] TRUE
Reduce(`-`, i_new) == Reduce(`-`, i_m2)
#[1] FALSE
To see how and why this works you simply need to investigate the i_*, i.e.
which(m1 == 0, arr.ind = TRUE)
row col
[1,] 1 1
[2,] 2 1
which(m2 == 0, arr.ind = TRUE)
row col
[1,] 1 1
[2,] 1 2
which(new == 0, arr.ind = TRUE)
row col
[1,] 1 1
[2,] 2 1

You could wrap rle in a function that *applyes it on rows and columns.
vecCheck <- function(mat, v, n) {
l <- unlist(lapply(1:2, function(x) apply(mat, x, rle)), recursive=F)
any(unlist(sapply(l, function(x) x$lengths[x$values == v] == n)))
}
new <- matrix(9, 4, 4)
vecCheck(new, 0, 2)
# [1] FALSE
new[1:2, 1 ] <- 0
vecCheck(new, 0, 2)
# [1] TRUE

Related

Calculating 4 or n Sum in R

I am trying to practice LeetCode problems for Data Scientist interviews in R and One of the question I came across is foursum. To solve this, I am trying to generate all the different four combinations and calculating the sum using apply function. Is there a better way to optimize it in R without using combn?
GetFourSumCombinations <- function(TestVector,Target){
CombinationPairs = combn(TestVector, 4) ## Get all the combinations
SumOfAllCombinations = apply(CombinationPairs, 2, sum)
TargetElements = which(SumOfAllCombinations == Target)
return(CombinationPairs[,TargetElements])
}
## OutPut:
TestVector = c(1, 0, -1, 0, -2, 2), Target = 0
GetFourSumCombinations(TestVector,0)
[,1] [,2] [,3]
[1,] 1 1 0
[2,] 0 -1 0
[3,] -1 -2 -2
[4,] 0 2 2
Here is a bit shorter version
GetFourSumCombinations <- function(TestVector,Target){
vals <- combn(TestVector, 4)
vals[, colSums(vals) == Target]
}
GetFourSumCombinations(TestVector, Target)
# [,1] [,2] [,3]
#[1,] 1 1 0
#[2,] 0 -1 0
#[3,] -1 -2 -2
#[4,] 0 2 2
data
TestVector <- c(1, 0, -1, 0, -2, 2)
Target = 0
Run combn , convert that to a data.frame and then Filter out the desired columns. This has a one-line body and no subscripting.
target4 <- function(x, target = 0) {
Filter(function(x) sum(x) == target, as.data.frame(combn(x, 4)))
}
TestVector <- c(1, 0, -1, 0, -2, 2)
target4(TestVector)
giving:
V1 V9 V14
1 1 1 0
2 0 -1 0
3 -1 -2 -2
4 0 2 2
2) Longer but does not use combn.
target4a <- function(x, target = 0) {
g <- do.call("expand.grid", rep(list(seq_along(x)), 4))
ok <- apply(g, 1, function(x) all(diff(x) > 0))
g2 <- apply(g[ok, ], 1, function(ix) x[ix])
g2[, colSums(g2) == target]
}
target4a(TestVector)
3) or perhaps break up (2) into a custom combn and (1).
combn4 <- function(x) {
g <- do.call("expand.grid", rep(list(seq_along(x)), 4))
ok <- apply(g, 1, function(x) all(diff(x) > 0))
apply(g[ok, ], 1, function(ix) x[ix])
}
target4b <- function(x, target = 0) {
Filter(function(x) sum(x) == target, as.data.frame(combn4(x)))
}
target4b(TestVector)

How to divide a matrix by the sum of rows and it has zeros

I am pretty new to R and I have a loop which gives sometimes a matrix like this:
1 2
FALSE 0 0
TRUE 0 2
I need to do as follows:
If the two cells in a single row have zeros replace them by 0.5
If one of the cells is not zero divide by the sum of the row
so the result of this will be:
1 2
FALSE 0.5 0.5
TRUE 0 1
Any idea please?
Thank you
If your matrix is x,
(x <- matrix(c(0, 0, 0, 2), 2))
# [,1] [,2]
# [1,] 0 0
# [2,] 0 2
zero_rows <- as.logical(rowSums(x != 0))
x[zero_rows,] <- x[zero_rows,]/sum(x[zero_rows,])
x[rowSums(x) == 0, ] <- rep(0.5, ncol(x))
x
# [,1] [,2]
# [1,] 0.5 0.5
# [2,] 0.0 1.0
This will work for a matrix (2 dimensional array) of arbitrary size
#akrun's suggested edit, constructing zero_rows with rowSums(x != 0) instead of apply(x, 1, function(r) 0 %in% r) should make this even more efficient.
Let x <- matrix(c(0, 0, 0, 2), 2))
t(apply(x,1,function(y)if(all(!y))replace(y,!y,0.5)else if(any(!y))y/sum(y) else y))
[,1] [,2]
[1,] 0.5 0.5
[2,] 0.0 1.0
x = matrix(c(0, 0, 0, 2), 2)
t(apply(x, 1L, function(y) ifelse(all(y == 0), return(rep(0.5, length(y))), return(y/sum(y)))))
# [,1] [,2]
#[1,] 0.5 0.5
#[2,] 0.0 1.0

In R how to remove all columns of a matrix that contain a negative number?

I want to remove those columns from a matrix M that contain at least one negative number. For example, if
M = (1 0 0 1)
(1 -1 0 2)
(2 3 4 -3)
I want M to become
M = (1 0)
(1 0)
(2 4)
How to type M <- removeNegativeColumns(M) code?
Simple way could be using sum for column for condition where value < 0 (-ve).
# Data
M <- matrix(c(1,0,0,1,1, -1, 0, 2,2, 3, 4, -3), ncol = 4, byrow = T)
M[, !colSums(M < 0 )]
# [,1] [,2]
#[1,] 1 0
#[2,] 1 0
#[3,] 2 4
M <- matrix(c(1,0,0,1,1, -1, 0, 2,2, 3, 4, -3), ncol = 4, byrow = T)
M1<- apply(M, 2,function(i)
{
p<- any(i <0)==FALSE #(any(as.vector(i)) < 0)
p
})
M<- M[,M1]
removeNegativeColumns <- function(M) M[,apply(M>=0,2,all)]
removeNegativeColumns(M)
# [,1] [,2]
# [1,] 1 0
# [2,] 1 0
# [3,] 2 4
Check whether the minimum of each row is less than zero, then use that to filter your matrix:
filter <- apply(M, 2, function (x) min(x) < 0)
M <- M[,!filter]
Edit:
As per Moody_Mudskipper this is a similar but superior (and correct) method:
filter <- apply(data, 2, function (x) any(x < 0))
data <- data[,!filter]

Write a value for maximum/minimum between two values

I have a two-column matrix and I want to produce a new matrix/data.frame where Col N has 1 if is maximum, 0 otherwise (they are never equal). This is my attempt:
testM <- matrix(c(1,2,3, 1,1,5), ncol = 2, byrow = T)
>testM
V1 V2
1 1 2
2 3 1
3 1 5
apply(data.frame(testM), 1, function(row) ifelse(max(row[1],row[2]),1,0))
I expect to have:
0 1
1 0
0 1
because of the 0,1 parameters in max() function, but I just get
[1] 1 1 1
Any ideas?
Or using pmax
testM <- matrix(c(1,2,3, 1,1,5), ncol = 2, byrow = T)
--(testM==pmax(testM[,1],testM[,2]))
V1 V2
[1,] 0 1
[2,] 1 0
[3,] 0 1
You can perform arithmetic on Booleans in R! Just check if an element in each row is equal to it's max value and multiply by 1.
t(apply(testM, 1, function(row) 1*(row == max(row))))
You can use max.col and col to produce a logical matrix:
res <- col(testM) == max.col(testM)
res
[,1] [,2]
[1,] FALSE TRUE
[2,] TRUE FALSE
[3,] FALSE TRUE
If you want it as 0/1, you can do:
res <- as.integer(col(testM) == max.col(testM)) # this removes the dimension
dim(res) <- dim(testM) # puts the dimension back
res
[,1] [,2]
[1,] 0 1
[2,] 1 0
[3,] 0 1

R: fast determine top k maximum value in a matrix

I would like to fast determine top k maximum values in a matrix, and then put those not the top k maximum value as zero, currently I work out the following solution. Can somebody improve these one, since when the matrix have many many rows, this one is not so fast?
thanks.
mat <- matrix(c(5, 1, 6, 4, 9, 1, 8, 9, 10), nrow = 3, byrow = TRUE)
sortedMat <- t(apply(mat, 1, function(x) sort(x, decreasing = TRUE, method = "quick")))
topK <- 2
sortedMat <- sortedMat[, 1:topK, drop = FALSE]
lmat <- mat
for (i in 1:nrow(mat)) {
lmat[i, ] <- mat[i, ] %in% sortedMat[i, ]
}
kMat <- mat * lmat
> mat
[,1] [,2] [,3]
[1,] 5 1 6
[2,] 4 9 1
[3,] 8 9 10
> kMat
[,1] [,2] [,3]
[1,] 5 0 6
[2,] 4 9 0
[3,] 0 9 10
In Rfast the command sort_mat sorts the columns of a matrix, colOrder does order for each column, colRanks gives ranks for each column and the colnth gives the nth value for each column. I believe at least one of them suit you.
You could use rank to speed this up. In case there are ties, you would have to decide on a method to break these (e.g. ties.method = "random").
kmat <- function(mat, k){
mat[t(apply(mat, 1, rank)) <= (ncol(mat)-k)] <- 0
mat
}
kmat(mat, 2)
## [,1] [,2] [,3]
## [1,] 5 0 6
## [2,] 4 9 0
## [3,] 0 9 10

Resources