updating documentation

R/assoc_rule.R

@@ -91,6 +91,8 @@ write_cond_rule <- function(d, vars=names(d), file = stdout()){
 #' @importFrom utils combn
 #' @example example/conditional_rule.R
 #' @inheritParams suggest_type_check
+#' @returns `suggest_cond_rule` returns [validate::validator()] object with the suggested rules.
+#' `write_cond_rule` returns invisibly a named list of ranges for each variable.
 suggest_cond_rule <- function(d, vars = names(d)){
   tf <- tempfile()
   pairs <- write_cond_rule(d, vars = vars, file = tf)

R/domain_check.R

@@ -55,6 +55,8 @@ write_domain_check <- function(d, vars=names(d), only_positive=TRUE, file=stdout
 #' @inheritParams suggest_type_check
 #' @param only_positive if `TRUE` only numerical values for positive values are included
 #' @example example/range_check.R
+#' @returns `suggest_domain_check` returns [validate::validator()] object with the suggested rules.
+#' `write_domain_check` returns invisibly a named list of checks for each variable.
 suggest_domain_check <- function(d, vars = names(d), only_positive=TRUE){
   tf <- tempfile()
   vars <- write_domain_check(d, vars, file = tf)

R/na_check.R

@@ -30,6 +30,8 @@ write_na_check <- function(d, vars=names(d), file=stdout()){
 #' @export
 #' @example example/na_check.R
 #' @inheritParams suggest_type_check
+#' @returns `suggest_na_check` returns [validate::validator()] object with the suggested rules.
+#' `write_na_check` write the rules to file and returns invisibly a named list of ranges for each variable.
 suggest_na_check <- function(d, vars = names(d)){
   tf <- tempfile()
   vars <- write_na_check(d, vars = vars, file = tf)

R/pos_check.R

@@ -30,6 +30,8 @@ write_pos_check <- function(d, vars=names(d), only_positive=TRUE, file=stdout())
 #' @inheritParams suggest_type_check
 #' @param only_positive if `TRUE` only numerical values for positive values are included
 #' @example example/range_check.R
+#' @returns `suggest_pos_check` returns [validate::validator()] object with the suggested rules.
+#' `write_pos_check` write the rules to file and returns invisibly a named list of checks for each variable.
 suggest_pos_check <- function(d, vars = names(d), only_positive=TRUE){
   tf <- tempfile()
   vars <- write_pos_check(d, vars, file = tf, only_positive = only_positive)

R/range_check.R

@@ -71,6 +71,8 @@ write_range_check <- function(d, vars=names(d), min=TRUE, max=FALSE, file=stdout
 #' @example example/range_check.R
 #' @param min `TRUE` or `FALSE`, should the minimum value be checked?
 #' @param max `TRUE` or `FALSE`, should the maximum value be checked?
+#' @returns `suggest_range_check` returns [validate::validator()] object with the suggested rules.
+#' `write_range_check` write the rules to file and returns invisibly a named list of ranges for each variable.
 suggest_range_check <- function(d, vars = names(d), min=TRUE, max=FALSE){
   tf <- tempfile()
   vars <- write_range_check(d, vars, min=min, max=max, file = tf)

R/ratio_check.R

@@ -49,6 +49,8 @@ ratio_check <- function(d, var1, var2, digits = 2){
 #' @inheritParams suggest_type_check
 #' @param lin_cor threshold for abs correlation to be included (details)
 #' @param digits number of digits for rounding
+#' @returns `suggest_ratio_check` returns [validate::validator()] object with the suggested rules.
+#' `write_ratio_check` write the rules to file and returns invisibly a named list of check for each variable.
 suggest_ratio_check <- function(d, vars = names(d), lin_cor=0.95, digits=2){
   tf <- tempfile()
   pairs <- write_ratio_check(d, vars, lin_cor = lin_cor, file = tf, digits = digits)

R/rpart.R

@@ -0,0 +1,52 @@
+#' @importFrom rpart rpart
+get_tree <- function(d){
+  m <- rpart(car_color ~ ., data = d)
+  node <- as.numeric(row.names(m$frame))
+  lab <- labels(m)
+  parent_node <- get_parents(node)
+}
+
+get_parents <- function(node){
+  l <- lapply(node[-1], function(n){
+    floor(n * cumprod(rep(0.5, log2(n) - 1)))
+  })
+}
+
+SPLIT <- "[<>=]=? ?(.+)"
+LEVS <- ".+=([a-z]+)$"
+LOGICAL <- "(.+)(<)"
+
+get_q <- function(m, d){
+  split_lab <- labels(m)
+  vars <- labels(m$terms)
+  split_vars <- sub(SPLIT, "", split_lab)
+  #TODO fix logical, factor and character
+  types <- attr(m$terms, "dataClasses")[split_vars]
+  expr <- vector(mode="expression", length = length(split_lab))
+
+  is_numeric <- which(types == "numeric")
+  expr[is_numeric] <- sapply(split_lab[is_numeric], str2lang)
+
+  is_character <- which(types == "character")
+  expr[is_character] <- sapply(split_lab[is_character], function(e){
+    let <- sub(LEVS, "\\1", e)
+    v <- sub(SPLIT, "", e)
+    f <- factor(d[[v]])
+    idx <- match(strsplit(let, "")[[1]], letters)
+    levs <- levels(f)[idx]
+    substitute(v %in% levs, list(v = as.symbol(v), levs=levs))
+  })
+
+  is_logical <- which(types == "logical")
+  expr[is_logical] <- sapply(split_lab[is_logical], function(e){
+    let <- sub(LEVS, "\\1", e)
+    v <- sub(SPLIT, "", e)
+    f <- factor(d[[v]])
+    idx <- match(strsplit(let, "")[[1]], letters)
+    levs <- levels(f)[idx]
+    substitute(v %in% levs, list(v = as.symbol(v), levs=levs))
+  })
+
+  expr
+}
+

R/suggest_rules.R

@@ -12,6 +12,8 @@
 #' @param unique_check if `TRUE` include unique_check
 #' @param conditional_rule if `TRUE` include cond_rule
 #' @export
+#' @returns returns [validate::validator()] object with the suggested rules.
+#' `write_all_suggestions` write the rules to file and returns invisibly a named list of ranges for each variable.
 suggest_rules <- function( d
                          , vars = names(d)
                          , domain_check = TRUE

R/type_check.R

@@ -24,6 +24,8 @@ write_type_check <- function(d, vars=names(d), file=stdout()){
 #' @export
 #' @param d `data.frame`, used to generate the checks
 #' @param vars `character` optionally the subset of variables to be used.
+#' @returns `suggest_type_check` returns [validate::validator()] object with the suggested rules.
+#' `write_type_check` write the rules to file and returns invisibly a named list of types for each variable.
 suggest_type_check <- function(d, vars = names(d)){
   tf <- tempfile()
   vars <- write_type_check(d, vars = vars, file = tf)

R/unique_check.R

@@ -31,6 +31,8 @@ write_unique_check <- function(d, vars=names(d), file=stdout(), fraction=0.95){
 #' @inheritParams suggest_type_check
 #' @param fraction if values in a column > `fraction` unique,
 #' the check will be generated.
+#' @returns `suggest_unique_check` returns [validate::validator()] object with the suggested rules.
+#' `write_unique_check` write the rules to file and returns invisibly a named list of checks for each variable.
 suggest_unique_check <- function(d, vars = names(d), fraction=0.95){
   tf <- tempfile()
   vars <- write_unique_check(d, vars, fraction=0.95, file = tf)

example/demo.R

@@ -0,0 +1,17 @@
+library(validatesuggest)
+
+data(retailers, package="validate")
+summary(retailers)
+
+suggest_type_check(retailers)
+
+suggest_domain_check(retailers)
+
+suggest_na_check(retailers)
+
+suggest_pos_check(retailers)
+
+suggest_all(retailers)
+
+
+