resolved #2

.travis.yml

@@ -20,7 +20,7 @@ r:
 before_install:
   - R -e "install.packages(c('devtools','roxygen2','testthat','knitr'))"
   - R -e "devtools::install_deps('./pkg')"
-  - R -e "devtools::document('./pkg')"
+  - R -e "pkgload::load_all('pkg'); devtools::document('./pkg')"
   - cd ./pkg
 
 r_packages:

pkg/NEWS

@@ -1,6 +1,10 @@
 version 0.1.3
-- bugfix in correct_typos (crashed in presence of certain inequality rules).
-
+- fix: 'correct_typos' crashed in presence of certain inequality rules
+- fix: 'impute_lr' gave faulty results when using 'var_group' validation 
+       rules (thanks to GH user smartie5)
+- fix: 'impute_lr' gave faulty results in cases where data contradicts rules 
+       (issue #2). Thanks to GH user smartie5
+
 
 version 0.1.2
 - bugfix in range-imputation (crashed when both upper and lower limit are -Inf)

pkg/R/linimpute.R

@@ -28,6 +28,9 @@ setGeneric("impute_lr", function(dat, x,...) standardGeneric("impute_lr"))
 #' @rdname impute_lr
 setMethod("impute_lr", c("data.frame","validator"), function(dat, x, ...){
   eps <- 1e-8 # TODO: need to integrate with validate::voptions
+
+  x <- do.call("validator", x$exprs(lin_eq_eps=0, lin_ineq_eps=0))
+
   lc <- x$linear_coefficients()
   ops <- lc$operators
   lc <- lintools::normalize(lc$A,lc$b,lc$operators)
@@ -201,7 +204,7 @@ impute_range_x <- function(x,A,b,neq, nleq,eps=1e-8){
   if (all(obs)) return(x)
   L <- lintools::subst_value(A=A,b=b,variables=obs, values=x[obs])
   R <- lintools::ranges(A=L$A,b=L$b,neq=neq,nleq=nleq,eps=eps)
-  i <- R[ ,"upper"] - R[ ,"lower"] < eps
+  i <- (R[ ,"upper"] - R[ ,"lower"] < eps) & ( R[,"lower"] <= R[,"upper"] )
   i[!is.finite(i)] <- FALSE
   x[i] <- R[i,"upper"]
   x

pkg/tests/testthat/test_linimpute.R

@@ -183,6 +183,16 @@ test_that("imputation by range determination",{
 
 })
 
+test_that("works with var_group",{
+  rules <- validator(var_group(a,b,c,d) >= 0, a+b+c == d)
+  d <- data.frame(a=NA, b=NA, c=5,d=5)
+  expect_equal(impute_lr(d,rules), data.frame(a=0,b=0,c=5,d=5))
+})
 
+test_that("works with ill-defined problem",{
+  rules <- validator(var_group(a,b,c,d)>=0, a+b+c==d)
+  d <- data.frame(a=NA_real_, b=NA_real_, c=10., d=9.)
+  expect_equal(impute_lr(d,rules), d)
+})