Fix Issue 201

pkg/R/syntax.R

@@ -167,6 +167,7 @@ NULL
   condition  <- do.call(paste, c(mget(Lvars, parent.frame()), sep="|"))
   consequent <- do.call(paste0, c(mget(Rvars, parent.frame()), sep="|"))
   cf <- .Call("R_fdcheck", condition, consequent)
+
   cf == seq_along(cf)
 }
 

pkg/inst/tinytest/test_gh_issue_201.R

@@ -0,0 +1,6 @@
+d <- data.frame(a = c(1, 1), b  = c(1, 2))
+val <- validator(a ~ b)
+out <- confront(d, val)
+expect_equal(nrow(violating(d, out)), 2)
+
+

pkg/inst/tinytest/test_poc.R

@@ -147,7 +147,7 @@
   dat <- read.csv("pocdata/Rule_15.csv")
   expect_equivalent(
     values(confront(dat,v))
-   ,   matrix(c(TRUE,TRUE,TRUE,FALSE,TRUE),nrow=5)
+   ,   matrix(c(TRUE,TRUE,FALSE,FALSE,TRUE),nrow=5)
    )
 
 

pkg/inst/tinytest/test_syntax.R

@@ -36,7 +36,7 @@
     ,postcode = c('2495','2496','8888','2495')
   )
   cf <- confront(dat,v1)
-  expect_equivalent(values(cf),array(c(TRUE,FALSE,TRUE,TRUE),dim=c(4,1)))
+  expect_equivalent(values(cf),array(c(FALSE,FALSE,TRUE,FALSE),dim=c(4,1)))
 
 
 ## group_expansion ----

pkg/src/R_fdep.c

@@ -25,7 +25,7 @@
 /* 
  * Check functional dependencies x -> y
  *
- * The FD x -> y is two be interpreted as if two
+ * The FD x -> y is to be interpreted as if two
  * elements of x have the same value, they shall have the
  * same value for y. In the comments below we refer to 'x' 
  * as the condition and to 'y' as the consequent.
@@ -35,7 +35,7 @@
  * 
  * If all pairs in (x,y) obey x->y then the output is seq_along(x).
  * suppose that for some i < j we have x[i] == x[j] but y[i] != y[j].
- * The j'th value of the output is then equal to i. 
+ * The i'th and j'th value of the output is then equal to 0. 
  *
  */
 
@@ -79,11 +79,14 @@ SEXP R_fdcheck(SEXP x, SEXP y){
         a = SuperFastHash((const char *) &a, 4); 
         goto rehash;
       }
-      if (H[j] == b && strcmp( CHAR(STRING_ELT(y,E[j])), CHAR(STRING_ELT(y,i)) ) == 0 ){ 
+      if (INTEGER(out)[E[j]] == 0){
+        (*I) = 0;
+      } else if (H[j] == b && strcmp( CHAR(STRING_ELT(y,E[j])), CHAR(STRING_ELT(y,i)) ) == 0 ){ 
         // conseqent also similar, all good.
         (*I) = i + 1;
       } else { // consequent different, store conflicting index.
-       (*I) = E[j] + 1;
+       (*I) = 0;
+       INTEGER(out)[E[j]] = 0;
       }
     }
   }