Skip to content

Commit

Permalink
final fix of labels
Browse files Browse the repository at this point in the history
  • Loading branch information
@Melkiades
Melkiades committed May 31, 2023
1 parent 6d04dd0 commit 38ddb85
Show file tree
Hide file tree
Showing 4 changed files with 309 additions and 71 deletions.
128 changes: 90 additions & 38 deletions R/analyze_vars_in_cols.R
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,17 @@
#' Summary numeric variables in columns
#'
#' @description `r lifecycle::badge("stable")`
#' @description `r lifecycle::badge("experimental")`
#'
#' Layout-creating function which can be used for creating column-wise summary tables, primarily
#' used for PK data sets. This function is a wrapper for [rtables::analyze_colvars()].
#'
#' @inheritParams argument_convention
#' @inheritParams rtables::analyze_colvars
#' @param summarize_row_groups (`flag`)\cr defaults to `FALSE` and applies the analysis to the current
#' @param row_labels (`character`)\cr as this function works in columns space, usual `.labels`
#' character vector applies on the column space. You can change the row labels by defining this
#' parameter to a named character vector with names corresponding to the split values. It defaults
#' to `NULL` and if it contains only one `string`, it will duplicate that as a row label.
#' @param do_summarize_row_groups (`flag`)\cr defaults to `FALSE` and applies the analysis to the current
#' label rows. This is a wrapper of [rtables::summarize_row_groups()] and it can accept `labelstr`
#' to define row labels. This behavior is not supported as we never need to overload row labels.
#' @param split_col_vars (`flag`)\cr defaults to `TRUE` and puts the analysis results onto the columns.
Expand All @@ -27,8 +31,8 @@
#'
#' Here `labelstr` behaves differently than usual. If it is not defined (default as `NULL`),
#' row labels are assigned automatically to the split values in case of `rtables::analyze_colvars`
#' (`summarize_row_groups = FALSE`, the default), and to the group label for
#' `summarize_row_groups = TRUE`.
#' (`do_summarize_row_groups = FALSE`, the default), and to the group label for
#' `do_summarize_row_groups = TRUE`.
#'
#' @seealso [summarize_vars()], [rtables::analyze_colvars()].
#'
Expand Down Expand Up @@ -113,19 +117,19 @@ analyze_vars_in_cols <- function(lyt,
cv = "CV (%)",
geom_cv = "CV % Geometric Mean"
),
labelstr = NULL,
summarize_row_groups = FALSE,
row_labels = NULL,
do_summarize_row_groups = FALSE,
split_col_vars = TRUE,
.indent_mods = NULL,
nested = TRUE,
na_level = NULL,
.formats = NULL) {
checkmate::assert_string(na_level, null.ok = TRUE)
checkmate::assert_string(labelstr, null.ok = TRUE)
checkmate::assert_character(row_labels, null.ok = TRUE)
checkmate::assert_int(.indent_mods, null.ok = TRUE)
checkmate::assert_flag(nested)
checkmate::assert_flag(split_col_vars)
checkmate::assert_flag(summarize_row_groups)
checkmate::assert_flag(do_summarize_row_groups)

# Automatic assignment of formats
if (is.null(.formats)) {
Expand All @@ -137,33 +141,6 @@ analyze_vars_in_cols <- function(lyt,
formats_v <- .formats
}

# Avoiding recursive argument, but keep the param name consistent
lbl_str <- labelstr

afun_list <- Map(
function(stat) {
function(u, .spl_context, labelstr = lbl_str, ...) {
res <- s_summary(u, ...)[[stat]]
if (summarize_row_groups) {
lbl <- ifelse(is.null(labelstr), " ", labelstr)
} else {
lbl <- ifelse(is.null(labelstr),
.spl_context$value[nrow(.spl_context)],
labelstr
)
}

rcell(res,
label = lbl,
format = formats_v[names(formats_v) == stat][[1]],
format_na_str = na_level,
indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods)
)
}
},
stat = .stats
)

# Check for vars in the case that one or more are used
if (length(vars) == 1) {
vars <- rep(vars, length(.stats))
Expand Down Expand Up @@ -193,24 +170,99 @@ analyze_vars_in_cols <- function(lyt,
)
}

# Main col split
lyt <- split_cols_by_multivar(
lyt = lyt,
vars = vars,
varlabels = .labels[.stats]
)
}

if (summarize_row_groups) {
if (do_summarize_row_groups) {
if (length(unique(vars)) > 1) {
stop("When using summarize_row_groups only one label level var should be inserted.")
stop("When using do_summarize_row_groups only one label level var should be inserted.")
}

# Function list for do_summarize_row_groups. Slightly different handling of labels
cfun_list <- Map(
function(stat) {
function(u, .spl_context, labelstr, ...) {
# Statistic
res <- s_summary(u, ...)[[stat]]

# Label check and replacement
if (length(row_labels) > 1) {
if (!(labelstr %in% names(row_labels))) {
stop("Replacing the labels in do_summarize_row_groups needs a named vector",
"that contains the split values. In the current split variable ",
.spl_context$split[nrow(.spl_context)],
" the labelstr value (split value by default) ", labelstr, " is not in",
" row_labels names: ", names(row_labels))
}
lbl <- unlist(row_labels[labelstr])
} else {
lbl <- labelstr
}

# Cell creation
rcell(res,
label = lbl,
format = formats_v[names(formats_v) == stat][[1]],
format_na_str = na_level,
indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods)
)
}
},
stat = .stats
)

# Main call to rtables
summarize_row_groups(
lyt = lyt,
var = unique(vars),
cfun = afun_list,
cfun = cfun_list,
extra_args = list(...)
)
} else {
# Function list for analyze_colvars
afun_list <- Map(
function(stat) {
function(u, .spl_context, ...) {
# Main statistics
res <- s_summary(u, ...)[[stat]]

# Label from context
label_from_context <- .spl_context$value[nrow(.spl_context)]

# Label switcher
if (is.null(row_labels)) {
lbl <- label_from_context
} else {
if (length(row_labels) > 1) {
if (!(label_from_context %in% names(row_labels))) {
stop("Replacing the labels in do_summarize_row_groups needs a named vector",
"that contains the split values. In the current split variable ",
.spl_context$split[nrow(.spl_context)],
" the split value ", label_from_context, " is not in",
" row_labels names: ", names(row_labels))
}
lbl <- unlist(row_labels[label_from_context])
}
}

# Cell creation
rcell(res,
label = lbl,
format = formats_v[names(formats_v) == stat][[1]],
format_na_str = na_level,
indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods)
)
}
},
stat = .stats
)

# Main call to rtables
analyze_colvars(lyt,
afun = afun_list,
nested = nested,
Expand Down
19 changes: 10 additions & 9 deletions man/analyze_vars_in_cols.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

98 changes: 84 additions & 14 deletions tests/testthat/_snaps/analyze_vars_in_cols.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@
F 288 36.0 0.4
M 234 36.3 0.6

# custom labels can be set with labelstr
# custom labels can be set with row_labels for analyze_colvars

Code
res
Expand All @@ -28,7 +28,19 @@
M
some custom label 234 36.3 8.5 0.6 23.4 23.5

# custom labels can be set with labelstr and summarize
---

Code
res
Output
n Mean SD SE CV (%) CV % Geometric Mean
——————————————————————————————————————————————————————————————————————————
F
Female Statistic 288 36.0 6.3 0.4 17.6 18.0
M
Male Statistic 234 36.3 8.5 0.6 23.4 23.5

# custom labels can be set with row_labels and summarize

Code
res
Expand All @@ -38,21 +50,79 @@
F 288 36.0 6.3 0.4 17.6 18.0
M 234 36.3 8.5 0.6 23.4 23.5

---

Code
res
Output
n Mean SD SE CV (%) CV % Geometric Mean
————————————————————————————————————————————————————————————————————————
Female Statistic 288 36.0 6.3 0.4 17.6 18.0
Male Statistic 234 36.3 8.5 0.6 23.4 23.5

# summarize works with nested analyze

Code
sort_at_path(tbl, c("SEX", "*", "RACE"), scorefun(1))
Output
n Mean SD SE CV (%) CV % Geometric Mean
——————————————————————————————————————————————————————————————————————————————————————————
F 288 36.0 6.3 0.4 17.6 18.0
ASIAN 135 35.4 4.4 0.4 12.5 13.0
BLACK OR AFRICAN AMERICAN 81 35.3 6.9 0.8 19.6 21.0
WHITE 36 38.3 7.7 1.3 20.2 20.2
AMERICAN INDIAN OR ALASKA NATIVE 36 37.8 8.5 1.4 22.5 23.0
M 234 36.3 8.5 0.6 23.4 23.5
ASIAN 126 34.8 6.7 0.6 19.3 19.2
WHITE 63 36.5 9.5 1.2 26.1 28.6
BLACK OR AFRICAN AMERICAN 27 45.2 9.6 1.8 21.1 20.3
AMERICAN INDIAN OR ALASKA NATIVE 18 32.8 4.9 1.2 15.1 15.3
Sex
Ethnicity n Mean SD SE CV (%) CV % Geometric Mean
——————————————————————————————————————————————————————————————————————————————————————————————————
Female 288 36.0 6.3 0.4 17.6 18.0
asian 135 35.4 4.4 0.4 12.5 13.0
black or african american 81 35.3 6.9 0.8 19.6 21.0
white 36 38.3 7.7 1.3 20.2 20.2
american indian or alaska native 36 37.8 8.5 1.4 22.5 23.0
Male 234 36.3 8.5 0.6 23.4 23.5
asian 126 34.8 6.7 0.6 19.3 19.2
white 63 36.5 9.5 1.2 26.1 28.6
black or african american 27 45.2 9.6 1.8 21.1 20.3
american indian or alaska native 18 32.8 4.9 1.2 15.1 15.3

---

Code
tbl_sorted
Output
n Mean SD SE CV (%) CV % Geometric Mean
———————————————————————————————————————————————————————————————————————————————————————————
F 288 36.0 6.3 0.4 17.6 18.0
ASIAN 135 35.4 4.4 0.4 12.5 13.0
C: Combination 135 35.4 4.4 0.4 12.5 13.0
B 63 35.4 3.9 0.5 10.9 11.2
C 54 34.7 5.5 0.7 15.7 16.1
A 18 37.6 0.4 0.1 1.1 1.1
BLACK OR AFRICAN AMERICAN 81 35.3 6.9 0.8 19.6 21.0
C: Combination 81 35.3 6.9 0.8 19.6 21.0
C 36 32.8 6.8 1.1 20.9 20.7
A 27 41.1 2.4 0.5 5.9 5.8
B 18 31.5 6.1 1.4 19.5 19.9
WHITE 36 38.3 7.7 1.3 20.2 20.2
C: Combination 36 38.3 7.7 1.3 20.2 20.2
A 18 37.2 3.5 0.8 9.3 9.4
B 9 49.6 0.0 0.0 0.0 0.0
C 9 29.4 0.0 0.0 0.0 0.0
AMERICAN INDIAN OR ALASKA NATIVE 36 37.8 8.5 1.4 22.5 23.0
C: Combination 36 37.8 8.5 1.4 22.5 23.0
A 18 38.4 10.0 2.4 26.2 27.2
C 18 37.2 6.8 1.6 18.4 18.8
M 234 36.3 8.5 0.6 23.4 23.5
ASIAN 126 34.8 6.7 0.6 19.3 19.2
C: Combination 126 34.8 6.7 0.6 19.3 19.2
A 45 35.7 3.5 0.5 9.8 9.5
B 45 37.2 7.6 1.1 20.6 20.3
C 36 30.6 6.7 1.1 22.0 20.8
WHITE 63 36.5 9.5 1.2 26.1 28.6
C: Combination 63 36.5 9.5 1.2 26.1 28.6
A 36 43.0 5.7 0.9 13.2 14.1
C 18 23.6 0.6 0.2 2.7 2.7
B 9 36.1 0.0 0.0 0.0 0.0
BLACK OR AFRICAN AMERICAN 27 45.2 9.6 1.8 21.1 20.3
C: Combination 27 45.2 9.6 1.8 21.1 20.3
B 18 38.7 1.7 0.4 4.5 4.5
C 9 58.3 0.0 0.0 0.0 0.0
AMERICAN INDIAN OR ALASKA NATIVE 18 32.8 4.9 1.2 15.1 15.3
C: Combination 18 32.8 4.9 1.2 15.1 15.3
B 9 28.0 0.0 0.0 0.0 0.0
C 9 37.6 0.0 0.0 0.0 0.0

Loading

0 comments on commit 38ddb85

Please sign in to comment.