updating documentation

Author: edwindj

R/contradicted.R

@@ -6,9 +6,10 @@
 #' @example ./examples/feasible.R
 #' @param x [validate::validator()] object with rules.
 #' @param rule_name `character` with the names of the rules that are causing infeasibility.
+#' @param verbose if `TRUE` prints the 
 #' @family feasibility
 #' @return `character` with conflicting rules.
-is_contradicted_by <- function(x, rule_name){
+is_contradicted_by <- function(x, rule_name, verbose = interactive()){
   rn <- rule_name %in% names(x)
 
   if (any(!rn)){
@@ -23,11 +24,21 @@ is_contradicted_by <- function(x, rule_name){
 
 
   res <- character()
-  contra <- detect_infeasible_rules(x, weight = weight)
+  contra <- detect_infeasible_rules(x, weight = weight, verbose = FALSE)
   while (length(contra) && !any(contra %in% names(weight))){
     res <- c(res, contra)
     weight[contra] <- N
-    contra <- detect_infeasible_rules(x, weight = weight)
+    contra <- detect_infeasible_rules(x, weight = weight, verbose = FALSE)
+  }
+  if (isTRUE(verbose) && length(res)){
+    v <- x[rule_name] |> to_exprs() |> lapply(deparse_all)
+    v_cont <- x[res] |> to_exprs() |> lapply(deparse_all)
+    message(
+      "Rule(s): \n",
+      paste0(" ", names(v), ": ", v, collapse = "\n"), 
+      "\ncontradicted by:\n",
+      paste0(" ", names(v_cont), ": ", v_cont, collapse = "\n")
+    )
   }
   res
 }

R/detect_contradicting_if_rules.R

@@ -13,7 +13,7 @@
 #' @family feasibility
 #' @example ./examples/detect_contradicting_if_rules.R
 #' @export
-detect_contradicting_if_rules <- function(x, ..., verbose = TRUE){
+detect_contradicting_if_rules <- function(x, ..., verbose = interactive()){
   res <- detect_if_clauses(x, ...)
   if (length(res) == 0){
     if (verbose){
@@ -79,7 +79,7 @@ check_condition <- function(cond_expr, x){
     return(NULL)
   }
   l <- list()
-  v1 <- is_contradicted_by(v, names(cond))
+  v1 <- is_contradicted_by(v, names(cond), verbose = FALSE)
   l[[cond_s]] <- v1
   l
 }

R/feasible.R

@@ -38,11 +38,12 @@ is_feasible <- function(x, ...){
 #' @export
 #' @param x [validate::validator()] object with the validation rules.
 #' @param ... passed to [detect_infeasible_rules()]
+#' @param verbose if `TRUE` print information to the console
 #' @family feasibility
 #' @example ./examples/feasible.R
 #' @return [validate::validator()] object with feasible rules.
-make_feasible <- function(x, ...){
-  dropping <- detect_infeasible_rules(x, ...) 
+make_feasible <- function(x, ..., verbose = interactive()){
+  dropping <- detect_infeasible_rules(x, ..., verbose = verbose) 
 
   if (length(dropping) == 0){
     message("No infeasibility found, returning original rule set")
@@ -65,8 +66,9 @@ make_feasible <- function(x, ...){
 #' weight `1`.
 #' @family feasibility
 #' @param ... not used
+#' @param verbose if `TRUE` it prints the infeasible rules that have been found.
 #' @return `character` with the names of the rules that are causing infeasibility.
-detect_infeasible_rules <- function(x, weight = numeric(), ...){
+detect_infeasible_rules <- function(x, weight = numeric(), ..., verbose = interactive()){
   # browser()
   if (!is_infeasible(x)){
     return(character())
@@ -145,6 +147,10 @@ detect_infeasible_rules <- function(x, weight = numeric(), ...){
     names(rules) <- sub("^\\.delta_", "", names(rules))
 
     dropping <- names(rules)[rules == 1]
+    if (isTRUE(verbose)){
+       v <- x[dropping] |> to_exprs() |> lapply(deparse_all)
+       message("Found: \n", paste0("  ", names(v), ": ", v, collapse = "\n"))
+    }
     dropping
   } else {
     stop("No solution found to make system feasible.", call. = FALSE)

R/implied_by.R

@@ -41,7 +41,7 @@ is_implied_by <- function(x, rule_name, ...){
   # names(weight) <- names(negated_rules)
   # detect_infeasible_rules(test_rules, weight)
 
-  is_contradicted_by(test_rules, names(negated_rules))
+  is_contradicted_by(test_rules, names(negated_rules), verbose = FALSE)
 }
 
 # rules <- x <- validator(r1 = x > 1, r2 = x > 2)

R/redundancy.R

@@ -8,23 +8,31 @@
 #' @example ./examples/redundancy.R
 #' @param x [validate::validator()] object with the validation rules.
 #' @param ... not used.
+#' @param verbose if `TRUE` print the redundant rule(s) to the console
 #' 
 #' @family redundancy
 #' 
 #' @export
-detect_redundancy <- function(x, ...){
+detect_redundancy <- function(x, ..., verbose=interactive()){
   x <- check_validator(x)
   can_be_checked <- is_linear(x) | is_categorical(x) | is_conditional(x)
   vals <- to_exprs(x)
   dnf_set <- lapply(vals[can_be_checked], as_dnf)
   are_redundant <- sapply(seq_along(dnf_set), function(i){
     is_redundant(dnf_set, i)
   })
-  idx <- which(can_be_checked)[are_redundant]
 
+  idx <- which(can_be_checked)[are_redundant]
   ret <- logical(length = length(vals))
   names(ret) <- names(vals)
   ret[idx] <- TRUE
+  if (isTRUE(verbose) && any(ret)){
+    v <- x[names(ret)[ret]] |> to_exprs() |>  lapply(deparse_all)
+    message(
+      "Redundant rule(s):\n",
+      paste0("  ", names(v), ": ", v, collapse = "\n")
+    )
+  }
   ret
 }
 
@@ -35,22 +43,32 @@ detect_redundancy <- function(x, ...){
 #' @example ./examples/redundancy.R
 #' @param x [validate::validator()] object with validation rules.
 #' @param ... not used
+#' @param verbose if `TRUE` print the remove rules to the console.
 #' 
 #' @family redundancy
 #' 
 #' @return simplified [validate::validator()] object, in which redundant rules are removed.
-remove_redundancy <- function(x, ...){
+remove_redundancy <- function(x, ..., verbose = interactive()){
   x <- check_validator(x)
 
   can_be_checked <- is_linear(x) | is_categorical(x) | is_conditional(x)
 
   vals <- to_exprs(x)
   dnf_set <- lapply(vals[can_be_checked], as_dnf)
+  red <- character()
   for (i in rev(seq_along(dnf_set))){  # remove later rules before older rules 
     if (is_redundant(dnf_set, i)){
+      red <- c(red, names(dnf_set)[i])
       dnf_set[[i]] <- list()
     }
   }
+  if (length(red) && isTRUE(verbose)){
+    v <- x[red] |> to_exprs() |> lapply(deparse_all) 
+    message(
+      "Removed redundant rule(s):\n",
+      paste0("  ", names(v), ": ", v, collapse = "\n")
+   )
+  }
   vals[can_be_checked] <- lapply(dnf_set, as.expression)
   vals <- unlist(vals) # this removes empty expressions
   do.call(validate::validator, vals)

R/simplify_rules.R

@@ -22,7 +22,7 @@ simplify_rules <- function(.x, .values = list(...), ...){
   .x <- substitute_values(.x, .values)
   .x <- simplify_fixed_variables(.x)
   .x <- simplify_conditional(.x)
-  .x <- remove_redundancy(.x)
+  .x <- remove_redundancy(.x, verbose=FALSE)
   .x
 }
 

README.Rmd

@@ -60,11 +60,11 @@ rules <- validator( rule1 = x > 0
                   )
 is_infeasible(rules)
 
-detect_infeasible_rules(rules)
-make_feasible(rules)
+detect_infeasible_rules(rules, verbose=TRUE)
+make_feasible(rules, verbose=TRUE)
 
 # find out the conflict with this rule
-is_contradicted_by(rules, "rule1")
+is_contradicted_by(rules, "rule1", verbose=TRUE)
 ```
 
 ### Finding contradicting if rules
@@ -154,15 +154,15 @@ rules <- validator( rule1 = age > 12
                   )
 
 # rule1 is superfluous
-remove_redundancy(rules)
+remove_redundancy(rules, verbose=TRUE)
 
 rules <- validator( rule1 = age > 12
                   , rule2 = age > 12
 )
 
 # standout: rule1 and rule2, first rule wins
-remove_redundancy(rules)
+remove_redundancy(rules, verbose=TRUE)
 
 # Note that detection signifies both rules!
-detect_redundancy(rules)
+detect_redundancy(rules, verbose=TRUE)
 ```

README.md

@@ -58,16 +58,24 @@ rules <- validator( rule1 = x > 0
 is_infeasible(rules)
 #> [1] TRUE
 
-detect_infeasible_rules(rules)
+detect_infeasible_rules(rules, verbose=TRUE)
+#> Found: 
+#>   rule1: x > 0
 #> [1] "rule1"
-make_feasible(rules)
+make_feasible(rules, verbose=TRUE)
+#> Found: 
+#>   rule1: x > 0
 #> Dropping rule(s): "rule1"
 #> Object of class 'validator' with 1 elements:
 #>  rule2: x < 0
 #> Rules are evaluated using locally defined options
 
 # find out the conflict with this rule
-is_contradicted_by(rules, "rule1")
+is_contradicted_by(rules, "rule1", verbose=TRUE)
+#> Rule(s): 
+#>  rule1: x > 0
+#> contradicted by:
+#>  rule2: x < 0
 #> [1] "rule2"
 ```
 
@@ -190,7 +198,9 @@ rules <- validator( rule1 = age > 12
                   )
 
 # rule1 is superfluous
-remove_redundancy(rules)
+remove_redundancy(rules, verbose=TRUE)
+#> Removed redundant rule(s):
+#>   rule1: age > 12
 #> Object of class 'validator' with 1 elements:
 #>  rule2: age > 18
 
@@ -199,12 +209,17 @@ rules <- validator( rule1 = age > 12
 )
 
 # standout: rule1 and rule2, first rule wins
-remove_redundancy(rules)
+remove_redundancy(rules, verbose=TRUE)
+#> Removed redundant rule(s):
+#>   rule2: age > 12
 #> Object of class 'validator' with 1 elements:
 #>  rule1: age > 12
 
 # Note that detection signifies both rules!
-detect_redundancy(rules)
+detect_redundancy(rules, verbose=TRUE)
+#> Redundant rule(s):
+#>   rule1: age > 12
+#>   rule2: age > 12
 #> rule1 rule2 
 #>  TRUE  TRUE
 ```

examples/detect_contradicting_if_rules.R

@@ -3,7 +3,7 @@ rules <- validator(
   if (nace == "a")  export == "n"
 )
 
-conflicts <- detect_contradicting_if_rules(rules)
+conflicts <- detect_contradicting_if_rules(rules, verbose=TRUE)
 
 print(conflicts)
 

examples/feasible.R

@@ -8,8 +8,8 @@ rules <- validator( rule1 = x > 0
 
 is_infeasible(rules)
 
-detect_infeasible_rules(rules)
-make_feasible(rules)
+detect_infeasible_rules(rules, verbose=TRUE)
+make_feasible(rules, verbose = TRUE)
 
 # find out the conflict with this rule
-is_contradicted_by(rules, "rule1")
+is_contradicted_by(rules, "rule1", verbose = TRUE)