R/test_rule.R

In idmn/dval:

#' Evaluate rule to a logical vector and list of variables used
#'
#' @param data A data frame
#' @param rule A statement which evaluates to a logical vector in terms of the data
#'
#' @return currently a list
#' @export
#'
#' @examples
#'
#' eval_rule(dm, AGE < 100)
#'
eval_rule <- function(data, rule){
    assertthat::assert_that(is.data.frame(data))
    .r <- lazyeval::lazy(rule)
    .r_text <- lazyeval::expr_text(rule)
    vars <- intersect(all.vars(.r$expr), names(data))
    group_vars <- as.character(dplyr::groups(data))
    # res should be logical assertthat
    ind <- dplyr::last(dplyr::transmute_(data, .r))
    assertthat::assert_that(is.logical(ind))
    structure(
        list(expression = .r_text,
             group_vars = group_vars,
             vars = vars,
             ind = ind,
             summary = summary_logical(ind)),
        class = c("rule_res")
    )
}

print.rule_res <- function(x){
    cat("Expression:\n")
    cat(x$expression)
    cat("\n\n")
    cat("Involved variables:\n")
    cat(x$vars)
    cat("\n\n")
    cat("Grouping by:\n")
    cat(x$group_vars)
    cat("\n\n")
    cat("Summary:\n")
    print.summary_logical(x$summary)
    cat("\n\n")
    cat("Results:\n")
    print(x$ind)
}

summary_logical <- function(x){
    assertthat::assert_that(is.logical(x))
    res <- structure(list(n = length(x), `TRUE` = 0, `FALSE` = 0, `NA` = 0), class = "summary_logical")
    tbl <- as.list(table(x))
    if ("TRUE" %in% names(tbl)) res$`TRUE` <- tbl$`TRUE`
    if ("FALSE" %in% names(tbl)) res$`FALSE` <- tbl$`FALSE`
    res$`NA` <- res$n - res$`TRUE` - res$`FALSE`
    res
}

print.summary_logical <- function(x){
    cat(paste0(x$n, ": ", x$`TRUE`, "[+], ", x$`FALSE`, "[-], ", x$`NA`, "[?]"))
}