fixed issue #19

R/categorical.R

@@ -13,12 +13,14 @@ is_cat_ <- function(expr, or=TRUE, ...){
   }
 
   op = op_to_s(expr)
+
   l <- left(expr)
   r <- right(expr)
 
   switch (op,
     "%in%" = TRUE,  # allow all literals (should check for character and logical)
     "%vin%" = TRUE, # Added to comply with validate >= 0.2.2
+    "var_group" = TRUE, # added for var_group expansion
     "("    = is_cat_(l, or),
     "!"    = is_cat_(l, !or),
     "=="   = is.character(r) || is.logical(r),

R/errorlocalizer.R

@@ -71,7 +71,9 @@ fh_localizer <-
         rows <- seq_len(nrow(data))
 
         # TODO add suggestions, status and progress bar
-        i <- 0
+        if (interactive()) {
+          pb <- utils::txtProgressBar(min = 0, max=nrow(data))
+        }
         res <- sapply(rows, function(r){
           # cat(".")
           values <- data[r,,drop=FALSE]
@@ -80,9 +82,13 @@ fh_localizer <-
           adapt <- el$adapt
           rm(el)
           gc()
+          if (interactive()){
+            value <- 1 + pb$getVal()
+            utils::setTxtProgressBar(pb, value)
+          }
           adapt
         })
-
+        if(interactive()){ close(pb) }
         dim(res) <- dim(weight)[2:1]
         adapt <- t(res)
         colnames(adapt) <- colnames(weight)

R/linear.R

@@ -38,7 +38,7 @@ is_lin_ <- function(expr, top=TRUE, ...){
     return(is.numeric(expr) || is.null(expr))
   }
 
-  if (is.symbol(expr)){ return(TRUE) }
+  if (is.symbol(expr) || op == "var_group"){ return(TRUE) }
 
   if (op %in% c("+","-")){
       return( is_lin_(l, FALSE) && is_lin_(r, FALSE))
@@ -97,7 +97,7 @@ lin_mip_rule_ <- function(e, sign=1, name, ...){
       l <- eval(l) # to deal with negative coefficients
     }
     if (is.numeric(l)){ return(lin_mip_rule_(r, sign*l)) }
-    
+
     if (is.numeric(left(r))){
       r <- eval(r) # to deal with negative coefficients
     }

issues/issue19.R

@@ -0,0 +1,12 @@
+library(errorlocate)
+library(validate)
+
+df <- data.frame(a=-1, b=0)
+rules <- validator(var_group(a,b)>=0)
+rules
+
+# not expanding var_group
+replace_errors(df, rules)
+
+rules <- validator(G := var_group(a,b), G >=0)
+replace_errors(df, rules)

tests/testthat/test-categorical.R

@@ -10,6 +10,11 @@ describe("categorical", {
                   )
     expect_equal(is_categorical(v), c(TRUE, TRUE, FALSE, FALSE))
   })
+  it("can detect var_group categorical rules",{
+    v <- validator(var_group(a,b) >= 0, if (var_group(a,b) == "a") c == TRUE)
+    expect_equal(is_categorical(v), c(FALSE, TRUE))
+  })
+
   it("can derive coefficients",{
     v <- validator( a %in% c("a1", "a2"),
                     if (a %in% 'a1') b == "b1"

tests/testthat/test-conditional.R

@@ -30,6 +30,14 @@ describe("conditional", {
     expect_equal( is_conditional(v)
                 , c(TRUE, TRUE, FALSE, FALSE, FALSE))
   })
+  it("can detect var_group conditional rules",{
+    v <- validator( var_group(a,b) >= 0
+                  , if (var_group(a,b) == "a") c == TRUE
+                  , if (var_group(a,b) > 1) c == TRUE
+                  )
+   expect_equal(is_conditional(v), c(FALSE, FALSE, TRUE))
+  })
+
   it("can detect more complex rules", {
     v <- validator( if ( x > 1 && z >= 1) y == 1,
                     if (x > 1) y == 1 || z <= 1,

tests/testthat/test-linear.R

@@ -16,6 +16,10 @@ describe("is_linear",{
     v <- validator(x > 1, y + 2*x <= 3, A == "a", A == TRUE)
     expect_equal(is_linear(v), c(TRUE, TRUE, FALSE, FALSE))
   })
+  it("can detect var_group linear rules",{
+    v <- validator(var_group(a,b) >= 0, if (var_group(a,b) == "a") c == TRUE)
+    expect_equal(is_linear(v), c(TRUE, FALSE))
+  })
 })
 
 describe("lin_mip_rule",{

tests/testthat/test-localize-errors.R

@@ -156,5 +156,12 @@ describe("Solve editrules checks",{
       x = rules
     )
     expect_equal(sum(le$errors), 1)
+
+  })
+  it("works for var_group rules",{
+    rules <- validator(var_group(a,b) >= 0)
+    data <- data.frame(a = -1, b = 1)
+    le <- locate_errors(data, rules)
+    expect_equal(sum(le$errors), 1)
   })
 })