From 84e8ed5b69ec7b06d20b03af5a43f0f543413276 Mon Sep 17 00:00:00 2001
From: Mark van der Loo <mark.vanderloo@gmail.com>
Date: Wed, 10 Apr 2019 14:55:27 +0200
Subject: [PATCH] resolved #2

---
 .travis.yml                         |  2 +-
 pkg/NEWS                            |  8 ++++++--
 pkg/R/linimpute.R                   |  5 ++++-
 pkg/tests/testthat/test_linimpute.R | 10 ++++++++++
 4 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index ec2c655..ca918c5 100644
--- a/.travis.yml
+++ b/.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:
diff --git a/pkg/NEWS b/pkg/NEWS
index 829b9b6..639c693 100644
--- a/pkg/NEWS
+++ b/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)
diff --git a/pkg/R/linimpute.R b/pkg/R/linimpute.R
index 27ad385..a0dbbfb 100644
--- a/pkg/R/linimpute.R
+++ b/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
diff --git a/pkg/tests/testthat/test_linimpute.R b/pkg/tests/testthat/test_linimpute.R
index 29654b6..e98c063 100644
--- a/pkg/tests/testthat/test_linimpute.R
+++ b/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)
+})