Match all logic rules with a matrix and in the same order

Viewed 107

For example, I have a matrix like this

dat <- cbind(1:10,11:20,21:30)
colnames(dat) <- paste0("x",1:ncol(dat))
dat
      x1 x2 x3
 [1,]  1 11 21
 [2,]  2 12 22
 [3,]  3 13 23
 [4,]  4 14 24
 [5,]  5 15 25
 [6,]  6 16 26
 [7,]  7 17 27
 [8,]  8 18 28
 [9,]  9 19 29
[10,] 10 20 30

I also have a vector with logical rules, for example like this

pat <- c("x1>1 & x2>12","x3>25","x1<x3 & x3>28")
pat
[1] "x1>1 & x2>12"       "x3>25"         "x1<x3 & x3>28"

I need to check the matrix for the execution of the rules, and the rules should work in the same sequence in which they are specified in the vector. For a better understanding, I will draw enter image description here

As a result, I would like to get a function that takes two arguments, a matrix dat and a vector with rules pat, and returns true / false.

If anyone has a desire to help me with this, I will be very happy

UPD======================================

I do not always get the correct answer from the function f1, what could be the problem?

f1 <- function(pat, dat) {
  tmp <-  suppressWarnings(lapply(pat, function(x) 
    min(which( with(as.data.frame(dat), 
                    eval(parse(text = x)))))))
  tmp1 <- unlist(tmp)
  i1 <- any(sapply(tmp, is.infinite))
  if(i1) FALSE else identical(tmp1, sort(tmp1))
}

some fake data

set.seed(25641)
dat <- matrix(data = sample(10,20,replace = T),ncol = 3)
colnames(dat) <- paste0("x",1:ncol(dat))

pat <- c("x1>5","x2>x1","x3>1")

> dat
     x1 x2 x3
[1,]  4  4  7
[2,]  9  3  4
[3,]  7  9  5
[4,]  3  2 10
[5,] 10  7 10
[6,]  5  6  4
[7,]  9  9  4

According to the data, it can be seen that the function f1 should return TRUE, but it returns FALSE enter image description here

f1(pat = pat,dat = dat)
[1] FALSE
2 Answers

Here is a function that loops over the pattern, convert the matrix to data.frame, while evaluating the expression, if there are no TRUE values after evaluation return FALSE or else check if the unlist min index is the same as the sorted one

f1 <- function(pat, dat) {
   tmp <-  suppressWarnings(lapply(pat, function(x) 
       min(which( with(as.data.frame(dat), 
           eval(parse(text = x)))))))
   tmp1 <- unlist(tmp)
   i1 <- any(sapply(tmp, is.infinite))
   if(i1) FALSE else identical(tmp1, sort(tmp1))
 }
   
f1(pat, dat)
#[1] TRUE

For the updated

pat <- c("x1>1 & x2>12","x3>25","x1<x3 & x3>48")
f1(pat, dat)
#[1] FALSE

Note this will return FALSE if one or more of the conditions are not met

f <- function(dat, pat){
  list2env(as.list.data.frame(data.frame(dat)), environment())
  m <- do.call(cbind, lapply(pat, function(x) eval(parse(text = x))))
  ifelse(all(apply(m, 2, any)), Reduce("<", apply(m, 2, which.max)), F)
}

Output

pat <- c("x1>1 & x2>12","x3>25","x1<x3 & x3>28")

f(dat, pat)
[1] TRUE


pat <- c("x1<1 & x2>12","x3>25","x1<x3 & x3>28") # first condition not met

f(dat, pat) 
[1] FALSE
Related