diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 00000000..2c5bb502 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,50 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: test-coverage + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr + needs: coverage + + - name: Test coverage + run: | + covr::codecov( + quiet = FALSE, + clean = FALSE, + install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") + ) + shell: Rscript {0} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v3 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/DESCRIPTION b/DESCRIPTION index f04e9c5b..0e7ccb87 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,7 @@ Imports: tidyselect (>= 1.1.0), tibble (>= 3.0.1), lifecycle, - forcats (>= 0.4.0) + forcats (>= 1.0.0) Suggests: testthat (>= 2.1.0), haven (>= 2.2.0), diff --git a/NAMESPACE b/NAMESPACE index 16e6a319..5411b68d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -135,6 +135,7 @@ importFrom(dplyr,between) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) +importFrom(dplyr,cur_column) importFrom(dplyr,cur_group) importFrom(dplyr,distinct) importFrom(dplyr,do) @@ -146,6 +147,7 @@ importFrom(dplyr,group_keys) importFrom(dplyr,if_else) importFrom(dplyr,lag) importFrom(dplyr,left_join) +importFrom(dplyr,matches) importFrom(dplyr,mutate) importFrom(dplyr,mutate_all) importFrom(dplyr,mutate_at) @@ -164,7 +166,7 @@ importFrom(dplyr,vars) importFrom(forcats,fct_collapse) importFrom(forcats,fct_drop) importFrom(forcats,fct_expand) -importFrom(forcats,fct_explicit_na) +importFrom(forcats,fct_na_value_to_level) importFrom(lifecycle,deprecate_soft) importFrom(lifecycle,deprecate_stop) importFrom(magrittr,"%>%") @@ -257,6 +259,7 @@ importFrom(tibble,add_column) importFrom(tibble,rownames_to_column) importFrom(tibble,tibble) importFrom(tidyr,complete) +importFrom(tidyr,fill) importFrom(tidyr,nesting) importFrom(tidyr,pivot_longer) importFrom(tidyr,pivot_wider) diff --git a/R/call_standardise.R b/R/call_standardise.R new file mode 100644 index 00000000..47af4eb4 --- /dev/null +++ b/R/call_standardise.R @@ -0,0 +1,56 @@ +# # MIT License +# +# Copyright (c) 2020 rlang authors +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in all +# copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +# SOFTWARE. + +#' rlang deprecated call_standardise, but this is necessary for +#' the `modify_nested_call()` function. The capability isn't +#' matched by the `call_match()` function. +#' +#' In modify nested call, this is used to restructure the function call +#' to have all named arguments. Since all the functions called inside +#' `call_standardise()` are exported and currently stable within rlang, +#' I'm porting the function here. +#' +#' @param call +#' +#' @return call +#' @noRd +tplyr_call_standardise <- function(call, env= rlang::caller_env()) { + + expr <- rlang::get_expr(call) + + if (!rlang::is_call(expr)) { + stop("call_standardise error") + } + + # The call name might be a literal, not necessarily a symbol + env <- rlang::get_env(call, env) + fn <- rlang::eval_bare(rlang::node_car(expr), env) + + if (rlang::is_primitive(fn)) { + call + } else { + matched <- match.call(fn, expr) + rlang::set_expr(call, matched) + } + +} + diff --git a/R/count.R b/R/count.R index fb00efcc..030db51d 100644 --- a/R/count.R +++ b/R/count.R @@ -48,7 +48,7 @@ process_summaries.count_layer <- function(x, ...) { ## Drop levels if target var is factor and kept levels used if (eval_tidy(keep_levels_logic) && - is.factor(built_target[[as_name(tail(target_var, 1)[[1]])]])) { + is.factor(built_target[[as_name(tail(target_var, 1)[[1]])]])) { # Pull out the levels that weren't in keep levels. target_levels <- levels(built_target[[as_name(tail(target_var, 1)[[1]])]]) drop_levels_ind <- !(target_levels %in% levels_to_keep) @@ -72,7 +72,7 @@ process_summaries.count_layer <- function(x, ...) { } if (length(target_var) == 2 && !quo_is_symbol(target_var[[2]]) && - as_name(target_var[[2]]) %in% names(target)) { + as_name(target_var[[2]]) %in% names(target)) { warning(paste0("The second target variable has been coerced into a symbol.", "You should pass variable names unquoted."), immediate. = TRUE) @@ -139,27 +139,58 @@ process_single_count_target <- function(x) { # Used to temporarily check formats if (is.null(format_strings)) tmp_fmt <- gather_defaults.count_layer(current_env()) if (count_missings && !(is.null(denom_ignore) || length(denom_ignore) == 0) && - (("pct" %in% total_count_format$vars || "distinct_pct" %in% total_count_format$vars) || - # Logic if no total_count format - (is.null(total_count_format) && is.null(format_strings) && ("pct" %in% tmp_fmt$n_counts$vars || "distinct_pct" %in% tmp_fmt$n_counts$vars)) || - (is.null(total_count_format) && ("pct" %in% count_fmt$n_counts$vars || "distinct_pct" %in% count_fmt$n_counts$vars)) - ) - ) { - warning("Your total row is ignoring certain values. The 'pct' in this row may not be 100%", - immediate. = TRUE) - } + (("pct" %in% total_count_format$vars || "distinct_pct" %in% total_count_format$vars) || + # Logic if no total_count format + (is.null(total_count_format) && is.null(format_strings) && ("pct" %in% tmp_fmt$n_counts$vars || "distinct_pct" %in% tmp_fmt$n_counts$vars)) || + (is.null(total_count_format) && ("pct" %in% count_fmt$n_counts$vars || "distinct_pct" %in% count_fmt$n_counts$vars)) + ) + ) { + warning("Your total row is ignoring certain values. The 'pct' in this row may not be 100%", + immediate. = TRUE) + } } if (is.null(count_row_prefix)) count_row_prefix <- "" - if (is.null(denoms_by)) denoms_by <- c(treat_var, cols) + # If a denoms variable is factor then it should be character for the denoms calculations + denoms_df_prep <- denoms_df %>% + mutate( + across(dplyr::where(is.factor), ~as.character(.)) + ) + + # Nested counts might have summary var come through as numeric + if ('summary_var' %in% map_chr(denoms_by, as_name) && is.numeric(denoms_df_prep$summary_var)) { + denoms_df_prep$summary_var <- as.character(denoms_df_prep$summary_var) + } + + # But if a summary_stat variable is factor, then the denoms needs to match this + # This happens if sorting was triggered for the variable as a factor + # fct_cols will be a named logical vector of the variable names, where TRUE + # is the summary_stat variables that are factors + fct_cols <- map_lgl(summary_stat, is.factor) + + if (any(fct_cols)) { + # From the bool vector of fct_cols, grab the names of the ones that + # are TRUE + # Create a regular expression like var1|var2|var3 + fct_cols_ns <- paste(names(fct_cols[fct_cols]), collapse="|") + + # Reset each factor variable to have the appropriate levels for the denom + # so that 0 filling can happen appropriately later on + denoms_df_prep <- denoms_df_prep %>% + mutate( + across(matches(fct_cols_ns), ~ factor(., levels=levels(summary_stat[[cur_column()]]))) + ) + + rm(fct_cols_ns) + } # rbind tables together numeric_data <- summary_stat %>% bind_rows(total_stat) %>% rename("summary_var" = !!target_var[[1]]) %>% group_by(!!!denoms_by) %>% - do(get_denom_total(., denoms_by, denoms_df, "n")) %>% + do(get_denom_total(., denoms_by, denoms_df_prep, "n")) %>% mutate(summary_var = prefix_count_row(summary_var, count_row_prefix)) %>% ungroup() @@ -175,6 +206,8 @@ process_single_count_target <- function(x) { distinct_stat[, c("distinct_n", "distinct_total")]) } + rm(denoms_df_prep, fct_cols) + }, envir = x) } @@ -214,8 +247,8 @@ process_count_n <- function(x) { # If there is a missing_count_string, but its not in the dataset if (!is.null(missing_count_string) && - !((any(unname(unlist(missing_count_list)) %in% unique(built_target[, as_name(target_var[[1]])]))) || - any(is.na(built_target[, as_name(target_var[[1]])])))) { + !((any(unname(unlist(missing_count_list)) %in% unique(built_target[, as_name(target_var[[1]])]))) || + any(is.na(built_target[, as_name(target_var[[1]])])))) { # This adds the missing string as a factor to the tallies. This is needed # to make sure the missing row is added even if there are no missing values. summary_stat <- summary_stat %>% @@ -318,12 +351,12 @@ prepare_format_metadata.count_layer <- function(x) { # distinct_by # If both distinct and n if (((("distinct_n" %in% map(format_strings$n_counts$vars, as_name) & - "n" %in% map(format_strings$n_counts$vars, as_name)) | - # or both distinct_pct and pct - ("distinct_pct" %in% map(format_strings$n_counts$vars, as_name) & - "pct" %in% map(format_strings$n_counts$vars, as_name))) & - # AND distinct_by is null - is.null(distinct_by))) { + "n" %in% map(format_strings$n_counts$vars, as_name)) | + # or both distinct_pct and pct + ("distinct_pct" %in% map(format_strings$n_counts$vars, as_name) & + "pct" %in% map(format_strings$n_counts$vars, as_name))) & + # AND distinct_by is null + is.null(distinct_by))) { stop("You can't use distinct and non-distinct parameters without specifying a distinct_by") } @@ -389,11 +422,11 @@ process_formatting.count_layer <- function(x, ...) { has_missing_count = has_missing_count) }) %>% # Pivot table - pivot_wider(id_cols = c(match_exact(by), "summary_var"), + pivot_wider(id_cols = c(match_exact(by), "summary_var"), names_from = c(!!treat_var, match_exact(cols)), values_from = n, names_prefix = "var1_") %>% - # Replace the by variables and target variable names with `row_label` - replace_by_string_names(quos(!!!by, summary_var)) + # Replace the by variables and target variable names with `row_label` + replace_by_string_names(quos(!!!by, summary_var)) if (is_built_nest) { # I had trouble doing this in a 'tidy' way so I just did it here. @@ -491,7 +524,7 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot # Iterate over every variable for (i in seq_along(vars_ord)) { str_all[[i + 1]] <- count_string_switch_help(vars_ord[i], count_fmt, .n[!missing_rows & !total_rows], .total[!missing_rows & !total_rows], - .distinct_n[!missing_rows & !total_rows], .distinct_total[!missing_rows & !total_rows], vars_ord) + .distinct_n[!missing_rows & !total_rows], .distinct_total[!missing_rows & !total_rows], vars_ord) } @@ -501,12 +534,12 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot missing_str_all[1] <- missing_f_str$repl_str for (i in seq_along(missing_vars_ord)) { missing_str_all[[i + 1]] <- count_string_switch_help(missing_vars_ord[i], - missing_f_str, - .n[missing_rows], - .total[missing_rows], - .distinct_n[missing_rows], - .distinct_total[missing_rows], - missing_vars_ord) + missing_f_str, + .n[missing_rows], + .total[missing_rows], + .distinct_n[missing_rows], + .distinct_total[missing_rows], + missing_vars_ord) } total_str_all <- vector("list", 5) @@ -516,9 +549,9 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot total_count_format, .n[total_rows], .total[total_rows], - .distinct_n[total_rows], - .distinct_total[total_rows], - total_vars_ord) + .distinct_n[total_rows], + .distinct_total[total_rows], + total_vars_ord) } # Put the vector strings together. Only include parts of str_all that aren't null @@ -658,8 +691,8 @@ process_count_denoms <- function(x) { "` is invalid. Filter error:\n", e)) }) - # For distinct counts, we want to defer back to the - # population dataset. Trigger this by identifying that + # For distinct counts, we want to defer back to the + # population dataset. Trigger this by identifying that # the population dataset was overridden if (!isTRUE(try(identical(pop_data, target)))) { # If the denom_where doesn't match the where AND the denom_where isn't true @@ -675,23 +708,39 @@ process_count_denoms <- function(x) { group_by(!!!layer_params[param_apears]) %>% summarize( n = n() - ) %>% + ) %>% ungroup() + # If user specified treatment var as a denom by then remove it + # and if inside a nested layer, rename summary_var in the denoms_by + # for building this table + if (is.null(denoms_by)) denoms_by <- c(treat_var, cols) + dist_grp <- denoms_by + which_is_treatvar <- which( + map_lgl(denoms_by, ~ as_name(.) %in% c(as_name(pop_treat_var), as_name(treat_var))) + ) + if (length(which_is_treatvar) > 0) { + dist_grp <- dist_grp[-which_is_treatvar] + } + is_svar <- map_lgl(dist_grp, ~as_name(.) == "summary_var") + if (any(is_svar)) { + dist_grp[[which(is_svar)]] <- layer_params[[1]] + } + denoms_df_dist <- built_pop_data %>% filter(!!denom_where) %>% - group_by(!!pop_treat_var) %>% + group_by(!!pop_treat_var, !!!dist_grp) %>% summarize( distinct_n = n_distinct(!!!distinct_by, !!pop_treat_var) ) %>% ungroup() - by_join <- as_name(pop_treat_var) - names(by_join) <- as_name(treat_var) + # Create merge variables to get the denoms dataframe merged correctly + by_join <- map_chr(append(dist_grp, pop_treat_var, after=0), as_name) + names(by_join) <- map_chr(append(dist_grp, treat_var, after=0), as_name) + denoms_df <- denoms_df_n %>% - complete(!!!layer_params[param_apears], - fill = list(n = 0)) %>% left_join(denoms_df_dist, by = by_join) if (as_name(target_var[[1]]) %in% names(target)) { @@ -699,6 +748,8 @@ process_count_denoms <- function(x) { rename("summary_var" := !!target_var[[1]]) } + rm(by_join, denoms_df_n, denoms_df_dist, dist_grp, is_svar, which_is_treatvar) + }, envir = x) } @@ -732,7 +783,7 @@ rename_missing_values <- function(x) { # Replace the implicit values in built_target built_target <- built_target %>% mutate(!!target_var[[1]] := fct_expand(!!target_var[[1]], "(Missing)")) %>% - mutate(!!target_var[[1]] := fct_explicit_na(!!target_var[[1]])) + mutate(!!target_var[[1]] := fct_na_value_to_level(!!target_var[[1]], level="(Missing)")) } built_target <- built_target %>% @@ -757,17 +808,17 @@ filter_numeric <- function(.data, return(.data) } - vals <- .data %>% - {if (is.null(numeric_cutoff_column)) . else filter(., !!treat_var == numeric_cutoff_column)} %>% - mutate( - pct = n/total, - distinct_pct = distinct_n/distinct_total - ) %>% - filter(!!sym(numeric_cutoff_stat) >= !!numeric_cutoff) %>% - extract2("summary_var") - - .data %>% - filter(summary_var %in% vals) + vals <- .data %>% + {if (is.null(numeric_cutoff_column)) . else filter(., !!treat_var == numeric_cutoff_column)} %>% + mutate( + pct = n/total, + distinct_pct = distinct_n/distinct_total + ) %>% + filter(!!sym(numeric_cutoff_stat) >= !!numeric_cutoff) %>% + extract2("summary_var") + + .data %>% + filter(summary_var %in% vals) } diff --git a/R/denom.R b/R/denom.R index 4598d260..a618f40d 100644 --- a/R/denom.R +++ b/R/denom.R @@ -154,7 +154,11 @@ get_denom_total <- function(.data, denoms_by, denoms_df, # Filter denoms dataset vars_in_denoms <- denoms_by[map_lgl(denoms_by, ~ as_name(.) %in% names(denoms_df))] filter_logic <- map(vars_in_denoms, function(x) { - expr(!!sym(as_name(x)) == !!unique(.data[, as_name(x)])[[1]]) + if (nrow(.data) > 0) { + expr(!!sym(as_name(x)) == !!unique(.data[, as_name(x)])[[1]]) + } else { + FALSE + } }) sums <- denoms_df %>% @@ -164,8 +168,27 @@ get_denom_total <- function(.data, denoms_by, denoms_df, .data$total <- ifelse(nrow(sums) > 0, sum(sums[["n"]], na.rm = TRUE), 0) # distinct_n is present for all count layers, but not shift layers, so # dont' do this for shift layers - if ("distinct_n" %in% names(sums)) - .data$distinct_total <- ifelse(nrow(sums) > 0, sums[["distinct_n"]], 0) + if ("distinct_n" %in% names(sums)) { + + merge_vars <- names(sums)[!(names(sums) %in% c('n', 'distinct_n'))] + dist_tot <- sums %>% + select(everything(), -n, distinct_total = distinct_n) + + # summary_var may be used for grouping denoms so only toss it if + # it's not in denoms_by + if (!('summary_var' %in% map_chr(vars_in_denoms, as_name)) & 'summary_var' %in% names(sums)) { + merge_vars <- merge_vars[merge_vars != 'summary_var'] + dist_tot <- dist_tot %>% + select(-summary_var) + } + + dist_tot <- dist_tot %>% distinct() + + .data <- .data %>% + left_join( + dist_tot, by = merge_vars + ) + } .data diff --git a/R/utils.R b/R/utils.R index 275eaf55..1187d100 100644 --- a/R/utils.R +++ b/R/utils.R @@ -27,7 +27,7 @@ modify_nested_call <- function(c, examine_only=FALSE, ...) { msg="Functions called within `add_layer` must be part of `Tplyr`") # Recursively extract the left side of the magrittr call to work your way up - e <- call_standardise(c) + e <- tplyr_call_standardise(c) c <- modify_nested_call(call_args(e)$lhs, examine_only, ...) if (!examine_only) { # Modify the magittr call by inserting the call retrieved from recursive command back in @@ -40,7 +40,7 @@ modify_nested_call <- function(c, examine_only=FALSE, ...) { # Standardize the call to get argument names and pull out the literal first argument # Save the call to a new variable in the process - e <- call_standardise(c) + e <- tplyr_call_standardise(c) args <- call_args(e)[1] # Send the first parameter back down recursively through modify_nested_call and @@ -302,8 +302,8 @@ clean_attr <- function(dat) { #' Simulate IBM rounding #' -#' This logic is from the github issue -#' https://github.com/atorus-research/Tplyr/issues/9 +#' This logic is from the stackoverflow issue +#' https://stackoverflow.com/questions/12688717/round-up-from-5 #' #' @param x The numeric values to round #' @param n The number of decimal rounding points @@ -314,10 +314,13 @@ ut_round <- function(x, n=0) { # x is the value to be rounded # n is the precision of the rounding - scale <- 10^n - y <- trunc(x * scale + sign(x) * 0.5) / scale + posneg <- sign(x) + e <- abs(x) * 10^n + e <- e + 0.5 + sqrt(.Machine$double.eps) + e <- trunc(e) + e <- e / 10^n # Return the rounded number - return(y) + return(e * posneg) } #' Assign a row identifier to a layer diff --git a/R/zzz.R b/R/zzz.R index 836ea526..53944b32 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,14 +11,14 @@ #' @importFrom stats IQR median sd quantile var #' @importFrom dplyr n summarize filter vars tally ungroup group_by mutate lag select bind_rows full_join add_tally distinct rowwise #' @importFrom dplyr everything rename mutate_at mutate_all as_tibble bind_cols do case_when arrange left_join row_number between mutate_if -#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group pull -#' @importFrom tidyr complete nesting pivot_wider pivot_longer replace_na starts_with +#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches +#' @importFrom tidyr complete nesting pivot_wider pivot_longer replace_na starts_with fill #' @importFrom utils str head tail #' @importFrom tidyselect all_of vars_select any_of #' @importFrom tibble tibble rownames_to_column add_column #' @importFrom lifecycle deprecate_soft deprecate_stop #' @importFrom stats var -#' @importFrom forcats fct_expand fct_collapse fct_explicit_na fct_drop +#' @importFrom forcats fct_expand fct_collapse fct_na_value_to_level fct_drop #' @importFrom utils capture.output NULL diff --git a/tests/testthat/_snaps/apply_formats.md b/tests/testthat/_snaps/apply_formats.md index 2f4a7828..4fab92c3 100644 --- a/tests/testthat/_snaps/apply_formats.md +++ b/tests/testthat/_snaps/apply_formats.md @@ -1,6 +1,6 @@ # apply_formats works correctly applies f_str() formatting - Problem while computing `fmt_example = apply_formats("a (xx.a)", hp, wt)`. + i In argument: `fmt_example = apply_formats("a (xx.a)", hp, wt)`. Caused by error: ! Auto-precision is not currently supported within the `apply_formats()` context diff --git a/tests/testthat/_snaps/count.md b/tests/testthat/_snaps/count.md index c2dc3e33..3e73875e 100644 --- a/tests/testthat/_snaps/count.md +++ b/tests/testthat/_snaps/count.md @@ -4,8 +4,8 @@ Caused by error in `value[[3L]]()`: ! group_count `where` condition `bad == code` is invalid. Filter error: Error in `filter()`: - ! Problem while computing `..1 = bad == code`. - Caused by error in `mask$eval_all_filter()`: + i In argument: `bad == code`. + Caused by error: ! object 'bad' not found # Total rows and missing counts are displayed correctly(0.1.5 Updates) @@ -155,6 +155,60 @@ You can not pass the second variable in `vars` as a denominator. +--- + + Code + tplyr_table(mtcars, gear, cols = vs) %>% add_layer(group_count(vars(cyl, grp)) %>% + set_denoms_by(cyl)) %>% build() %>% as.data.frame() + Output + row_label1 row_label2 var1_3_0 var1_3_1 var1_4_0 var1_4_1 + 1 4 4 0 ( 0.0%) 1 ( 9.1%) 0 ( 0.0%) 8 ( 72.7%) + 2 4 grp.4 0 ( 0.0%) 1 ( 9.1%) 0 ( 0.0%) 3 ( 27.3%) + 3 4 grp.4.5 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) 5 ( 45.5%) + 4 6 6 0 ( 0.0%) 2 ( 28.6%) 2 ( 28.6%) 2 ( 28.6%) + 5 6 grp.6 0 ( 0.0%) 0 ( 0.0%) 1 ( 14.3%) 1 ( 14.3%) + 6 6 grp.6.5 0 ( 0.0%) 2 ( 28.6%) 1 ( 14.3%) 1 ( 14.3%) + 7 8 8 12 ( 85.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + 8 8 grp.8 7 ( 50.0%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + 9 8 grp.8.5 5 ( 35.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + var1_5_0 var1_5_1 ord_layer_index ord_layer_1 ord_layer_2 + 1 1 ( 9.1%) 1 ( 9.1%) 1 1 Inf + 2 1 ( 9.1%) 0 ( 0.0%) 1 1 1 + 3 0 ( 0.0%) 1 ( 9.1%) 1 1 2 + 4 1 ( 14.3%) 0 ( 0.0%) 1 2 Inf + 5 0 ( 0.0%) 0 ( 0.0%) 1 2 1 + 6 1 ( 14.3%) 0 ( 0.0%) 1 2 2 + 7 2 ( 14.3%) 0 ( 0.0%) 1 3 Inf + 8 2 ( 14.3%) 0 ( 0.0%) 1 3 1 + 9 0 ( 0.0%) 0 ( 0.0%) 1 3 2 + +--- + + Code + tplyr_table(mtcars, gear, cols = vs) %>% add_layer(group_count(vars(cyl, grp))) %>% + build() %>% as.data.frame() + Output + row_label1 row_label2 var1_3_0 var1_3_1 var1_4_0 var1_4_1 + 1 4 4 0 ( 0.0%) 1 ( 33.3%) 0 ( 0.0%) 8 ( 80.0%) + 2 4 grp.4 0 ( 0.0%) 1 ( 33.3%) 0 ( 0.0%) 3 ( 30.0%) + 3 4 grp.4.5 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) 5 ( 50.0%) + 4 6 6 0 ( 0.0%) 2 ( 66.7%) 2 (100.0%) 2 ( 20.0%) + 5 6 grp.6 0 ( 0.0%) 0 ( 0.0%) 1 ( 50.0%) 1 ( 10.0%) + 6 6 grp.6.5 0 ( 0.0%) 2 ( 66.7%) 1 ( 50.0%) 1 ( 10.0%) + 7 8 8 12 (100.0%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + 8 8 grp.8 7 ( 58.3%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + 9 8 grp.8.5 5 ( 41.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) + var1_5_0 var1_5_1 ord_layer_index ord_layer_1 ord_layer_2 + 1 1 ( 25.0%) 1 (100.0%) 1 1 Inf + 2 1 ( 25.0%) 0 ( 0.0%) 1 1 1 + 3 0 ( 0.0%) 1 (100.0%) 1 1 2 + 4 1 ( 25.0%) 0 ( 0.0%) 1 2 Inf + 5 0 ( 0.0%) 0 ( 0.0%) 1 2 1 + 6 1 ( 25.0%) 0 ( 0.0%) 1 2 2 + 7 2 ( 50.0%) 0 ( 0.0%) 1 3 Inf + 8 2 ( 50.0%) 0 ( 0.0%) 1 3 1 + 9 0 ( 0.0%) 0 ( 0.0%) 1 3 2 + # nested count layers will error out if second variable is bigger than the first i In index: 1. @@ -164,151 +218,190 @@ # set_numeric_threshold works as expected Code - build(t1) + as.data.frame(build(t1)) Output - # A tibble: 2 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - - 1 8 12 ( 80.0%) " 0 ( 0.0%)" " 2 ( 40.0%)" 1 0 - 2 Total 15 (100.0%) "12 (100.0%)" " 5 (100.0%)" 1 12 + row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 + 1 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 + 2 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 --- Code - build(t2) + as.data.frame(build(t2)) Output - # A tibble: 3 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_lay~1 - - 1 4 " 1 ( 6.7%)" " 8 ( 66.7%)" " 2 ( 40.0%)" 1 8 - 2 8 "12 ( 80.0%)" " 0 ( 0.0%)" " 2 ( 40.0%)" 1 0 - 3 Total "15 (100.0%)" "12 (100.0%)" " 5 (100.0%)" 1 12 - # ... with abbreviated variable name 1: ord_layer_1 + row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 + 1 4 1 ( 6.7%) 8 ( 66.7%) 2 ( 40.0%) 1 8 + 2 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 + 3 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 --- Code - build(t3) + as.data.frame(build(t3)) Output - # A tibble: 1 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - - 1 Total 15 (100.0%) 12 (100.0%) " 5 (100.0%)" 1 12 + row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 + 1 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 --- Code - build(t4) + as.data.frame(build(t4)) Output - # A tibble: 0 x 2 - # ... with 2 variables: row_label1 , ord_layer_index + [1] row_label1 ord_layer_index + <0 rows> (or 0-length row.names) --- Code - build(t5) + as.data.frame(build(t5)) Output - # A tibble: 3 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_lay~1 - - 1 4 " 1 ( 6.7%)" " 8 ( 66.7%)" " 2 ( 40.0%)" 1 8 - 2 8 "12 ( 80.0%)" " 0 ( 0.0%)" " 2 ( 40.0%)" 1 0 - 3 Total "15 (100.0%)" "12 (100.0%)" " 5 (100.0%)" 1 12 - # ... with abbreviated variable name 1: ord_layer_1 + row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 + 1 4 1 ( 6.7%) 8 ( 66.7%) 2 ( 40.0%) 1 8 + 2 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 + 3 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 --- Code - build(t6) + as.data.frame(build(t6)) Output - # A tibble: 2 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - - 1 8 12 ( 80.0%) " 0 ( 0.0%)" " 2 ( 40.0%)" 1 0 - 2 Total 15 (100.0%) "12 (100.0%)" " 5 (100.0%)" 1 12 + row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 + 1 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 + 2 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 --- Code - build(t7) + as.data.frame(build(t7)) Output - # A tibble: 9 x 8 - row_label1 row_l~1 var1_~2 var1_~3 var1_~4 ord_l~5 ord_l~6 ord_l~7 - - 1 GASTROINTESTINAL DISO~ "GASTR~ " 6 ( ~ " 6 ( ~ " 3 ( ~ 1 1 Inf - 2 GASTROINTESTINAL DISO~ " DI~ " 3 ( ~ " 1 ( ~ " 2 ( ~ 1 1 1 - 3 GENERAL DISORDERS AND~ "GENER~ "11 ( ~ "21 ( ~ "21 ( ~ 1 2 Inf - 4 GENERAL DISORDERS AND~ " AP~ " 4 ( ~ " 7 ( ~ " 5 ( ~ 1 2 1 - 5 INFECTIONS AND INFEST~ "INFEC~ " 5 ( ~ " 4 ( ~ " 3 ( ~ 1 3 Inf - 6 INFECTIONS AND INFEST~ " UP~ " 4 ( ~ " 1 ( ~ " 1 ( ~ 1 3 1 - 7 SKIN AND SUBCUTANEOUS~ "SKIN ~ " 7 ( ~ "21 ( ~ "26 ( ~ 1 4 Inf - 8 SKIN AND SUBCUTANEOUS~ " ER~ " 4 ( ~ " 3 ( ~ " 2 ( ~ 1 4 1 - 9 SKIN AND SUBCUTANEOUS~ " PR~ " 3 ( ~ " 8 ( ~ " 7 ( ~ 1 4 2 - # ... with abbreviated variable names 1: row_label2, 2: var1_Placebo, - # 3: `var1_Xanomeline High Dose`, 4: `var1_Xanomeline Low Dose`, - # 5: ord_layer_index, 6: ord_layer_1, 7: ord_layer_2 + row_label1 + 1 GASTROINTESTINAL DISORDERS + 2 GASTROINTESTINAL DISORDERS + 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 4 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 5 INFECTIONS AND INFESTATIONS + 6 INFECTIONS AND INFESTATIONS + 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 8 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 9 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + row_label2 var1_Placebo + 1 GASTROINTESTINAL DISORDERS 6 ( 12.8%) + 2 DIARRHOEA 3 ( 6.4%) + 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS 11 ( 23.4%) + 4 APPLICATION SITE PRURITUS 4 ( 8.5%) + 5 INFECTIONS AND INFESTATIONS 5 ( 10.6%) + 6 UPPER RESPIRATORY TRACT INFECTION 4 ( 8.5%) + 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS 7 ( 14.9%) + 8 ERYTHEMA 4 ( 8.5%) + 9 PRURITUS 3 ( 6.4%) + var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index + 1 6 ( 7.8%) 3 ( 3.9%) 1 + 2 1 ( 1.3%) 2 ( 2.6%) 1 + 3 21 ( 27.3%) 21 ( 27.6%) 1 + 4 7 ( 9.1%) 5 ( 6.6%) 1 + 5 4 ( 5.2%) 3 ( 3.9%) 1 + 6 1 ( 1.3%) 1 ( 1.3%) 1 + 7 21 ( 27.3%) 26 ( 34.2%) 1 + 8 3 ( 3.9%) 2 ( 2.6%) 1 + 9 8 ( 10.4%) 7 ( 9.2%) 1 + ord_layer_1 ord_layer_2 + 1 1 Inf + 2 1 1 + 3 2 Inf + 4 2 1 + 5 3 Inf + 6 3 1 + 7 4 Inf + 8 4 1 + 9 4 2 --- Code - build(t8) + as.data.frame(build(t8)) Output - # A tibble: 9 x 8 - row_label1 row_l~1 var1_~2 var1_~3 var1_~4 ord_l~5 ord_l~6 ord_l~7 - - 1 GASTROINTESTINAL DISO~ "GASTR~ " 6 ( ~ " 6 ( ~ " 3 ( ~ 1 3 Inf - 2 GASTROINTESTINAL DISO~ " DI~ " 3 ( ~ " 1 ( ~ " 2 ( ~ 1 3 2 - 3 GENERAL DISORDERS AND~ "GENER~ "11 ( ~ "21 ( ~ "21 ( ~ 1 21 Inf - 4 GENERAL DISORDERS AND~ " AP~ " 4 ( ~ " 7 ( ~ " 5 ( ~ 1 21 5 - 5 INFECTIONS AND INFEST~ "INFEC~ " 5 ( ~ " 4 ( ~ " 3 ( ~ 1 3 Inf - 6 INFECTIONS AND INFEST~ " UP~ " 4 ( ~ " 1 ( ~ " 1 ( ~ 1 3 1 - 7 SKIN AND SUBCUTANEOUS~ "SKIN ~ " 7 ( ~ "21 ( ~ "26 ( ~ 1 26 Inf - 8 SKIN AND SUBCUTANEOUS~ " ER~ " 4 ( ~ " 3 ( ~ " 2 ( ~ 1 26 2 - 9 SKIN AND SUBCUTANEOUS~ " PR~ " 3 ( ~ " 8 ( ~ " 7 ( ~ 1 26 7 - # ... with abbreviated variable names 1: row_label2, 2: var1_Placebo, - # 3: `var1_Xanomeline High Dose`, 4: `var1_Xanomeline Low Dose`, - # 5: ord_layer_index, 6: ord_layer_1, 7: ord_layer_2 + row_label1 + 1 GASTROINTESTINAL DISORDERS + 2 GASTROINTESTINAL DISORDERS + 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 4 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS + 5 INFECTIONS AND INFESTATIONS + 6 INFECTIONS AND INFESTATIONS + 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 8 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + 9 SKIN AND SUBCUTANEOUS TISSUE DISORDERS + row_label2 var1_Placebo + 1 GASTROINTESTINAL DISORDERS 6 ( 12.8%) + 2 DIARRHOEA 3 ( 6.4%) + 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS 11 ( 23.4%) + 4 APPLICATION SITE PRURITUS 4 ( 8.5%) + 5 INFECTIONS AND INFESTATIONS 5 ( 10.6%) + 6 UPPER RESPIRATORY TRACT INFECTION 4 ( 8.5%) + 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS 7 ( 14.9%) + 8 ERYTHEMA 4 ( 8.5%) + 9 PRURITUS 3 ( 6.4%) + var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index + 1 6 ( 7.8%) 3 ( 3.9%) 1 + 2 1 ( 1.3%) 2 ( 2.6%) 1 + 3 21 ( 27.3%) 21 ( 27.6%) 1 + 4 7 ( 9.1%) 5 ( 6.6%) 1 + 5 4 ( 5.2%) 3 ( 3.9%) 1 + 6 1 ( 1.3%) 1 ( 1.3%) 1 + 7 21 ( 27.3%) 26 ( 34.2%) 1 + 8 3 ( 3.9%) 2 ( 2.6%) 1 + 9 8 ( 10.4%) 7 ( 9.2%) 1 + ord_layer_1 ord_layer_2 + 1 3 Inf + 2 3 2 + 3 21 Inf + 4 21 5 + 5 3 Inf + 6 3 1 + 7 26 Inf + 8 26 2 + 9 26 7 # denom and distinct_denom values work as expected Code - build(t1) + as.data.frame(build(t1)) Output - # A tibble: 5 x 6 - row_label1 var1_3 var1_4 var1_5 ord_layer~1 ord_l~2 - - 1 4 " 1/ 15 ( 6.7)" " 8/ 12 (66.7)" " 2/ 5 (40.0)" 1 8 - 2 6 " 2/ 15 (13.3)" " 4/ 12 (33.3)" " 1/ 5 (20.0)" 1 4 - 3 8 "12/ 15 (80.0)" " 0/ 12 ( 0.0)" " 2/ 5 (40.0)" 1 0 - 4 Missing " 0" " 0" " 0" 1 0 - 5 Total " 15 [100.0]" " 12 [100.0]" " 5 [100.0]" 1 12 - # ... with abbreviated variable names 1: ord_layer_index, 2: ord_layer_1 + row_label1 var1_3 var1_4 var1_5 ord_layer_index + 1 4 1/ 15 ( 6.7) 8/ 12 (66.7) 2/ 5 (40.0) 1 + 2 6 2/ 15 (13.3) 4/ 12 (33.3) 1/ 5 (20.0) 1 + 3 8 12/ 15 (80.0) 0/ 12 ( 0.0) 2/ 5 (40.0) 1 + 4 Missing 0 0 0 1 + 5 Total 15 [100.0] 12 [100.0] 5 [100.0] 1 + ord_layer_1 + 1 8 + 2 4 + 3 0 + 4 0 + 5 12 --- Code - build(t2) + as.data.frame(build(t2)) Output - # A tibble: 3 x 6 - row_label1 var1_3 var1_4 var1_5 ord_l~1 ord_l~2 - - 1 4 " 1 1 1 15" " 2 2 8 12" " 1 1 2 ~ 1 1 - 2 6 " 1 1 2 15" " 2 2 4 12" " 1 1 1 ~ 1 2 - 3 8 " 1 1 12 15" " 0 2 0 12" " 1 1 2 ~ 1 3 - # ... with abbreviated variable names 1: ord_layer_index, 2: ord_layer_1 + row_label1 var1_3 var1_4 var1_5 ord_layer_index + 1 4 1 1 1 15 2 2 8 12 1 1 2 5 1 + 2 6 1 1 2 15 2 2 4 12 1 1 1 5 1 + 3 8 1 1 12 15 0 2 0 12 1 1 2 5 1 + ord_layer_1 + 1 1 + 2 2 + 3 3 # denoms with distinct population data populates as expected Code - tab + as.data.frame(tab) Output - # A tibble: 1 x 8 - row_label1 var1_Dosed var1_Plac~1 var1_~2 var1_~3 var1_~4 ord_l~5 ord_l~6 - - 1 Any Body System 93 (55.4%) 32 (37.2%) 125 (4~ 43 (51~ 50 (59~ 1 NA - # ... with abbreviated variable names 1: var1_Placebo, 2: var1_Total, - # 3: `var1_Xanomeline High Dose`, 4: `var1_Xanomeline Low Dose`, - # 5: ord_layer_index, 6: ord_layer_1 + row_label1 var1_Dosed var1_Placebo var1_Total var1_Xanomeline High Dose + 1 Any Body System 93 (55.4%) 32 (37.2%) 125 (49.2%) 43 (51.2%) + var1_Xanomeline Low Dose ord_layer_index ord_layer_1 + 1 50 (59.5%) 1 NA # nested count layers error out when you try to add a total row @@ -319,121 +412,196 @@ # Tables with pop_data can accept a layer level where Code - dput(build(t)) + as.data.frame(build(t)) + Output + row_label1 var1_Placebo + 1 ABDOMINAL PAIN 0, [ 0] ( 0.0%) [ 0.0%] + 2 AGITATION 0, [ 0] ( 0.0%) [ 0.0%] + 3 ANXIETY 0, [ 0] ( 0.0%) [ 0.0%] + 4 APPLICATION SITE DERMATITIS 1, [ 1] ( 1.2%) [ 2.1%] + 5 APPLICATION SITE ERYTHEMA 0, [ 0] ( 0.0%) [ 0.0%] + 6 APPLICATION SITE IRRITATION 1, [ 1] ( 1.2%) [ 2.1%] + 7 APPLICATION SITE PAIN 0, [ 0] ( 0.0%) [ 0.0%] + 8 APPLICATION SITE PRURITUS 4, [ 4] ( 4.7%) [ 8.5%] + 9 APPLICATION SITE REACTION 1, [ 1] ( 1.2%) [ 2.1%] + 10 APPLICATION SITE URTICARIA 0, [ 0] ( 0.0%) [ 0.0%] + 11 APPLICATION SITE VESICLES 1, [ 1] ( 1.2%) [ 2.1%] + 12 APPLICATION SITE WARMTH 0, [ 0] ( 0.0%) [ 0.0%] + 13 ATRIAL HYPERTROPHY 1, [ 1] ( 1.2%) [ 2.1%] + 14 BLISTER 0, [ 0] ( 0.0%) [ 0.0%] + 15 BUNDLE BRANCH BLOCK RIGHT 1, [ 1] ( 1.2%) [ 2.1%] + 16 BURNING SENSATION 0, [ 0] ( 0.0%) [ 0.0%] + 17 CARDIAC FAILURE CONGESTIVE 1, [ 1] ( 1.2%) [ 2.1%] + 18 CHILLS 1, [ 2] ( 1.2%) [ 4.3%] + 19 COMPLEX PARTIAL SEIZURES 0, [ 0] ( 0.0%) [ 0.0%] + 20 CONFUSIONAL STATE 1, [ 1] ( 1.2%) [ 2.1%] + 21 CONSTIPATION 1, [ 1] ( 1.2%) [ 2.1%] + 22 CYSTITIS 0, [ 0] ( 0.0%) [ 0.0%] + 23 DERMATITIS CONTACT 0, [ 0] ( 0.0%) [ 0.0%] + 24 DIARRHOEA 2, [ 2] ( 2.3%) [ 4.3%] + 25 DIZZINESS 0, [ 0] ( 0.0%) [ 0.0%] + 26 ELECTROCARDIOGRAM T WAVE INVERSION 1, [ 1] ( 1.2%) [ 2.1%] + 27 EPISTAXIS 0, [ 0] ( 0.0%) [ 0.0%] + 28 ERYTHEMA 3, [ 4] ( 3.5%) [ 8.5%] + 29 FATIGUE 0, [ 0] ( 0.0%) [ 0.0%] + 30 HALLUCINATION, VISUAL 0, [ 0] ( 0.0%) [ 0.0%] + 31 HEART RATE INCREASED 1, [ 1] ( 1.2%) [ 2.1%] + 32 HEART RATE IRREGULAR 1, [ 1] ( 1.2%) [ 2.1%] + 33 HYPERHIDROSIS 0, [ 0] ( 0.0%) [ 0.0%] + 34 HYPONATRAEMIA 1, [ 1] ( 1.2%) [ 2.1%] + 35 HYPOTENSION 0, [ 0] ( 0.0%) [ 0.0%] + 36 INCREASED APPETITE 1, [ 1] ( 1.2%) [ 2.1%] + 37 INFLAMMATION 0, [ 0] ( 0.0%) [ 0.0%] + 38 IRRITABILITY 1, [ 1] ( 1.2%) [ 2.1%] + 39 MALAISE 0, [ 0] ( 0.0%) [ 0.0%] + 40 MYALGIA 0, [ 0] ( 0.0%) [ 0.0%] + 41 MYOCARDIAL INFARCTION 0, [ 0] ( 0.0%) [ 0.0%] + 42 NAUSEA 1, [ 1] ( 1.2%) [ 2.1%] + 43 OEDEMA PERIPHERAL 1, [ 1] ( 1.2%) [ 2.1%] + 44 PRURITUS 3, [ 3] ( 3.5%) [ 6.4%] + 45 PRURITUS GENERALISED 0, [ 0] ( 0.0%) [ 0.0%] + 46 RASH 0, [ 0] ( 0.0%) [ 0.0%] + 47 RASH MACULO-PAPULAR 0, [ 0] ( 0.0%) [ 0.0%] + 48 RASH PRURITIC 0, [ 0] ( 0.0%) [ 0.0%] + 49 SINUS BRADYCARDIA 0, [ 0] ( 0.0%) [ 0.0%] + 50 SKIN EXFOLIATION 0, [ 0] ( 0.0%) [ 0.0%] + 51 SKIN IRRITATION 0, [ 0] ( 0.0%) [ 0.0%] + 52 SUPRAVENTRICULAR EXTRASYSTOLES 1, [ 1] ( 1.2%) [ 2.1%] + 53 SYNCOPE 0, [ 0] ( 0.0%) [ 0.0%] + 54 TACHYCARDIA 1, [ 1] ( 1.2%) [ 2.1%] + 55 TRANSIENT ISCHAEMIC ATTACK 0, [ 0] ( 0.0%) [ 0.0%] + 56 UPPER RESPIRATORY TRACT INFECTION 1, [ 1] ( 1.2%) [ 2.1%] + 57 URTICARIA 0, [ 0] ( 0.0%) [ 0.0%] + 58 VOMITING 0, [ 0] ( 0.0%) [ 0.0%] + 59 WOUND 0, [ 0] ( 0.0%) [ 0.0%] + var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index + 1 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 2 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 3 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 4 3, [ 3] ( 3.6%) [ 3.9%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 5 3, [ 3] ( 3.6%) [ 3.9%] 4, [ 4] ( 4.8%) [ 5.3%] 1 + 6 3, [ 4] ( 3.6%) [ 5.2%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 7 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 8 6, [ 7] ( 7.1%) [ 9.1%] 4, [ 4] ( 4.8%) [ 5.3%] 1 + 9 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 10 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 11 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 12 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 13 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 14 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 2] ( 1.2%) [ 2.6%] 1 + 15 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 16 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 17 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 18 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 19 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 20 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 21 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 22 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 23 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 24 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 25 1, [ 1] ( 1.2%) [ 1.3%] 3, [ 4] ( 3.6%) [ 5.3%] 1 + 26 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 27 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 28 3, [ 3] ( 3.6%) [ 3.9%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 29 0, [ 0] ( 0.0%) [ 0.0%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 30 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 31 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 32 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 33 2, [ 2] ( 2.4%) [ 2.6%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 34 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 35 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 36 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 37 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 38 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 39 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 40 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 41 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 42 2, [ 2] ( 2.4%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 43 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 44 8, [ 8] ( 9.5%) [ 10.4%] 6, [ 6] ( 7.1%) [ 7.9%] 1 + 45 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 2] ( 1.2%) [ 2.6%] 1 + 46 2, [ 2] ( 2.4%) [ 2.6%] 3, [ 4] ( 3.6%) [ 5.3%] 1 + 47 1, [ 2] ( 1.2%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 48 1, [ 1] ( 1.2%) [ 1.3%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 49 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 50 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 51 1, [ 1] ( 1.2%) [ 1.3%] 3, [ 3] ( 3.6%) [ 3.9%] 1 + 52 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 53 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 + 54 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 55 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + 56 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 57 1, [ 2] ( 1.2%) [ 2.6%] 1, [ 2] ( 1.2%) [ 2.6%] 1 + 58 2, [ 2] ( 2.4%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 + 59 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 + ord_layer_1 + 1 1 + 2 2 + 3 3 + 4 4 + 5 5 + 6 6 + 7 7 + 8 8 + 9 9 + 10 10 + 11 11 + 12 12 + 13 15 + 14 17 + 15 19 + 16 20 + 17 21 + 18 23 + 19 24 + 20 25 + 21 26 + 22 30 + 23 32 + 24 33 + 25 34 + 26 35 + 27 36 + 28 37 + 29 40 + 30 42 + 31 44 + 32 45 + 33 47 + 34 49 + 35 50 + 36 51 + 37 52 + 38 54 + 39 55 + 40 56 + 41 57 + 42 60 + 43 63 + 44 65 + 45 66 + 46 67 + 47 68 + 48 69 + 49 72 + 50 73 + 51 74 + 52 76 + 53 78 + 54 79 + 55 80 + 56 82 + 57 84 + 58 87 + 59 88 + +# Regression test to make sure cols produce correct denom + + Code + t Output - structure(list(row_label1 = c("ABDOMINAL PAIN", "AGITATION", - "ANXIETY", "APPLICATION SITE DERMATITIS", "APPLICATION SITE ERYTHEMA", - "APPLICATION SITE IRRITATION", "APPLICATION SITE PAIN", "APPLICATION SITE PRURITUS", - "APPLICATION SITE REACTION", "APPLICATION SITE URTICARIA", "APPLICATION SITE VESICLES", - "APPLICATION SITE WARMTH", "ATRIAL HYPERTROPHY", "BLISTER", "BUNDLE BRANCH BLOCK RIGHT", - "BURNING SENSATION", "CARDIAC FAILURE CONGESTIVE", "CHILLS", - "COMPLEX PARTIAL SEIZURES", "CONFUSIONAL STATE", "CONSTIPATION", - "CYSTITIS", "DERMATITIS CONTACT", "DIARRHOEA", "DIZZINESS", "ELECTROCARDIOGRAM T WAVE INVERSION", - "EPISTAXIS", "ERYTHEMA", "FATIGUE", "HALLUCINATION, VISUAL", - "HEART RATE INCREASED", "HEART RATE IRREGULAR", "HYPERHIDROSIS", - "HYPONATRAEMIA", "HYPOTENSION", "INCREASED APPETITE", "INFLAMMATION", - "IRRITABILITY", "MALAISE", "MYALGIA", "MYOCARDIAL INFARCTION", - "NAUSEA", "OEDEMA PERIPHERAL", "PRURITUS", "PRURITUS GENERALISED", - "RASH", "RASH MACULO-PAPULAR", "RASH PRURITIC", "SINUS BRADYCARDIA", - "SKIN EXFOLIATION", "SKIN IRRITATION", "SUPRAVENTRICULAR EXTRASYSTOLES", - "SYNCOPE", "TACHYCARDIA", "TRANSIENT ISCHAEMIC ATTACK", "UPPER RESPIRATORY TRACT INFECTION", - "URTICARIA", "VOMITING", "WOUND"), var1_Placebo = c(" 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 4, [ 4] ( 4.7%) [ 8.5%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 1, [ 2] ( 1.2%) [ 4.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 2, [ 2] ( 2.3%) [ 4.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 3, [ 4] ( 3.5%) [ 8.5%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 1, [ 1] ( 1.2%) [ 2.1%]", - " 3, [ 3] ( 3.5%) [ 6.4%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 2.1%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]" - ), `var1_Xanomeline High Dose` = c(" 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 3, [ 3] ( 3.6%) [ 3.9%]", " 3, [ 3] ( 3.6%) [ 3.9%]", - " 3, [ 4] ( 3.6%) [ 5.2%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 6, [ 7] ( 7.1%) [ 9.1%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 3, [ 3] ( 3.6%) [ 3.9%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 2, [ 2] ( 2.4%) [ 2.6%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 8, [ 8] ( 9.5%) [ 10.4%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 1, [ 2] ( 1.2%) [ 2.6%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 2] ( 1.2%) [ 2.6%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 0, [ 0] ( 0.0%) [ 0.0%]" - ), `var1_Xanomeline Low Dose` = c(" 1, [ 1] ( 1.2%) [ 1.3%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 4, [ 4] ( 4.8%) [ 5.3%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 4, [ 4] ( 4.8%) [ 5.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 2] ( 1.2%) [ 2.6%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 2, [ 2] ( 2.4%) [ 2.6%]", " 3, [ 4] ( 3.6%) [ 5.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 2, [ 2] ( 2.4%) [ 2.6%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 2, [ 2] ( 2.4%) [ 2.6%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 6, [ 6] ( 7.1%) [ 7.9%]", " 1, [ 2] ( 1.2%) [ 2.6%]", - " 3, [ 4] ( 3.6%) [ 5.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 0, [ 0] ( 0.0%) [ 0.0%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 3, [ 3] ( 3.6%) [ 3.9%]", - " 1, [ 1] ( 1.2%) [ 1.3%]", " 2, [ 2] ( 2.4%) [ 2.6%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 2] ( 1.2%) [ 2.6%]", - " 0, [ 0] ( 0.0%) [ 0.0%]", " 1, [ 1] ( 1.2%) [ 1.3%]" - ), ord_layer_index = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, - 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, - 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, - 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, - 1L), ord_layer_1 = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 15, - 17, 19, 20, 21, 23, 24, 25, 26, 30, 32, 33, 34, 35, 36, 37, 40, - 42, 44, 45, 47, 49, 50, 51, 52, 54, 55, 56, 57, 60, 63, 65, 66, - 67, 68, 69, 72, 73, 74, 76, 78, 79, 80, 82, 84, 87, 88)), row.names = c(NA, - -59L), class = c("tbl_df", "tbl", "data.frame")) + row_label1 var1_0_F var1_0_M + 1 Subjects with at least one event 19 (35.8) [53] 13 (39.4) [33] + var1_54_F var1_54_M var1_81_F var1_81_M + 1 27 (54.0) [50] 23 (67.6) [34] 17 (42.5) [40] 26 (59.1) [44] diff --git a/tests/testthat/_snaps/desc.md b/tests/testthat/_snaps/desc.md index 854e8123..1c7e893a 100644 --- a/tests/testthat/_snaps/desc.md +++ b/tests/testthat/_snaps/desc.md @@ -4,8 +4,8 @@ Caused by error in `value[[3L]]()`: ! group_desc `where` condition `bad == code` is invalid. Filter error: Error in `filter()`: - ! Problem while computing `..1 = bad == code`. - Caused by error in `mask$eval_all_filter()`: + i In argument: `bad == code`. + Caused by error: ! object 'bad' not found # Stats as columns properly transposes the built data @@ -19,13 +19,15 @@ --- - # A tibble: 3 x 11 - row_label1 var1_n_0 var1_sd_0 var1_n_1 var1_~1 var2_~2 var2_~3 var2_~4 var2_~5 - - 1 3 "15" " 0.8" "" "BLAH" "15" " 0.3" "" "BLAH" - 2 4 " 4" " 0.2" " 8" " 0.5" " 4" " 0.1" " 8" " 0.3" - 3 5 "" "BLAH" " 5" " 0.8" "" "BLAH" " 5" " 0.4" - # ... with 2 more variables: ord_layer_index , ord_layer_1 , and - # abbreviated variable names 1: var1_sd_1, 2: var2_n_0, 3: var2_sd_0, - # 4: var2_n_1, 5: var2_sd_1 + Code + as.data.frame(d2) + Output + row_label1 var1_n_0 var1_sd_0 var1_n_1 var1_sd_1 var2_n_0 var2_sd_0 var2_n_1 + 1 3 15 0.8 BLAH 15 0.3 + 2 4 4 0.2 8 0.5 4 0.1 8 + 3 5 BLAH 5 0.8 BLAH 5 + var2_sd_1 ord_layer_index ord_layer_1 + 1 BLAH 1 1 + 2 0.3 1 2 + 3 0.4 1 3 diff --git a/tests/testthat/_snaps/functional.md b/tests/testthat/_snaps/functional.md index 441b8cdb..412df417 100644 --- a/tests/testthat/_snaps/functional.md +++ b/tests/testthat/_snaps/functional.md @@ -1,6 +1,6 @@ # all test tables can be built without errors or warnings - Problem while computing `col_i = fct_expand(...)`. + i In argument: `col_i = fct_expand(...)`. Caused by error: ! object 'col_i' not found diff --git a/tests/testthat/_snaps/meta.md b/tests/testthat/_snaps/meta.md index 7c295a1c..19c02cb6 100644 --- a/tests/testthat/_snaps/meta.md +++ b/tests/testthat/_snaps/meta.md @@ -41,18 +41,32 @@ # Metadata extraction and extension work properly Code - get_metadata(t) + as.data.frame(get_metadata(t)) Output - # A tibble: 7 x 5 - row_id row_label1 var1_3 var1_4 var1_5 - - 1 d1_1 n - 2 d2_1 Mean (SD) - 3 d3_1 Median - 4 d4_1 Q1, Q3 - 5 d5_1 Min, Max - 6 d6_1 Missing - 7 x1_1 + row_id row_label1 var1_3 + 1 d1_1 n ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 2 d2_1 Mean (SD) ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 3 d3_1 Median ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 4 d4_1 Q1, Q3 ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 5 d5_1 Min, Max ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 6 d6_1 Missing ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE + 7 x1_1 NULL + var1_4 + 1 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 2 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 3 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 4 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 5 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 6 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE + 7 NULL + var1_5 + 1 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 2 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 3 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 4 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 5 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 6 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE + 7 NULL # Metadata print method is accurate diff --git a/tests/testthat/_snaps/precision.md b/tests/testthat/_snaps/precision.md index f9db8a7b..39b671cb 100644 --- a/tests/testthat/_snaps/precision.md +++ b/tests/testthat/_snaps/precision.md @@ -20,23 +20,40 @@ --- - # A tibble: 12 x 8 - row_label1 row_label2 var1_3 var1_4 var1_5 ord_l~1 ord_l~2 ord_l~3 - - 1 0 n " 12" " 2" " 4" 1 1 1 - 2 0 Mean (SD) "4.10 (0.768)" "2.75~ "2.91~ 1 1 2 - 3 0 Median "3.81" "2.75" "2.97" 1 1 3 - 4 0 Q1, Q3 "3.56, 4.36" "2.68~ "2.61~ 1 1 4 - 5 0 Min, Max "3.4, 5.4" "2.6,~ "2.1,~ 1 1 5 - 6 0 Missing " 0" " 0" " 0" 1 1 6 - 7 1 n " 3" " 10" " 1" 1 2 1 - 8 1 Mean (SD) "3.0467 (0.51842~ "2.59~ "1.51~ 1 2 2 - 9 1 Median "3.2150" "2.55~ "1.51~ 1 2 3 - 10 1 Q1, Q3 "2.8400, 3.3375" "2.00~ "1.51~ 1 2 4 - 11 1 Min, Max "2.465, 3.460" "1.61~ "1.51~ 1 2 5 - 12 1 Missing " 0" " 0" " 0" 1 2 6 - # ... with abbreviated variable names 1: ord_layer_index, 2: ord_layer_1, - # 3: ord_layer_2 + Code + t <- tplyr_table(mtcars, gear) + l <- group_desc(t, wt, by = vs) %>% set_precision_data(prec2, default = "auto") + t <- add_layers(t, l) + as.data.frame(build(t)) + Message + Unhandled precision cases were found - calculating precision based on source data + Output + row_label1 row_label2 var1_3 var1_4 var1_5 + 1 0 n 12 2 4 + 2 0 Mean (SD) 4.10 (0.768) 2.75 (0.180) 2.91 (0.610) + 3 0 Median 3.81 2.75 2.97 + 4 0 Q1, Q3 3.56, 4.36 2.68, 2.81 2.61, 3.27 + 5 0 Min, Max 3.4, 5.4 2.6, 2.9 2.1, 3.6 + 6 0 Missing 0 0 0 + 7 1 n 3 10 1 + 8 1 Mean (SD) 3.0467 (0.51842) 2.5905 (0.69357) 1.5130 ( ) + 9 1 Median 3.2150 2.5500 1.5130 + 10 1 Q1, Q3 2.8400, 3.3375 2.0012, 3.1800 1.5130, 1.5130 + 11 1 Min, Max 2.465, 3.460 1.615, 3.440 1.513, 1.513 + 12 1 Missing 0 0 0 + ord_layer_index ord_layer_1 ord_layer_2 + 1 1 1 1 + 2 1 1 2 + 3 1 1 3 + 4 1 1 4 + 5 1 1 5 + 6 1 1 6 + 7 1 2 1 + 8 1 2 2 + 9 1 2 3 + 10 1 2 4 + 11 1 2 5 + 12 1 2 6 # Data validation for external precision data works effectively @@ -62,10 +79,11 @@ # Partially provided decimal precision caps populate correctly - # A tibble: 3 x 3 - var1_Placebo `var1_Xanomeline High Dose` `var1_Xanomeline Low Dose` - - 1 322.2 ( 65.0) 298.8 ( 55.5) 287.1 ( 76.8) - 2 322.223 (64.969) 298.849 (55.543) 287.149 (76.822) - 3 322.2 (65.0) 298.8 (55.5) 287.1 (76.8) + Code + as.data.frame(d %>% select(starts_with("var1"))) + Output + var1_Placebo var1_Xanomeline High Dose var1_Xanomeline Low Dose + 1 322.2 ( 65.0) 298.8 ( 55.5) 287.1 ( 76.8) + 2 322.223 (64.969) 298.849 (55.543) 287.149 (76.822) + 3 322.2 (65.0) 298.8 (55.5) 287.1 (76.8) diff --git a/tests/testthat/_snaps/shift.md b/tests/testthat/_snaps/shift.md index 92cb93ca..371daeb3 100644 --- a/tests/testthat/_snaps/shift.md +++ b/tests/testthat/_snaps/shift.md @@ -4,7 +4,7 @@ Caused by error in `value[[3L]]()`: ! group_shift `where` condition `bad == code` is invalid. Filter error: Error in `filter()`: - ! Problem while computing `..1 = bad == code`. - Caused by error in `mask$eval_all_filter()`: + i In argument: `bad == code`. + Caused by error: ! object 'bad' not found diff --git a/tests/testthat/_snaps/table.md b/tests/testthat/_snaps/table.md index 084879b4..9c9bc583 100644 --- a/tests/testthat/_snaps/table.md +++ b/tests/testthat/_snaps/table.md @@ -6,8 +6,8 @@ tplyr_table `where` condition `bad == code` is invalid. Filter error: Error in `filter()`: - ! Problem while computing `..1 = bad == code`. - Caused by error in `mask$eval_all_filter()`: + i In argument: `bad == code`. + Caused by error: ! object 'bad' not found @@ -15,8 +15,8 @@ Population data `pop_where` condition `bad == code` is invalid. Filter error: Error in `filter()`: - ! Problem while computing `..1 = bad == code`. - Caused by error in `mask$eval_all_filter()`: + i In argument: `bad == code`. + Caused by error: ! object 'bad' not found If the population data and target data subsets should be different, use `set_pop_where`. diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index 8b3f812f..c61f0d29 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -639,7 +639,29 @@ test_that("nested count layers handle `set_denoms_by` as expected", { " 0 ( 0.0%)", " 2 (100.0%)", "12 (100.0%)", " 7 ( 58.3%)", " 5 ( 41.7%)")) - + # Tests added to capture #136 + expect_snapshot( + # Results have been manually verified + # Denom for cyl == 4 is 11 + tplyr_table(mtcars, gear, cols=vs) %>% + add_layer( + group_count(vars(cyl,grp)) %>% + set_denoms_by(cyl) + ) %>% + build() %>% + as.data.frame() + ) + + expect_snapshot( + # Results have been manually verified + # Denom for gear == 3, vs = 0 is 12 + tplyr_table(mtcars, gear, cols=vs) %>% + add_layer( + group_count(vars(cyl,grp)) + ) %>% + build() %>% + as.data.frame() + ) }) @@ -675,6 +697,19 @@ test_that("test IBM rounding option", { options(tplyr.IBMRounding = FALSE) }) +test_that("test specific rounding proplem #124", { + vec <- c(2.64, -3.20, -2.88, 2.95) + mvec <- mean(vec) + + options(tplyr.IBMRounding = TRUE) + + rounded <- ut_round(mvec, 3) + + expect_equal(rounded, -0.123) + + options(tplyr.IBMRounding = FALSE) +}) + test_that("nested count layers will error out if second variable is bigger than the first", { mtcars <- mtcars2 mtcars$grp <- paste0("grp.", as.numeric(mtcars$cyl) + rep(c(0, 0.5), 16)) @@ -719,7 +754,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t1)) + expect_snapshot(as.data.frame(build(t1))) t2 <- mtcars %>% tplyr_table(gear) %>% @@ -730,7 +765,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t2)) + expect_snapshot(as.data.frame(build(t2))) t3 <- mtcars %>% tplyr_table(gear) %>% @@ -741,7 +776,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t3)) + expect_snapshot(as.data.frame(build(t3))) t4 <- mtcars %>% tplyr_table(gear) %>% @@ -752,7 +787,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t4)) + expect_snapshot(as.data.frame(build(t4))) t5 <- mtcars %>% tplyr_table(gear) %>% @@ -763,7 +798,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t5)) + expect_snapshot(as.data.frame(build(t5))) t6 <- mtcars %>% tplyr_table(gear) %>% @@ -774,7 +809,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t6)) + expect_snapshot(as.data.frame(build(t6))) load(test_path("adae.Rdata")) @@ -785,7 +820,7 @@ test_that("set_numeric_threshold works as expected", { set_numeric_threshold(3, "n", "Placebo") ) - expect_snapshot(build(t7)) + expect_snapshot(as.data.frame(build(t7))) t8 <- adae %>% tplyr_table(TRTA) %>% @@ -795,7 +830,7 @@ test_that("set_numeric_threshold works as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t8)) + expect_snapshot(as.data.frame(build(t8))) }) test_that("denom and distinct_denom values work as expected", { @@ -810,7 +845,7 @@ test_that("denom and distinct_denom values work as expected", { set_order_count_method("bycount") ) - expect_snapshot(build(t1)) + expect_snapshot(as.data.frame(build(t1))) t2 <- tplyr_table(mtcars, gear) %>% add_layer( @@ -819,7 +854,7 @@ test_that("denom and distinct_denom values work as expected", { set_format_strings(f_str("xxx xxx xxx xxx", distinct_n, distinct_total, n, total)) ) - expect_snapshot(build(t2)) + expect_snapshot(as.data.frame(build(t2))) }) test_that("denoms with distinct population data populates as expected", { @@ -838,7 +873,7 @@ test_that("denoms with distinct population data populates as expected", { ) %>% build() - expect_snapshot(tab) + expect_snapshot(as.data.frame(tab)) }) test_that("nested count layers error out when you try to add a total row", { @@ -867,6 +902,24 @@ test_that("Tables with pop_data can accept a layer level where", { set_format_strings(f_str("xxx, [xxx] (xxx.x%) [xxx.x%]", distinct_n, n, distinct_pct, pct)) ) - expect_snapshot(dput(build(t))) + expect_snapshot(as.data.frame(build(t))) + +}) + +test_that("Regression test to make sure cols produce correct denom", { + load(test_path('adsl.Rdata')) + load(test_path('adae.Rdata')) + t <- tplyr_table(adae,TRTAN, cols=SEX) %>% + set_pop_data(adsl) %>% + set_pop_treat_var(TRT01AN) %>% + add_layer( + group_count("Subjects with at least one event") %>% + set_distinct_by(USUBJID) %>% + set_format_strings(f_str("xxx (xx.x) [xx]", distinct_n, distinct_pct, distinct_total)) + ) %>% + build() %>% + select(-starts_with('ord')) %>% + as.data.frame() + expect_snapshot(t) }) diff --git a/tests/testthat/test-denom.R b/tests/testthat/test-denom.R index 0272527b..49b72cd9 100644 --- a/tests/testthat/test-denom.R +++ b/tests/testthat/test-denom.R @@ -26,3 +26,24 @@ test_that("this_denom can be called after a group_by and gives totals", { expect_equal(df2, tibble(total = rep(c(15, 12, 5), c(15, 12, 5)))) }) + +test_that("can build when data has no rows and population data is set (#131)", { + + load(test_path("adae.Rdata")) + load(test_path("adsl.Rdata")) + + t <- adae %>% + tplyr_table(TRTA) %>% + set_pop_data(adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count( + TRTEMFL, + where = TRTEMFL == "Y" & AESER == "Y" & AEREL == "REMOTE" + ) %>% + set_distinct_by(USUBJID) + ) + + expect_no_error(build(t)) + +}) diff --git a/tests/testthat/test-desc.R b/tests/testthat/test-desc.R index 723a5f61..3105340a 100644 --- a/tests/testthat/test-desc.R +++ b/tests/testthat/test-desc.R @@ -132,14 +132,12 @@ test_that("Stats as columns properly transposes the built data", { set_stats_as_columns() ) - expect_silent(build(t2)) - - d2 <- build(t2) + expect_silent(d2 <- build(t2)) t2_exp_names <- c('row_label1', 'var1_n_0', 'var1_sd_0', 'var1_n_1', 'var1_sd_1', 'var2_n_0', 'var2_sd_0', 'var2_n_1', 'var2_sd_1', 'ord_layer_index', 'ord_layer_1') expect_equal(names(d2), t2_exp_names) - expect_snapshot_output(d2) + expect_snapshot(as.data.frame(d2)) }) diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R index 3dbc6e68..3400c209 100644 --- a/tests/testthat/test-meta.R +++ b/tests/testthat/test-meta.R @@ -338,15 +338,13 @@ test_that("Metadata extraction and extension error properly", { test_that("Metadata extraction and extension work properly", { - dat <- t %>% build(metadata=TRUE) - m <- tibble( row_id = 'x1_1', var1_3 = list(tplyr_meta()) ) t <- append_metadata(t, m) - expect_snapshot(get_metadata(t)) + expect_snapshot(as.data.frame(get_metadata(t))) }) diff --git a/tests/testthat/test-precision.R b/tests/testthat/test-precision.R index 1247a4f8..caa9c294 100644 --- a/tests/testthat/test-precision.R +++ b/tests/testthat/test-precision.R @@ -167,12 +167,12 @@ test_that("Missing by variables are handled as specified in precision data",{ build(t) }) - expect_snapshot_output({ + expect_snapshot({ t <- tplyr_table(mtcars, gear) l <- group_desc(t, wt, by = vs) %>% set_precision_data(prec2, default="auto") t <- add_layers(t, l) - build(t) + as.data.frame(build(t)) }) }) @@ -249,5 +249,5 @@ test_that("Partially provided decimal precision caps populate correctly", { expect_silent(d <- build(t)) # Manually verified these results look appropriate - expect_snapshot_output(print(d %>% select(starts_with('var1')))) + expect_snapshot(as.data.frame(d %>% select(starts_with('var1')))) })