#' Detect redundant rules without removing.
#'
#' Detect redundancies in a rule set.
#'
#' @note For removal of duplicate rules, simplify
#' @example ./examples/redundancy.R
#' @param x \code{\link{validator}} object with the validation rules.
#' @param ... not used.
#'
#' @family redundancy
#'
#' @export
detect_redundancy <- function(x, ...){
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]
ret <- logical(length = length(vals))
names(ret) <- names(vals)
ret[idx] <- TRUE
ret
}
#' Remove redundant rules
#'
#' Simplify a rule set by removing redundant rules
#' @export
#' @example ./examples/redundancy.R
#' @param x \code{\link{validator}} object with validation rules.
#' @param ... not used
#'
#' @family redundancy
#'
#' @return simplified \code{\link{validator}} object, in which redundant rules are removed.
remove_redundancy <- function(x, ...){
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)
for (i in rev(seq_along(dnf_set))){ # remove later rules before older rules
if (is_redundant(dnf_set, i)){
dnf_set[[i]] <- list()
}
}
vals[can_be_checked] <- lapply(dnf_set, as.expression)
vals <- unlist(vals) # this removes empty expressions
do.call(validate::validator, vals)
}
# utility function for checking if rule i is redundant.
is_redundant <- function(dnf_set, i, ...){
dnf <- dnf_set[[i]]
negated_rules <- lapply(dnf, invert_or_negate)
# We allow the injection of multiple rules (a negation of a disjunction are multiple rules!)
dnf_set <- c(dnf_set[-i], negated_rules)
#names(dnf_set) <- make.unique(names(dnf_set))
exprs <- unlist(lapply(dnf_set, as.expression))
test_rules <- do.call(validate::validator, exprs)
# if (i == 2){
# for (n in ls()){
# cat(n, ': \n')
# print(get(n))
# }
# }
is_infeasible(test_rules)
}
# x <- validator( rule1 = x > 1
# , rule2 = x > 2
# )
# remove_redundancy(x)
# detect_redundancy(x)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.