diff --git a/R/build.R b/R/build.R index 7b7c74d..36d094e 100644 --- a/R/build.R +++ b/R/build.R @@ -75,6 +75,10 @@ build.ardis <- function(x, layer=NULL, where=TRUE, ...) { # If the pre-build wasn't executed then execute it if (!'built_target' %in% ls(x)) { treatment_group_build(x) + } + + # If header N's haven't been supplied, then construct them + if (!"header_n" %in% ls(x)) { x <- build_header_n(x) } diff --git a/R/count.R b/R/count.R index afbc557..3f117be 100644 --- a/R/count.R +++ b/R/count.R @@ -402,15 +402,31 @@ process_count_denoms <- function(x) { ) %>% ungroup() - denoms_df_dist <- built_pop_data %>% - filter(!!denom_where) %>% - group_by(!!pop_treat_var) %>% - summarize( - distinct_n = n_distinct(!!!distinct_by, !!pop_treat_var) - ) %>% - ungroup() + # Use cached header N's if they're available + if (exists("cached_header_n")) { + denoms_df_dist <- header_n %>% + rename(distinct_n = n) + + # If there was a treatment variable remap provided, add it + if (!quo_is_null(header_treat_var)) { + by_join <- as_name(header_treat_var) + } + else { + by_join <- as_name(pop_treat_var) + } + } else { + # Calculate header N's from pop data if it wasn't available + denoms_df_dist <- built_pop_data %>% + filter(!!denom_where) %>% + group_by(!!pop_treat_var) %>% + summarize( + distinct_n = n_distinct(!!!distinct_by, !!pop_treat_var) + ) %>% + ungroup() + + by_join <- as_name(pop_treat_var) + } - by_join <- as_name(pop_treat_var) names(by_join) <- as_name(treat_var) denoms_df <- denoms_df_n %>% diff --git a/R/table_bindings.R b/R/table_bindings.R index db1d54e..6e595b4 100644 --- a/R/table_bindings.R +++ b/R/table_bindings.R @@ -19,7 +19,7 @@ #' @param table A \code{ardis} object #' #' @return For \code{ardis_header_n} the header_n binding of the -#' \code{ardis} object. For \code{ardis_header_n<-} and +#' \code{ardis} object. For \code{header_n<-} and #' \code{set_ardis_header_n} the modified object. #' #' @examples @@ -38,31 +38,32 @@ header_n <- function(table) { env_get(table, "header_n") } -#' @param x A \code{ardis} object -#' @param value A data.frame with columns with the treatment variable, column +#' @param table A \code{ardis} object +#' @param x A data.frame with columns with the treatment variable, column #' variabes, and a variable with counts named 'n'. #' #' @export #' @rdname header_n -`header_n<-` <- function(x, value) { - set_header_n(x, value) +`header_n<-` <- function(table, x) { + set_header_n(table, x) } -#' @param header_n A data.frame with columns with the treatment variable, column -#' variabes, and a variable with counts named 'n'. +#' @param header_treat_var The symbol name of the treatment variable in the header_n data frame. Provide unquoted #' #' @export #' @rdname header_n -set_header_n <- function(table, value) { - assert_that(is.data.frame(value), +set_header_n <- function(table, x, header_treat_var = NULL) { + header_treat_var <- enquo(header_treat_var) + + assert_that(is.data.frame(x), msg = "header_n argument must be numeric") - assert_that("n" %in% names(value)) + assert_that("n" %in% names(x)) - assert_that(is.numeric(value$n), + assert_that(is.numeric(x$n), msg = "header_n argument must be named") - env_bind(table, header_n = value) + env_bind(table, header_n = x, header_treat_var = header_treat_var, cached_header_n = TRUE) table } @@ -194,9 +195,13 @@ pop_treat_var <- function(table) { set_pop_treat_var <- function(table, pop_treat_var) { pop_treat_var <- enquo(pop_treat_var) - assert_that(class(quo_get_expr(pop_treat_var)) == "name", - as_name(quo_get_expr(pop_treat_var)) %in% names(table$pop_data), - msg = paste0("pop_treat_var passed to ardis is not a column of pop_data")) + if (!exists("cached_header_n", envir=table)) { + assert_that(class(quo_get_expr(pop_treat_var)) == "name", + as_name(quo_get_expr(pop_treat_var)) %in% names(table$pop_data), + msg = paste0("pop_treat_var passed to ardis is not a column of pop_data. ", + "Did you forget to use `set_pop_data()` or `set_header_n()` ", + "before calling `set_pop_treat_var()`?")) + } env_bind(table, pop_treat_var = pop_treat_var) diff --git a/man/header_n.Rd b/man/header_n.Rd index b49ee24..8eb444a 100644 --- a/man/header_n.Rd +++ b/man/header_n.Rd @@ -8,24 +8,21 @@ \usage{ header_n(table) -header_n(x) <- value +header_n(table, x) <- value -set_header_n(table, value) +set_header_n(table, x, header_treat_var = NULL) } \arguments{ \item{table}{A \code{ardis} object} -\item{x}{A \code{ardis} object} - -\item{value}{A data.frame with columns with the treatment variable, column +\item{x}{A data.frame with columns with the treatment variable, column variabes, and a variable with counts named 'n'.} -\item{header_n}{A data.frame with columns with the treatment variable, column -variabes, and a variable with counts named 'n'.} +\item{header_treat_var}{The symbol name of the treatment variable in the header_n data frame. Provide unquoted} } \value{ For \code{ardis_header_n} the header_n binding of the - \code{ardis} object. For \code{ardis_header_n<-} and + \code{ardis} object. For \code{header_n<-} and \code{set_ardis_header_n} the modified object. } \description{