From 30e9fe7f51bf1e23d8e9f338c264b94ed6f773b0 Mon Sep 17 00:00:00 2001 From: "Fukuda, Hiroaki" Date: Wed, 10 Apr 2024 21:59:51 -0400 Subject: [PATCH 1/4] Add a new argument to specify hover variables for outlier in `prepare_boxly` and `boxly()`. --- R/boxly.R | 49 ++++++++++++++++++++++++++++++++++++-------- R/prepare_boxly.R | 31 ++++++++++++++++++++++++++-- man/boxly.Rd | 5 ++++- man/prepare_boxly.Rd | 10 ++++++++- 4 files changed, 83 insertions(+), 12 deletions(-) diff --git a/R/boxly.R b/R/boxly.R index 8d03098..0b1bb73 100644 --- a/R/boxly.R +++ b/R/boxly.R @@ -22,6 +22,7 @@ #' @param color Color for box plot. #' @param hover_summary_var A character vector of statistics to be displayed #' on hover label of box. +#' @param hover_outlier_display A character vector of hover variable for outlier. #' @param hover_outlier_label A character vector of hover label for outlier. #' @param x_label x-axis label. #' @param y_label y-axis label. @@ -54,13 +55,15 @@ boxly <- function(outdata, color = NULL, hover_summary_var = c("n", "min", "q1", "median", "mean", "q3", "max"), - hover_outlier_label = c("Participant Id", "Parameter value"), + hover_outlier_display = c("USUBJID", outdata$y_var), + hover_outlier_label = c("Participant ID", "Parameter value"), x_label = "Visit", y_label = "Change", heading_select_list = "Lab parameter", heading_summary_table = "Number of Participants") { x_var <- outdata$x_var y_var <- outdata$y_var + id_var <- outdata$id_var group_var <- outdata$group_var param_var <- outdata$param_var hover_var_outlier <- outdata$hover_var_outlier @@ -94,13 +97,43 @@ boxly <- function(outdata, } # paste multiple hover_outlier_labels - tbl$text <- ifelse(!is.na(tbl$outlier), - paste0( - hover_outlier_label[1], ": ", tbl[["USUBJID"]], - "\n", hover_outlier_label[2], ": ", tbl[["outlier"]] - ), - NA - ) + # Check length of variables and labels + if (length(hover_outlier_label) > 0) { + if (!length(hover_outlier_display) == length(hover_outlier_label)) { + message("hover_outlier_display should have the same length as hover_outlier_label.") + } + } + + # Set labels + label <- vapply(tbl, function(x) { + if (is.null(attr(x, "label"))) { + return(NA_character_) + } else { + attr(x, "label") + } + }, FUN.VALUE = character(1)) + listing_label <- ifelse(is.na(label), names(tbl), label) + + tbl$text <- apply(tbl, 1, function (x) { + text <- NULL + var <- NULL + if (!is.na(x[["outlier"]])) { + for (i in seq(hover_outlier_display)) { + var <- hover_outlier_display[i] + if (!is.null(hover_outlier_label)) { + label <- ifelse(!is.na(hover_outlier_label[i]), hover_outlier_label[i], listing_label[var]) + } else { + label <- listing_label[var] + } + text <- ifelse(i == 1, + paste0(text, label, ": ", x[[var]]), + paste0(text, "\n", label, ": ", x[[var]])) + } + } else { + text <- NA + } + return(text) + }) # implement color if (is.null(color)) { diff --git a/R/prepare_boxly.R b/R/prepare_boxly.R index c1b208a..720774f 100644 --- a/R/prepare_boxly.R +++ b/R/prepare_boxly.R @@ -25,6 +25,7 @@ #' The term name is used as key to link information. #' @param analysis A character value of analysis term name. #' The term name is used as key to link information. +#' @param hover_var_outlier A character vector of hover variable for outlier. #' #' @return Metadata list with plotting dataset. #' @@ -46,7 +47,9 @@ prepare_boxly <- function(meta, population = NULL, observation = NULL, - analysis = NULL) { + analysis = NULL, + hover_var_outlier = c("USUBJID", metalite::collect_adam_mapping(meta, analysis)$y) + ) { if (is.null(population)) { if (length(meta$population) == 1) { population <- meta$population[[1]]$name @@ -89,7 +92,7 @@ prepare_boxly <- function(meta, function(s) { metalite::collect_observation_record(meta, population, observation, parameter = s, - var = unique(c(obs_var, y, x)) + var = unique(c(obs_var, y, x, hover_var_outlier)) ) } ) @@ -170,6 +173,30 @@ prepare_boxly <- function(meta, plotds <- do.call(rbind, plotds) rownames(plotds) <- NULL + # Get all labels from the un-subset data + label <- vapply(obs, function(x) { + if (is.null(attr(x, "label"))) { + return(NA_character_) + } else { + attr(x, "label") + } + }, FUN.VALUE = character(1)) + listing_label <- ifelse(is.na(label), names(obs), label) + + name <- names(plotds) + var <- names(plotds) + label <- listing_label[match(names(plotds), names(listing_label))] + diff <- setdiff(name, names(plotds)) + if (length(diff) > 0) { + var <- c(var, diff) + label <- c(label, diff) + } + + # Assign label + for (i in seq(name)) { + attr(plotds[[i]], "label") <- label[names(plotds[i]) == var] + } + # Return value metalite::outdata(meta, population, observation, parameter, x_var = x, y_var = y, group_var = obs_group, diff --git a/man/boxly.Rd b/man/boxly.Rd index 91071f7..eab6128 100644 --- a/man/boxly.Rd +++ b/man/boxly.Rd @@ -8,7 +8,8 @@ boxly( outdata, color = NULL, hover_summary_var = c("n", "min", "q1", "median", "mean", "q3", "max"), - hover_outlier_label = c("Participant Id", "Parameter value"), + hover_outlier_display = c("USUBJID", outdata$y_var), + hover_outlier_label = c("Participant ID", "Parameter value"), x_label = "Visit", y_label = "Change", heading_select_list = "Lab parameter", @@ -23,6 +24,8 @@ boxly( \item{hover_summary_var}{A character vector of statistics to be displayed on hover label of box.} +\item{hover_outlier_display}{A character vector of hover variable for outlier.} + \item{hover_outlier_label}{A character vector of hover label for outlier.} \item{x_label}{x-axis label.} diff --git a/man/prepare_boxly.Rd b/man/prepare_boxly.Rd index 3ad98d6..81f4dcf 100644 --- a/man/prepare_boxly.Rd +++ b/man/prepare_boxly.Rd @@ -4,7 +4,13 @@ \alias{prepare_boxly} \title{Prepare data for interactive box plot} \usage{ -prepare_boxly(meta, population = NULL, observation = NULL, analysis = NULL) +prepare_boxly( + meta, + population = NULL, + observation = NULL, + analysis = NULL, + hover_var_outlier = c("USUBJID", metalite::collect_adam_mapping(meta, analysis)$y) +) } \arguments{ \item{meta}{A metadata object created by metalite.} @@ -17,6 +23,8 @@ The term name is used as key to link information.} \item{analysis}{A character value of analysis term name. The term name is used as key to link information.} + +\item{hover_var_outlier}{A character vector of hover variable for outlier.} } \value{ Metadata list with plotting dataset. From 38f2a4b4b11229113c0f7358d92a674b8120522b Mon Sep 17 00:00:00 2001 From: fukuhiro2023 Date: Thu, 11 Apr 2024 02:35:51 +0000 Subject: [PATCH 2/4] Style code (GHA) --- R/boxly.R | 7 ++++--- R/prepare_boxly.R | 3 +-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/boxly.R b/R/boxly.R index 0b1bb73..1c8c212 100644 --- a/R/boxly.R +++ b/R/boxly.R @@ -114,7 +114,7 @@ boxly <- function(outdata, }, FUN.VALUE = character(1)) listing_label <- ifelse(is.na(label), names(tbl), label) - tbl$text <- apply(tbl, 1, function (x) { + tbl$text <- apply(tbl, 1, function(x) { text <- NULL var <- NULL if (!is.na(x[["outlier"]])) { @@ -126,8 +126,9 @@ boxly <- function(outdata, label <- listing_label[var] } text <- ifelse(i == 1, - paste0(text, label, ": ", x[[var]]), - paste0(text, "\n", label, ": ", x[[var]])) + paste0(text, label, ": ", x[[var]]), + paste0(text, "\n", label, ": ", x[[var]]) + ) } } else { text <- NA diff --git a/R/prepare_boxly.R b/R/prepare_boxly.R index 720774f..7e29599 100644 --- a/R/prepare_boxly.R +++ b/R/prepare_boxly.R @@ -48,8 +48,7 @@ prepare_boxly <- function(meta, population = NULL, observation = NULL, analysis = NULL, - hover_var_outlier = c("USUBJID", metalite::collect_adam_mapping(meta, analysis)$y) - ) { + hover_var_outlier = c("USUBJID", metalite::collect_adam_mapping(meta, analysis)$y)) { if (is.null(population)) { if (length(meta$population) == 1) { population <- meta$population[[1]]$name From 6586208fd08ec2308d9ba24ae02a7e87dc881773 Mon Sep 17 00:00:00 2001 From: "Fukuda, Hiroaki" Date: Tue, 16 Apr 2024 22:07:15 -0400 Subject: [PATCH 3/4] Change to pass hover variables via `outdata` --- R/boxly.R | 11 +++++------ R/prepare_boxly.R | 5 ++--- man/boxly.Rd | 6 ++---- man/prepare_boxly.Rd | 2 +- 4 files changed, 10 insertions(+), 14 deletions(-) diff --git a/R/boxly.R b/R/boxly.R index 1c8c212..bd49b5d 100644 --- a/R/boxly.R +++ b/R/boxly.R @@ -22,8 +22,8 @@ #' @param color Color for box plot. #' @param hover_summary_var A character vector of statistics to be displayed #' on hover label of box. -#' @param hover_outlier_display A character vector of hover variable for outlier. #' @param hover_outlier_label A character vector of hover label for outlier. +#' A label from an input data is used if `NA` for a variable is specified. #' @param x_label x-axis label. #' @param y_label y-axis label. #' @param heading_select_list Select list menu label. @@ -55,7 +55,6 @@ boxly <- function(outdata, color = NULL, hover_summary_var = c("n", "min", "q1", "median", "mean", "q3", "max"), - hover_outlier_display = c("USUBJID", outdata$y_var), hover_outlier_label = c("Participant ID", "Parameter value"), x_label = "Visit", y_label = "Change", @@ -99,8 +98,8 @@ boxly <- function(outdata, # paste multiple hover_outlier_labels # Check length of variables and labels if (length(hover_outlier_label) > 0) { - if (!length(hover_outlier_display) == length(hover_outlier_label)) { - message("hover_outlier_display should have the same length as hover_outlier_label.") + if (!length(hover_var_outlier) == length(hover_outlier_label)) { + warning("The Length of hover labels should be same as that of hover variables.") } } @@ -118,8 +117,8 @@ boxly <- function(outdata, text <- NULL var <- NULL if (!is.na(x[["outlier"]])) { - for (i in seq(hover_outlier_display)) { - var <- hover_outlier_display[i] + for (i in seq(hover_var_outlier)) { + var <- hover_var_outlier[i] if (!is.null(hover_outlier_label)) { label <- ifelse(!is.na(hover_outlier_label[i]), hover_outlier_label[i], listing_label[var]) } else { diff --git a/R/prepare_boxly.R b/R/prepare_boxly.R index 7e29599..1cf3e53 100644 --- a/R/prepare_boxly.R +++ b/R/prepare_boxly.R @@ -25,7 +25,7 @@ #' The term name is used as key to link information. #' @param analysis A character value of analysis term name. #' The term name is used as key to link information. -#' @param hover_var_outlier A character vector of hover variable for outlier. +#' @param hover_var_outlier A character vector of hover variables for outlier. #' #' @return Metadata list with plotting dataset. #' @@ -80,7 +80,6 @@ prepare_boxly <- function(meta, pop_var <- metalite::collect_adam_mapping(meta, population)$var y <- metalite::collect_adam_mapping(meta, analysis)$y x <- metalite::collect_adam_mapping(meta, analysis)$x - # hover_outlier <- collect_adam_mapping(meta, analysis)$hover_outlier # Obtain Data pop <- metalite::collect_population_record(meta, population, var = pop_var) @@ -199,7 +198,7 @@ prepare_boxly <- function(meta, # Return value metalite::outdata(meta, population, observation, parameter, x_var = x, y_var = y, group_var = obs_group, - param_var = obs_var, + param_var = obs_var, hover_var_outlier = hover_var_outlier, n = n_tbl, order = NULL, group = NULL, reference_group = NULL, plotds = plotds ) diff --git a/man/boxly.Rd b/man/boxly.Rd index eab6128..56cd912 100644 --- a/man/boxly.Rd +++ b/man/boxly.Rd @@ -8,7 +8,6 @@ boxly( outdata, color = NULL, hover_summary_var = c("n", "min", "q1", "median", "mean", "q3", "max"), - hover_outlier_display = c("USUBJID", outdata$y_var), hover_outlier_label = c("Participant ID", "Parameter value"), x_label = "Visit", y_label = "Change", @@ -24,9 +23,8 @@ boxly( \item{hover_summary_var}{A character vector of statistics to be displayed on hover label of box.} -\item{hover_outlier_display}{A character vector of hover variable for outlier.} - -\item{hover_outlier_label}{A character vector of hover label for outlier.} +\item{hover_outlier_label}{A character vector of hover label for outlier. +A label from an input data is used if \code{NA} for a variable is specified.} \item{x_label}{x-axis label.} diff --git a/man/prepare_boxly.Rd b/man/prepare_boxly.Rd index 81f4dcf..d917fe3 100644 --- a/man/prepare_boxly.Rd +++ b/man/prepare_boxly.Rd @@ -24,7 +24,7 @@ The term name is used as key to link information.} \item{analysis}{A character value of analysis term name. The term name is used as key to link information.} -\item{hover_var_outlier}{A character vector of hover variable for outlier.} +\item{hover_var_outlier}{A character vector of hover variables for outlier.} } \value{ Metadata list with plotting dataset. From d1da467e26cabda8cde6659107cbeb0d85eb406b Mon Sep 17 00:00:00 2001 From: "Fukuda, Hiroaki" Date: Tue, 16 Apr 2024 22:09:12 -0400 Subject: [PATCH 4/4] Update based on `prepare_boxly()`. --- tests/testthat/test-independant-testing-prepare_boxly.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-independant-testing-prepare_boxly.R b/tests/testthat/test-independant-testing-prepare_boxly.R index 4a2dd96..79485a2 100644 --- a/tests/testthat/test-independant-testing-prepare_boxly.R +++ b/tests/testthat/test-independant-testing-prepare_boxly.R @@ -34,10 +34,11 @@ test_that("Its class is 'outdata'", { expect_equal(output$y_var, "CHG") expect_equal(output$group_var, "TRTA") expect_equal(output$param_var, "PARAM") + expect_equal(output$hover_var_outlier, c("USUBJID", "CHG")) expect_equal(output$parameter, meta$plan$parameter) expect_equal(output$order, NULL) expect_equal(output$group, NULL) - expect_equal(names(output), c("meta", "population", "observation", "parameter", "n", "order", "group", "reference_group", "x_var", "y_var", "group_var", "param_var", "plotds")) + expect_equal(names(output), c("meta", "population", "observation", "parameter", "n", "order", "group", "reference_group", "x_var", "y_var", "group_var", "param_var", "hover_var_outlier", "plotds")) expect_equal(names(output$meta), c("data_population", "data_observation", "plan", "observation", "population", "parameter", "analysis")) expect_equal(nrow(output$meta$data_population), nrow(meta$data_population)) expect_equal(nrow(output$meta$data_observation), nrow(meta$data_observation))