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.