fixing stuf

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: errorlocate
 Type: Package
 Title: Locate Errors with Validation Rules
-Version: 0.3.2
+Version: 0.3.3
 Authors@R: c(person("Edwin", "de Jonge", email = "edwindjonge@gmail.com", role = c("aut", "cre"), comment=c(ORCID="0000-0002-6580-4718")),
              person("Mark", "van der Loo", email = "mark.vanderloo@gmail.com", role = c("aut")))
 Description: Errors in data can be located and removed using validation rules from package 'validate'.

NEWS.md

@@ -1,7 +1,8 @@
-# errorlocate 0.3.2
+# errorlocate 0.3.3
 
 * Fixed issue #21, thanks to Sander Scholtus: strict equalities
 * Fixed issue #22, thanks to Sander Scholtus: missing columns in data.
+* Fixed issue #23, "<var> =="" FALSE in if clause was handled incorrectly.
 
 # errorlocate 0.3.0
 

R/MipRules.R

@@ -57,15 +57,14 @@ miprules <- setRefClass("MipRules",
          ._value_rules <<- list()
          return(invisible())
        }
+
        missing_vars <- ._vars[!._vars %in% names(values)]
        if (length(missing_vars)){
           stop("Missing variable(s): "
               , paste0("'", missing_vars, "'", collapse = ", ")
               , "."
               , call. = FALSE)
        }
-       #browser()
-       values <- as.list(values)
 
        if (missing(weights)){
          weights <- rep(1, length(values))
@@ -82,9 +81,11 @@ miprules <- setRefClass("MipRules",
      },
      execute = function(...){
        # TODO see if this can be executed in parallel.
+       #browser()
        lp <- translate_mip_lp(mip_rules(), objective, ...)
        #TODO set timer, duration etc.
        s <- solve(lp)
+       #browser()
        values <- lpSolveAPI::get.variables(lp)
        names(values) <- colnames(lp)
        adapt <- objective < 0 # trick to create logical with names

R/categorical.R

@@ -137,7 +137,7 @@ cat_mip_rule_ <- function(e, name, ...){
     vars <- bin_var_name(x)
     # if (x %in% set) +1, if (!(x %in% set)) -1
     #coef <- rep(if(x$not) -1L else 1L, length(vars))
-    coef <- rep(if(x$not || all(x$value == FALSE)) -1L else 1L, length(vars))
+    coef <- rep(if( xor(x$not, all(x$value == FALSE))) -1L else 1L, length(vars))
     names(coef) <- vars
     coef
   })
@@ -146,7 +146,7 @@ cat_mip_rule_ <- function(e, name, ...){
   # sum(a_pos) + sum(1-a_neg) >= 1
   # condition is that at least one of the variable is true, extract the negated memberships
   b <- 1 - sum(sapply(rule_l, function(x){
-    x$not || all(x$value == FALSE)
+    xor(x$not, all(x$value == FALSE))
   }))
 
   if ( length(rule_l) == 1){

R/errorlocalizer.R

@@ -101,10 +101,11 @@ fh_localizer <-
         }
         res <- sapply(rows, function(r){
           # cat(".")
-          values <- data[r,,drop=FALSE]
+          values <- as.list(data[r,,drop=FALSE])
           ._miprules$set_values(values, weight[r,])
           el <- ._miprules$execute(timeout=timeout, ...)
-          adapt <- el$adapt
+          adapt <- sapply(values, function(x){FALSE})
+          adapt[names(el$adapt)] <- el$adapt
           rm(el)
           gc()
           if (interactive()){
@@ -114,14 +115,13 @@ fh_localizer <-
           adapt
         })
         if(interactive()){ close(pb) }
-        dim(res) <- dim(weight)[2:1]
+        #dim(res) <- dim(weight)[2:1]
         adapt <- t(res)
-        colnames(adapt) <- colnames(weight)
 
-        weight_per_record <- as.numeric(tcrossprod(adapt, weight))
+        idx <- which(colnames(adapt) %in% colnames(weight))
+        weight_per_record <- as.numeric(tcrossprod(adapt[,idx], weight))
 
         is.na(adapt) <- is.na(data)
-        #browser()
         create_errorlocation(
           values = adapt,
           weight = weight_per_record

R/expr_manip.R

@@ -1,7 +1,7 @@
 negate_ <- function(e, ...){
-  # don't do double negation: that complicates analysis of expressions
   op <- node(e)
 
+  # don't do double negation: that complicates analysis of expressions
   if (op == '!'){
     return(consume(e[[2]]))
   }
@@ -10,7 +10,11 @@ negate_ <- function(e, ...){
     if (op == "!="){
       substitute( l == r, list(l = left(e), r = right(e)))
     } else if (op == "=="){
-      substitute( l != r, list(l = left(e), r = right(e)))
+      if (is.logical(right(e))){
+        substitute( l == r, list(l = left(e), r = !right(e)))
+      } else {
+        substitute( l != r, list(l = left(e), r = right(e)))
+      }
     }
     else {
       substitute( !(e), list(e=e) )

R/mip_lpsolve.R

@@ -25,7 +25,7 @@ translate_mip_lp <- function( rules
 
   # TODO improve!
   lpSolveAPI::lp.control( lps,
-                          presolve = "rows",
+                          #presolve = "rows",
                           epsint = 1e-15,
                           epspivot = 1e-15,
                           ...

tests/testthat/test-conditional.R

@@ -83,4 +83,22 @@ describe("cond_as_mip_rules",{
     expect_equal(mr[[3]]$rule, "V1._lin2")
     get_mr_matrix(mr)
   })
+
+  it("transforms a categorical rule",{
+    rules <- validator(A %in% c("a1", "a2"), if (A != "a1") x > 1)
+    mr <- to_miprules(rules)
+    expect_equal(mr[[2]]$a, c("A:a1" = -1, V2._lin1 = 1))
+    expect_equal(mr[[2]]$b, 0)
+    expect_equal(mr[[3]]$a, c(x = -1, V2._lin1 = -1e7))
+    expect_equal(mr[[3]]$b, -1)
+  })
+
+  it("transforms a logical rule", {
+    rules <- validator(if (a == FALSE) x > 1)
+    mr <- to_miprules(rules)
+    expect_equal(mr[[1]]$a, c(a = -1, V1._lin1 = 1))
+    expect_equal(mr[[1]]$b, 0)
+    expect_equal(mr[[2]]$a, c(x = -1, V1._lin1 = -1e7))
+    expect_equal(mr[[2]]$b, -1)
+  })
 })

tests/testthat/test-dnf.R

@@ -42,4 +42,21 @@ describe("as_dnf", {
     expect_equivalent(dnf, expression(x <=1, z <= 1, w <= 1, y < 0))
   })
 
+  it("works with logical if statement",{
+    dnf <- as_dnf(quote(if (A == TRUE) x > 0))
+    expect_equivalent(as.expression(dnf), expression(A == FALSE | x > 0))
+
+    dnf <- as_dnf(quote(if (A == FALSE) x > 0))
+    expect_equivalent(as.expression(dnf), expression(A == TRUE | x > 0))
+
+    dnf <- as_dnf(quote(if (A == FALSE & B == TRUE) x > 0))
+    expect_equivalent(as.expression(dnf), expression(A == TRUE | B == FALSE | x > 0))
+
+    dnf <- as_dnf(quote(if (A != FALSE) x > 0))
+    expect_equivalent(as.expression(dnf), expression(A == FALSE | x > 0))
+
+    dnf <- as_dnf(quote(if (A != TRUE) x > 0))
+    expect_equivalent(as.expression(dnf), expression(A == TRUE | x > 0))
+  })
+
 })