From 136ebbdfcd0d23899b0c164bbc2bfbe3b024e1b1 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 30 Jan 2024 20:33:30 -0600 Subject: [PATCH 1/9] new util to get the column name out of col_label --- R/displays.R | 12 ++++-------- R/utils.R | 5 +++++ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/R/displays.R b/R/displays.R index a267c304..d5cfd6fc 100644 --- a/R/displays.R +++ b/R/displays.R @@ -88,10 +88,8 @@ eta_covariate <- function(df, x, y, ncol = 2, tag_levels = NULL, byrow = NULL, #' @export eta_covariate_list <- function(df, x, y, transpose = FALSE) { p <- diagnostic_display_list(df, x, y, eta_cat, eta_cont) - labx <- lapply(x, col_label) - labx <- sapply(labx, "[[", 1) - laby <- lapply(y, col_label) - laby <- sapply(laby, "[[", 1) + labx <- col_label_col(x) + laby <- col_label_col(y) p <- lapply(p, setNames, nm = labx) names(p) <- laby if(isTRUE(transpose)) { @@ -149,8 +147,7 @@ npde_covariate <- function(df, x, ncol = 2, tag_levels = NULL, byrow = NULL) { npde_covariate_list <- function(df, x) { p <- diagnostic_display_list(df, x, pm_axis_npde(), npde_cat, npde_cont) p <- p[[1]] - labx <- lapply(x, col_label) - labx <- sapply(labx, "[[", 1) + labx <- col_label_col(x) names(p) <- labx p <- class_pm_display(p) p @@ -204,8 +201,7 @@ cwres_covariate <- function(df, x, ncol = 2, tag_levels = NULL, byrow = NULL) { cwres_covariate_list <- function(df, x) { p <- diagnostic_display_list(df, x, pm_axis_npde(), cwres_cat, cwres_cont) p <- p[[1]] - labx <- lapply(x, col_label) - labx <- sapply(labx, "[[", 1) + labx <- col_label_col(x) names(p) <- labx p <- class_pm_display(p) p diff --git a/R/utils.R b/R/utils.R index 5e1ec8ad..930ea415 100755 --- a/R/utils.R +++ b/R/utils.R @@ -252,6 +252,11 @@ col_labels <- function(x) { values } +col_label_col <- function(x) { + x <- lapply(x, col_label) + vapply(x, "[", 1, FUN.VALUE = "a") +} + #' Parse the label part of a col_label #' #' @details From 2870b993213c7ea4499532d851c990ac9784d93e Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 30 Jan 2024 21:03:49 -0600 Subject: [PATCH 2/9] add covariate_split --- NAMESPACE | 2 ++ R/displays.R | 66 ++++++++++++++++++++++++++++++++++++++++ man/covariate_split.Rd | 68 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 136 insertions(+) create mode 100644 man/covariate_split.Rd diff --git a/NAMESPACE b/NAMESPACE index 2a4e17d2..9e666e97 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,8 @@ export(cont_cat) export(cont_cont) export(cont_hist) export(cont_hist_list) +export(covariate_split) +export(covariate_split_list) export(cwres_cat) export(cwres_cont) export(cwres_covariate) diff --git a/R/displays.R b/R/displays.R index d5cfd6fc..247e8b16 100644 --- a/R/displays.R +++ b/R/displays.R @@ -455,6 +455,72 @@ cwres_scatter <- function(df, xname = "value", p } +#' Create a display of continuous versus categorical covariates +#' +#' Get a single graphic of continous covariate boxpots split by +#' levels of different categorical covariates (`covariate_split()`). +#' Alternatively, get the component plots to be arranged by the user +#' (`covariate_split_list()`) +#' +#' @inheritParams eta_covariate +#' +#' @param x character `col//title` for the categorical covariates to +#' plot on x-axis; see [col_label]. +#' @param y character `col//title` for the continuous covariates to +#' plot on y-axis; see [col_label]. +#' @param transpose logical; if `TRUE`, output will be transposed to +#' group plots by the categorical covariates rather than the continuous +#' covariates. +#' @param ... additional arguments passed to [cont_cat()]. +#' +#' @details +#' Pass `ncol = NULL` or another non-numeric value to bypass arranging plots +#' coming from `covariate_split()`. +#' +#' @examples +#' data <- pmplots_data_id() +#' cont <- c("WT//Weight (kg)", "ALB//Albumin (mg/dL)", "AGE//Age (years)") +#' cats <- c("RF//Renal function", "CPc//Child-Pugh") +#' +#' covariate_split(data, x = cats, y = cont, tag_levels = "A") +#' +#' covariate_split(data, cats, cont) +#' covariate_split(data, cats, cont, transpose = TRUE) +#' +#' covariate_split_list(data, cats, cont) +#' covariate_split_list(data, cats, cont, transpose = TRUE) +#' +#' @seealso [eta_covariate()], [eta_covariate_list()] +#' @md +#' @export +covariate_split <- function(df, x, y, ncol = 2, tag_levels = NULL, + byrow = FALSE, transpose = FALSE, ...) { + require_patchwork() + p <- covariate_split_list(df, x, y, transpose, ...) + if(is.numeric(ncol)) { + p <- lapply(p, pm_grid, ncol = ncol, byrow = byrow) + } + if(!is.null(tag_levels)) { + p <- lapply(p, function(x) x + patchwork::plot_annotation(tag_levels = tag_levels)) + } + p +} + +#' @rdname covariate_split +#' @export +covariate_split_list <- function(df, x, y, transpose = FALSE, ...) { + p <- list_plot_y(df, x, y, .fun = cont_cat, ...) + labx <- col_label_col(x) + laby <- col_label_col(y) + names(p) <- laby + p <- lapply(p, setNames, labx) + if(isTRUE(transpose)) { + p <- list_transpose(p) + } + p <- lapply(p, class_pm_display) + p +} + #' with method for pm_display objects #' #' @param data a `pm_display` object. diff --git a/man/covariate_split.Rd b/man/covariate_split.Rd new file mode 100644 index 00000000..a5edfa2e --- /dev/null +++ b/man/covariate_split.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/displays.R +\name{covariate_split} +\alias{covariate_split} +\alias{covariate_split_list} +\title{Create a display of continuous versus categorical covariates} +\usage{ +covariate_split( + df, + x, + y, + ncol = 2, + tag_levels = NULL, + byrow = FALSE, + transpose = FALSE, + ... +) + +covariate_split_list(df, x, y, transpose = FALSE, ...) +} +\arguments{ +\item{df}{a data frame to plot.} + +\item{x}{character \verb{col//title} for the categorical covariates to +plot on x-axis; see \link{col_label}.} + +\item{y}{character \verb{col//title} for the continuous covariates to +plot on y-axis; see \link{col_label}.} + +\item{ncol}{passed to \code{\link[=pm_grid]{pm_grid()}}.} + +\item{tag_levels}{passed to \code{\link[patchwork:plot_annotation]{patchwork::plot_annotation()}}.} + +\item{byrow}{passed to \code{\link[=pm_grid]{pm_grid()}}.} + +\item{transpose}{logical; if \code{TRUE}, output will be transposed to +group plots by the categorical covariates rather than the continuous +covariates.} + +\item{...}{additional arguments passed to \code{\link[=cont_cat]{cont_cat()}}.} +} +\description{ +Get a single graphic of continous covariate boxpots split by +levels of different categorical covariates (\code{covariate_split()}). +Alternatively, get the component plots to be arranged by the user +(\code{covariate_split_list()}) +} +\details{ +Pass \code{ncol = NULL} or another non-numeric value to bypass arranging plots +coming from \code{covariate_split()}. +} +\examples{ +data <- pmplots_data_id() +cont <- c("WT//Weight (kg)", "ALB//Albumin (mg/dL)", "AGE//Age (years)") +cats <- c("RF//Renal function", "CPc//Child-Pugh") + +covariate_split(data, x = cats, y = cont, tag_levels = "A") + +covariate_split(data, cats, cont) +covariate_split(data, cats, cont, transpose = TRUE) + +covariate_split_list(data, cats, cont) +covariate_split_list(data, cats, cont, transpose = TRUE) + +} +\seealso{ +\code{\link[=eta_covariate]{eta_covariate()}}, \code{\link[=eta_covariate_list]{eta_covariate_list()}} +} From ecbac8c21b88c156721ec0604f22ff7a858c0f91 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 30 Jan 2024 21:24:07 -0600 Subject: [PATCH 3/9] fill out covariate split display --- R/displays.R | 16 ++++++++++++++-- man/covariate_split.Rd | 16 ++++++++++++++-- 2 files changed, 28 insertions(+), 4 deletions(-) diff --git a/R/displays.R b/R/displays.R index 247e8b16..12e8b727 100644 --- a/R/displays.R +++ b/R/displays.R @@ -487,8 +487,20 @@ cwres_scatter <- function(df, xname = "value", #' covariate_split(data, cats, cont) #' covariate_split(data, cats, cont, transpose = TRUE) #' -#' covariate_split_list(data, cats, cont) -#' covariate_split_list(data, cats, cont, transpose = TRUE) +#' l <- covariate_split_list(data, cats, cont, transpose = TRUE) +#' +#' with(l$RF, WT/(ALB + AGE), tag_levels = "A") +#' +#' @return +#' `covariate_split()` returns a list of plots arranged in graphics as a +#' `patchwork` object using [pm_grid()]. `covariate_split_list()` the same +#' plots, but unarranged as a list of lists. +#' +#' When `transpose` is `FALSE` (default), plots in a single graphic are grouped +#' by the continuous covariate (passed as `y`), and the names of the list +#' reflect those names (e.g., `WT`). When `transpose` is `TRUE`, the graphics +#' are grouped by the categorical covariate (passed as `x`) and the names of the +#' list reflect those names (e.g. `RF`). See **Examples**. #' #' @seealso [eta_covariate()], [eta_covariate_list()] #' @md diff --git a/man/covariate_split.Rd b/man/covariate_split.Rd index a5edfa2e..ae439bb3 100644 --- a/man/covariate_split.Rd +++ b/man/covariate_split.Rd @@ -39,6 +39,17 @@ covariates.} \item{...}{additional arguments passed to \code{\link[=cont_cat]{cont_cat()}}.} } +\value{ +\code{covariate_split()} returns a list of plots arranged in graphics as a +\code{patchwork} object using \code{\link[=pm_grid]{pm_grid()}}. \code{covariate_split_list()} the same +plots, but unarranged as a list of lists. + +When \code{transpose} is \code{FALSE} (default), plots in a single graphic are grouped +by the continuous covariate (passed as \code{y}), and the names of the list +reflect those names (e.g., \code{WT}). When \code{transpose} is \code{TRUE}, the graphics +are grouped by the categorical covariate (passed as \code{x}) and the names of the +list reflect those names (e.g. \code{RF}). See \strong{Examples}. +} \description{ Get a single graphic of continous covariate boxpots split by levels of different categorical covariates (\code{covariate_split()}). @@ -59,8 +70,9 @@ covariate_split(data, x = cats, y = cont, tag_levels = "A") covariate_split(data, cats, cont) covariate_split(data, cats, cont, transpose = TRUE) -covariate_split_list(data, cats, cont) -covariate_split_list(data, cats, cont, transpose = TRUE) +l <- covariate_split_list(data, cats, cont, transpose = TRUE) + +with(l$RF, WT/(ALB + AGE), tag_levels = "A") } \seealso{ From 49fd1987cf623391c99939b01ac807b95b8f2fc9 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Wed, 31 Jan 2024 17:03:38 -0600 Subject: [PATCH 4/9] add Rd file; add tests for cont_cat_panel and buddy --- NAMESPACE | 4 +- R/displays.R | 26 ++++---- man/{covariate_split.Rd => cont_cat_panel.Rd} | 29 ++++---- tests/testthat/test-displays.R | 66 ++++++++++++++++++- 4 files changed, 92 insertions(+), 33 deletions(-) rename man/{covariate_split.Rd => cont_cat_panel.Rd} (74%) diff --git a/NAMESPACE b/NAMESPACE index 9e666e97..8057b51b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,11 +8,11 @@ S3method(with,pm_display) export(boxwork) export(col_label) export(cont_cat) +export(cont_cat_panel) +export(cont_cat_panel_list) export(cont_cont) export(cont_hist) export(cont_hist_list) -export(covariate_split) -export(covariate_split_list) export(cwres_cat) export(cwres_cont) export(cwres_covariate) diff --git a/R/displays.R b/R/displays.R index 12e8b727..180645b4 100644 --- a/R/displays.R +++ b/R/displays.R @@ -457,10 +457,10 @@ cwres_scatter <- function(df, xname = "value", #' Create a display of continuous versus categorical covariates #' -#' Get a single graphic of continous covariate boxpots split by -#' levels of different categorical covariates (`covariate_split()`). +#' Get a single graphic of continuous covariate boxplots split by +#' levels of different categorical covariates (`cont_cat_panel()`). #' Alternatively, get the component plots to be arranged by the user -#' (`covariate_split_list()`) +#' (`cont_cat_panel_list()`) #' #' @inheritParams eta_covariate #' @@ -475,25 +475,25 @@ cwres_scatter <- function(df, xname = "value", #' #' @details #' Pass `ncol = NULL` or another non-numeric value to bypass arranging plots -#' coming from `covariate_split()`. +#' coming from `cont_cat_panel()`. #' #' @examples #' data <- pmplots_data_id() #' cont <- c("WT//Weight (kg)", "ALB//Albumin (mg/dL)", "AGE//Age (years)") #' cats <- c("RF//Renal function", "CPc//Child-Pugh") #' -#' covariate_split(data, x = cats, y = cont, tag_levels = "A") +#' cont_cat_panel(data, x = cats, y = cont, tag_levels = "A") #' -#' covariate_split(data, cats, cont) -#' covariate_split(data, cats, cont, transpose = TRUE) +#' cont_cat_panel(data, cats, cont) +#' cont_cat_panel(data, cats, cont, transpose = TRUE) #' -#' l <- covariate_split_list(data, cats, cont, transpose = TRUE) +#' l <- cont_cat_panel_list(data, cats, cont, transpose = TRUE) #' #' with(l$RF, WT/(ALB + AGE), tag_levels = "A") #' #' @return -#' `covariate_split()` returns a list of plots arranged in graphics as a -#' `patchwork` object using [pm_grid()]. `covariate_split_list()` the same +#' `cont_cat_panel()` returns a list of plots arranged in graphics as a +#' `patchwork` object using [pm_grid()]. `cont_cat_panel_list()` the same #' plots, but unarranged as a list of lists. #' #' When `transpose` is `FALSE` (default), plots in a single graphic are grouped @@ -505,10 +505,10 @@ cwres_scatter <- function(df, xname = "value", #' @seealso [eta_covariate()], [eta_covariate_list()] #' @md #' @export -covariate_split <- function(df, x, y, ncol = 2, tag_levels = NULL, +cont_cat_panel <- function(df, x, y, ncol = 2, tag_levels = NULL, byrow = FALSE, transpose = FALSE, ...) { require_patchwork() - p <- covariate_split_list(df, x, y, transpose, ...) + p <- cont_cat_panel_list(df, x, y, transpose, ...) if(is.numeric(ncol)) { p <- lapply(p, pm_grid, ncol = ncol, byrow = byrow) } @@ -520,7 +520,7 @@ covariate_split <- function(df, x, y, ncol = 2, tag_levels = NULL, #' @rdname covariate_split #' @export -covariate_split_list <- function(df, x, y, transpose = FALSE, ...) { +cont_cat_panel_list <- function(df, x, y, transpose = FALSE, ...) { p <- list_plot_y(df, x, y, .fun = cont_cat, ...) labx <- col_label_col(x) laby <- col_label_col(y) diff --git a/man/covariate_split.Rd b/man/cont_cat_panel.Rd similarity index 74% rename from man/covariate_split.Rd rename to man/cont_cat_panel.Rd index ae439bb3..f756eb78 100644 --- a/man/covariate_split.Rd +++ b/man/cont_cat_panel.Rd @@ -1,11 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/displays.R -\name{covariate_split} -\alias{covariate_split} -\alias{covariate_split_list} +\name{cont_cat_panel} +\alias{cont_cat_panel} \title{Create a display of continuous versus categorical covariates} \usage{ -covariate_split( +cont_cat_panel( df, x, y, @@ -15,8 +14,6 @@ covariate_split( transpose = FALSE, ... ) - -covariate_split_list(df, x, y, transpose = FALSE, ...) } \arguments{ \item{df}{a data frame to plot.} @@ -40,8 +37,8 @@ covariates.} \item{...}{additional arguments passed to \code{\link[=cont_cat]{cont_cat()}}.} } \value{ -\code{covariate_split()} returns a list of plots arranged in graphics as a -\code{patchwork} object using \code{\link[=pm_grid]{pm_grid()}}. \code{covariate_split_list()} the same +\code{cont_cat_panel()} returns a list of plots arranged in graphics as a +\code{patchwork} object using \code{\link[=pm_grid]{pm_grid()}}. \code{cont_cat_panel_list()} the same plots, but unarranged as a list of lists. When \code{transpose} is \code{FALSE} (default), plots in a single graphic are grouped @@ -51,26 +48,26 @@ are grouped by the categorical covariate (passed as \code{x}) and the names of t list reflect those names (e.g. \code{RF}). See \strong{Examples}. } \description{ -Get a single graphic of continous covariate boxpots split by -levels of different categorical covariates (\code{covariate_split()}). +Get a single graphic of continuous covariate boxplots split by +levels of different categorical covariates (\code{cont_cat_panel()}). Alternatively, get the component plots to be arranged by the user -(\code{covariate_split_list()}) +(\code{cont_cat_panel_list()}) } \details{ Pass \code{ncol = NULL} or another non-numeric value to bypass arranging plots -coming from \code{covariate_split()}. +coming from \code{cont_cat_panel()}. } \examples{ data <- pmplots_data_id() cont <- c("WT//Weight (kg)", "ALB//Albumin (mg/dL)", "AGE//Age (years)") cats <- c("RF//Renal function", "CPc//Child-Pugh") -covariate_split(data, x = cats, y = cont, tag_levels = "A") +cont_cat_panel(data, x = cats, y = cont, tag_levels = "A") -covariate_split(data, cats, cont) -covariate_split(data, cats, cont, transpose = TRUE) +cont_cat_panel(data, cats, cont) +cont_cat_panel(data, cats, cont, transpose = TRUE) -l <- covariate_split_list(data, cats, cont, transpose = TRUE) +l <- cont_cat_panel_list(data, cats, cont, transpose = TRUE) with(l$RF, WT/(ALB + AGE), tag_levels = "A") diff --git a/tests/testthat/test-displays.R b/tests/testthat/test-displays.R index 5ab7d8d7..5d7e9986 100644 --- a/tests/testthat/test-displays.R +++ b/tests/testthat/test-displays.R @@ -1,4 +1,5 @@ library(testthat) +library(pmplots) local_edition(3) data <- pmplots_data_obs() @@ -7,8 +8,14 @@ id <- pmplots_data_id() covs <- c("AAG", "WT//Weight", "CPc//Child-Pugh", "STUDYc") etas <- c("ETA1//ETA-CL", "ETA2//ETA-V2", "ETA3//ETA-KA") -etas1 <- lapply(etas, col_label) %>% sapply("[",1) -covs1 <- lapply(covs, col_label) %>% sapply("[", 1) +etas1 <- pmplots:::col_label_col(etas) +covs1 <- pmplots:::col_label_col(covs) + +cats <- c("CPc//Child-Pugh", "STUDYc//Study", "RF//Renal function") +cont <- c("AAG", "WT//Weight (kg)", "AGE//Age (years)", "CRCL") +cats1 <- pmplots:::col_label_col(cats) +cont1 <- pmplots:::col_label_col(cont) + test_that("eta_covariate", { a <- eta_covariate(data, covs, etas) @@ -20,6 +27,16 @@ test_that("eta_covariate", { expect_s3_class(a[[1]], "patchwork") }) +test_that("cont_cat_panel", { + a <- cont_cat_panel(data, x = cats, y = cont) + expect_length(a, length(cont)) + expect_length(a[[1]], length(cats)) + expect_named(a) + expect_identical(names(a), cont1) + expect_type(a, "list") + expect_s3_class(a[[1]], "patchwork") +}) + test_that("npde_covariate", { a <- npde_covariate(data, covs) expect_length(a, length(covs)) @@ -46,6 +63,20 @@ test_that("eta_covariate_list", { expect_s3_class(a[[1]][[1]], "gg") }) +test_that("cont_cat_panel_list", { + a <- cont_cat_panel_list(data, cats, cont) + expect_length(a, length(cont)) + expect_length(a[[1]], length(cats)) + expect_named(a) + expect_named(a[[1]]) + expect_identical(names(a), cont1) + expect_identical(names(a[[1]]), cats1) + expect_identical(names(a[[1]]), names(a[[2]])) + expect_type(a, "list") + expect_s3_class(a[[1]], "pm_display") + expect_s3_class(a[[1]][[1]], "gg") +}) + test_that("npde_covariate_list", { a <- npde_covariate_list(data, covs) expect_length(a, length(covs)) @@ -73,6 +104,13 @@ test_that("eta_covariate transpose", { expect_identical(names(a), covs1) }) +test_that("cont_cat_panel transpose", { + a <- cont_cat_panel(data, cats, cont, transpose = TRUE) + expect_type(a, "list") + expect_s3_class(a[[1]], "patchwork") + expect_identical(names(a), cats1) +}) + test_that("eta_covariate_list transpose", { a <- eta_covariate_list(data, covs, etas, transpose = TRUE) expect_equal(names(a), covs1) @@ -82,6 +120,15 @@ test_that("eta_covariate_list transpose", { expect_s3_class(p, "patchwork") }) +test_that("cont_cat_panel_list transpose", { + a <- cont_cat_panel_list(data, cats, cont, transpose = TRUE) + expect_equal(names(a), cats1) + expect_equal(names(a[[1]]), cont1) + + p <- with(a$RF, (WT/CRCL) | AGE) + expect_s3_class(p, "patchwork") +}) + # --------------------------------------------------------------------------- test_that("npde_panel", { @@ -200,6 +247,9 @@ test_that("covariate plots - arrange by column", { a <- eta_covariate(data, covs[1], etas[1:2], byrow = FALSE) expect_false(a$ETA1$patches$layout$byrow) + a <- cont_cat_panel(data, cats, cont, byrow = FALSE) + expect_false(a$WT$patches$layout$byrow) + a <- npde_covariate(data, covs, byrow = FALSE) expect_false(a$patches$layout$byrow) @@ -211,6 +261,9 @@ test_that("covariate plots - set ncol", { a <- eta_covariate(data, covs, etas, ncol = 3) expect_equal(a$ETA1$patches$layout$ncol, 3) + a <- cont_cat_panel(data, cats, cont, ncol = 2) + expect_equal(a$WT$patches$layout$ncol, 2) + a <- npde_covariate(data, covs, ncol = 2) expect_equal(a$patches$layout$ncol, 2) @@ -225,6 +278,9 @@ test_that("tag levels via function", { a <- eta_covariate(data, covs, etas, tag_levels = "A") expect_equal(a$ETA1$patches$annotation$tag_levels, "A") + a <- cont_cat_panel(data, cats, cont, tag_levels = "A") + expect_equal(a$WT$patches$annotation$tag_levels, "A") + a <- npde_covariate(data, covs, tag_levels = "1") expect_equal(a$patches$annotation$tag_levels, "1") @@ -256,6 +312,10 @@ test_that("tag levels via with()", { p <- with(a$ETA1, WT, tag_levels = "A") expect_equal(p$patches$annotation$tag_levels, "A") + a <- cont_cat_panel_list(data, cats, cont) + p <- with(a$WT, (RF + CPc)/STUDYc, tag_levels = "A") + expect_equal(p$patches$annotation$tag_levels, "A") + a <- npde_covariate_list(data, covs) p <- with(a, WT + AAG, tag_levels = "a") expect_equal(p$patches$annotation$tag_levels, "a") @@ -274,3 +334,5 @@ test_that("tag levels via with()", { }) # --------------------------------------------------------------------------- + + From 62adf0ea0332401f21fae30281fdf2f9e777c1c1 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 6 Feb 2024 14:26:36 -0600 Subject: [PATCH 5/9] fix Rd --- R/displays.R | 2 +- man/cont_cat_panel.Rd | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/displays.R b/R/displays.R index 180645b4..57de1799 100644 --- a/R/displays.R +++ b/R/displays.R @@ -518,7 +518,7 @@ cont_cat_panel <- function(df, x, y, ncol = 2, tag_levels = NULL, p } -#' @rdname covariate_split +#' @rdname cont_cat_panel #' @export cont_cat_panel_list <- function(df, x, y, transpose = FALSE, ...) { p <- list_plot_y(df, x, y, .fun = cont_cat, ...) diff --git a/man/cont_cat_panel.Rd b/man/cont_cat_panel.Rd index f756eb78..2e7a2434 100644 --- a/man/cont_cat_panel.Rd +++ b/man/cont_cat_panel.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/displays.R \name{cont_cat_panel} \alias{cont_cat_panel} +\alias{cont_cat_panel_list} \title{Create a display of continuous versus categorical covariates} \usage{ cont_cat_panel( @@ -14,6 +15,8 @@ cont_cat_panel( transpose = FALSE, ... ) + +cont_cat_panel_list(df, x, y, transpose = FALSE, ...) } \arguments{ \item{df}{a data frame to plot.} From 84ee23a6821e8ad774f04788ea08a152a93335ad Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 6 Feb 2024 14:37:09 -0600 Subject: [PATCH 6/9] test for col_label_col utility --- tests/testthat/test-col_label.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-col_label.R b/tests/testthat/test-col_label.R index e28491dc..9db1fe45 100755 --- a/tests/testthat/test-col_label.R +++ b/tests/testthat/test-col_label.R @@ -40,3 +40,11 @@ test_that("punctuation in col-label issue-72 [PMP-TEST-006]", { c("wt.baseline", "Baseline Weight") ) }) + +test_that("get col part from a col-label vector", { + x <- "a//first" + expect_identical(pmplots:::col_label_col(x), "a") + + x <- c("a//first", "b@@second", "c//third") + expect_identical(pmplots:::col_label_col(x), c("a", "b", "c")) +}) From 309ffc1592225074c39ae0853e6c7d0a0bba2d62 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 6 Feb 2024 14:41:43 -0600 Subject: [PATCH 7/9] refer to col_label() --- R/displays.R | 8 ++++---- man/cont_cat_panel.Rd | 4 ++-- man/cwres_covariate.Rd | 2 +- man/eta_covariate.Rd | 4 ++-- man/npde_covariate.Rd | 2 +- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/displays.R b/R/displays.R index 57de1799..42e80b57 100644 --- a/R/displays.R +++ b/R/displays.R @@ -28,8 +28,8 @@ diagnostic_display_list <- function(df, x, y, fun_cat, fun_cont) { #' #' @param df a data frame to plot. #' @param x character `col//title` for covariates to plot on x-axis; -#' see [col_label]. -#' @param y character `col//title` for ETAs to plot on y-axis; see [col_label]. +#' see [col_label()]. +#' @param y character `col//title` for ETAs to plot on y-axis; see [col_label()]. #' @param ncol passed to [pm_grid()]. #' @param byrow passed to [pm_grid()]. #' @param tag_levels passed to [patchwork::plot_annotation()]. @@ -465,9 +465,9 @@ cwres_scatter <- function(df, xname = "value", #' @inheritParams eta_covariate #' #' @param x character `col//title` for the categorical covariates to -#' plot on x-axis; see [col_label]. +#' plot on x-axis; see [col_label()]. #' @param y character `col//title` for the continuous covariates to -#' plot on y-axis; see [col_label]. +#' plot on y-axis; see [col_label()]. #' @param transpose logical; if `TRUE`, output will be transposed to #' group plots by the categorical covariates rather than the continuous #' covariates. diff --git a/man/cont_cat_panel.Rd b/man/cont_cat_panel.Rd index 2e7a2434..97e6a7f3 100644 --- a/man/cont_cat_panel.Rd +++ b/man/cont_cat_panel.Rd @@ -22,10 +22,10 @@ cont_cat_panel_list(df, x, y, transpose = FALSE, ...) \item{df}{a data frame to plot.} \item{x}{character \verb{col//title} for the categorical covariates to -plot on x-axis; see \link{col_label}.} +plot on x-axis; see \code{\link[=col_label]{col_label()}}.} \item{y}{character \verb{col//title} for the continuous covariates to -plot on y-axis; see \link{col_label}.} +plot on y-axis; see \code{\link[=col_label]{col_label()}}.} \item{ncol}{passed to \code{\link[=pm_grid]{pm_grid()}}.} diff --git a/man/cwres_covariate.Rd b/man/cwres_covariate.Rd index b8300271..b7caf8b7 100644 --- a/man/cwres_covariate.Rd +++ b/man/cwres_covariate.Rd @@ -13,7 +13,7 @@ cwres_covariate_list(df, x) \item{df}{a data frame to plot.} \item{x}{character \verb{col//title} for covariates to plot on x-axis; -see \link{col_label}.} +see \code{\link[=col_label]{col_label()}}.} \item{ncol}{passed to \code{\link[=pm_grid]{pm_grid()}}.} diff --git a/man/eta_covariate.Rd b/man/eta_covariate.Rd index 5744dcea..1fbe0d4a 100644 --- a/man/eta_covariate.Rd +++ b/man/eta_covariate.Rd @@ -21,9 +21,9 @@ eta_covariate_list(df, x, y, transpose = FALSE) \item{df}{a data frame to plot.} \item{x}{character \verb{col//title} for covariates to plot on x-axis; -see \link{col_label}.} +see \code{\link[=col_label]{col_label()}}.} -\item{y}{character \verb{col//title} for ETAs to plot on y-axis; see \link{col_label}.} +\item{y}{character \verb{col//title} for ETAs to plot on y-axis; see \code{\link[=col_label]{col_label()}}.} \item{ncol}{passed to \code{\link[=pm_grid]{pm_grid()}}.} diff --git a/man/npde_covariate.Rd b/man/npde_covariate.Rd index 1bffaada..d05f9d82 100644 --- a/man/npde_covariate.Rd +++ b/man/npde_covariate.Rd @@ -13,7 +13,7 @@ npde_covariate_list(df, x) \item{df}{a data frame to plot.} \item{x}{character \verb{col//title} for covariates to plot on x-axis; -see \link{col_label}.} +see \code{\link[=col_label]{col_label()}}.} \item{ncol}{passed to \code{\link[=pm_grid]{pm_grid()}}.} From ceef079ac307f2dc5da60fbedb4d364f8f9ad93d Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 6 Feb 2024 14:45:01 -0600 Subject: [PATCH 8/9] tweak documentation --- R/displays.R | 8 ++++---- man/cont_cat_panel.Rd | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/R/displays.R b/R/displays.R index 42e80b57..c5a9b991 100644 --- a/R/displays.R +++ b/R/displays.R @@ -488,7 +488,7 @@ cwres_scatter <- function(df, xname = "value", #' cont_cat_panel(data, cats, cont, transpose = TRUE) #' #' l <- cont_cat_panel_list(data, cats, cont, transpose = TRUE) -#' +#' names(l) #' with(l$RF, WT/(ALB + AGE), tag_levels = "A") #' #' @return @@ -497,10 +497,10 @@ cwres_scatter <- function(df, xname = "value", #' plots, but unarranged as a list of lists. #' #' When `transpose` is `FALSE` (default), plots in a single graphic are grouped -#' by the continuous covariate (passed as `y`), and the names of the list +#' by the continuous covariates (passed as `y`), and the names of the list #' reflect those names (e.g., `WT`). When `transpose` is `TRUE`, the graphics -#' are grouped by the categorical covariate (passed as `x`) and the names of the -#' list reflect those names (e.g. `RF`). See **Examples**. +#' are grouped by the categorical covariates (passed as `x`) and the names of +#' the list reflect those names (e.g. `RF`). See **Examples**. #' #' @seealso [eta_covariate()], [eta_covariate_list()] #' @md diff --git a/man/cont_cat_panel.Rd b/man/cont_cat_panel.Rd index 97e6a7f3..67867548 100644 --- a/man/cont_cat_panel.Rd +++ b/man/cont_cat_panel.Rd @@ -45,10 +45,10 @@ covariates.} plots, but unarranged as a list of lists. When \code{transpose} is \code{FALSE} (default), plots in a single graphic are grouped -by the continuous covariate (passed as \code{y}), and the names of the list +by the continuous covariates (passed as \code{y}), and the names of the list reflect those names (e.g., \code{WT}). When \code{transpose} is \code{TRUE}, the graphics -are grouped by the categorical covariate (passed as \code{x}) and the names of the -list reflect those names (e.g. \code{RF}). See \strong{Examples}. +are grouped by the categorical covariates (passed as \code{x}) and the names of +the list reflect those names (e.g. \code{RF}). See \strong{Examples}. } \description{ Get a single graphic of continuous covariate boxplots split by @@ -71,7 +71,7 @@ cont_cat_panel(data, cats, cont) cont_cat_panel(data, cats, cont, transpose = TRUE) l <- cont_cat_panel_list(data, cats, cont, transpose = TRUE) - +names(l) with(l$RF, WT/(ALB + AGE), tag_levels = "A") } From 40d67e758d62a0dbdbef16f465d29dbfdbc8f918 Mon Sep 17 00:00:00 2001 From: Kyle Baron Date: Tue, 6 Feb 2024 14:46:34 -0600 Subject: [PATCH 9/9] tweak documentation --- R/displays.R | 4 ++-- man/cont_cat_panel.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/displays.R b/R/displays.R index c5a9b991..01c037f7 100644 --- a/R/displays.R +++ b/R/displays.R @@ -493,8 +493,8 @@ cwres_scatter <- function(df, xname = "value", #' #' @return #' `cont_cat_panel()` returns a list of plots arranged in graphics as a -#' `patchwork` object using [pm_grid()]. `cont_cat_panel_list()` the same -#' plots, but unarranged as a list of lists. +#' `patchwork` object using [pm_grid()]. `cont_cat_panel_list()` returns the +#' same plots, but unarranged as a named list of lists. #' #' When `transpose` is `FALSE` (default), plots in a single graphic are grouped #' by the continuous covariates (passed as `y`), and the names of the list diff --git a/man/cont_cat_panel.Rd b/man/cont_cat_panel.Rd index 67867548..aa89f06a 100644 --- a/man/cont_cat_panel.Rd +++ b/man/cont_cat_panel.Rd @@ -41,8 +41,8 @@ covariates.} } \value{ \code{cont_cat_panel()} returns a list of plots arranged in graphics as a -\code{patchwork} object using \code{\link[=pm_grid]{pm_grid()}}. \code{cont_cat_panel_list()} the same -plots, but unarranged as a list of lists. +\code{patchwork} object using \code{\link[=pm_grid]{pm_grid()}}. \code{cont_cat_panel_list()} returns the +same plots, but unarranged as a named list of lists. When \code{transpose} is \code{FALSE} (default), plots in a single graphic are grouped by the continuous covariates (passed as \code{y}), and the names of the list