goshawk coverage - 0.00%

Files
Source

#' Function to create a spaghetti plot.
#'
#' This function is rendered by teal.goshawk module
#'
#' @param data data frame with variables to be summarized and generate statistics which will display
#'  in the plot.
#' @param subj_id unique subject id variable name.
#' @param biomarker_var name of variable containing biomarker names.
#' @param biomarker_var_label name of variable containing biomarker labels.
#' @param biomarker biomarker name to be analyzed.
#' @param value_var name of variable containing biomarker results.
#' @param unit_var name of variable containing biomarker units.
#' @param trt_group name of variable representing treatment group.
#' @param trt_group_level vector that can be used to define the factor level of `trt_group`.
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
#' @param time name of variable containing visit names.
#' @param time_level vector that can be used to define the factor level of time. Only use it when
#' x-axis variable is character or factor.
#' @param color_manual vector of colors.
#' @param color_comb name or hex value for combined treatment color.
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param alpha subject line transparency (0 = transparent, 1 = opaque)
#' @param facet_ncol number of facets per row.
#' @param facet_scales passed to `scales` in [`ggplot2::facet_wrap`]. Should scales be fixed (`"fixed"`,
#' the default), free (`"free"`), or free in one dimension (`"free_x"`, `"free_y"`)?
#' @param xtick a vector to define the tick values of time in x-axis.
#' Default value is `ggplot2::waiver()`.
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values. Default
#'  value is `ggplot2::waiver()`.
#' @param rotate_xlab boolean whether to rotate x-axis labels.
#' @param font_size control font size for title, x-axis, y-axis and legend font.
#' @param dot_size plot dot size. Default to 2.
#' @param group_stats control group mean or median overlay.
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   The data inside of the `ggplot2` object must also contain the columns with these variable names
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
#'
#'
#' @author Wenyi Liu (wenyi.liu@roche.com)
#'
#' @return \code{ggplot} object
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
#' )
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
#'
#' ADLB <- rADLB
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD)) %>%
#'   mutate(ANRLO = .5, ANRHI = 1) %>%
#'   rowwise() %>%
#'   group_by(PARAMCD) %>%
#'   mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste("<", round(runif(1, min = .5, max = .7))), LBSTRESC
#'   )) %>%
#'   mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste(">", round(runif(1, min = .9, max = 1.2))), LBSTRESC
#'   )) %>%
#'   ungroup()
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
#'
#' # add LLOQ and ULOQ variables
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL")
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
#'
#' g_spaghettiplot(
#'   data = ADLB,
#'   subj_id = "USUBJID",
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   time = "AVISITCD",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   alpha = .02,
#'   xtick = c("BL", "W 1", "W 4"),
#'   xlabel = c("Baseline", "Week 1", "Week 4"),
#'   rotate_xlab = FALSE,
#'   group_stats = "median",
#'   hline_vars = c("ANRHI", "ANRLO"),
#'   hline_vars_colors = c("pink", "brown")
#' )
#'
#' g_spaghettiplot(
#'   data = ADLB,
#'   subj_id = "USUBJID",
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   time = "AVISITCD",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   alpha = .02,
#'   xtick = c("BL", "W 1", "W 4"),
#'   xlabel = c("Baseline", "Week 1", "Week 4"),
#'   rotate_xlab = FALSE,
#'   group_stats = "median",
#'   hline_arb = 1.3,
#'   hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'   hline_vars_colors = c("pink", "brown", "purple", "gray"),
#'   dot_size = 3
#' )
#'
#' g_spaghettiplot(
#'   data = ADLB,
#'   subj_id = "USUBJID",
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   time = "AVISITCDN",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   alpha = .02,
#'   xtick = c(0, 1, 4),
#'   xlabel = c("Baseline", "Week 1", "Week 4"),
#'   rotate_xlab = FALSE,
#'   group_stats = "median",
#'   hline_arb = c(.5, .7, 1),
#'   hline_arb_color = c("blue", "red", "green"),
#'   hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#'   hline_vars = c("ANRHI", "ANRLO"),
#'   dot_size = 4
#' )
#'
#' # removing missing levels from the plot with facet_scales
#'
#' g_spaghettiplot(
#'   data = ADLB,
#'   subj_id = "USUBJID",
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   time = "RACE",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   alpha = .02,
#'   facet_scales = "fixed",
#'   rotate_xlab = FALSE,
#'   group_stats = "median",
#'   hline_arb = c(.5, .7, 1),
#'   hline_arb_color = c("blue", "red", "green"),
#'   hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#'   hline_vars = c("ANRHI", "ANRLO")
#' )
#'
#' g_spaghettiplot(
#'   data = ADLB,
#'   subj_id = "USUBJID",
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   time = "RACE",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   alpha = .02,
#'   facet_scales = "free_x",
#'   rotate_xlab = FALSE,
#'   group_stats = "median",
#'   hline_arb = c(.5, .7, 1),
#'   hline_arb_color = c("blue", "red", "green"),
#'   hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#'   hline_vars = c("ANRHI", "ANRLO"),
#'   dot_size = 1
#' )
#'
g_spaghettiplot <- function(data,
                            subj_id = "USUBJID",
                            biomarker_var = "PARAMCD",
                            biomarker_var_label = "PARAM",
                            biomarker,
                            value_var = "AVAL",
                            unit_var = "AVALU",
                            trt_group,
                            trt_group_level = NULL,
                            loq_flag_var = "LOQFL",
                            time,
                            time_level = NULL,
                            color_manual = NULL,
                            color_comb = "#39ff14",
                            ylim = c(NA, NA),
                            alpha = 1.0,
                            facet_ncol = 2,
                            facet_scales = c("fixed", "free", "free_x", "free_y"),
                            xtick = ggplot2::waiver(),
                            xlabel = xtick,
                            rotate_xlab = FALSE,
                            font_size = 12,
                            dot_size = 2,
                            group_stats = "NONE",
                            hline_arb = numeric(0),
                            hline_arb_color = "red",
                            hline_arb_label = "Horizontal line",
                            hline_vars = character(0),
                            hline_vars_colors = "green",
                            hline_vars_labels = hline_vars) {
  checkmate::assert_numeric(ylim, len = 2)
  facet_scales <- match.arg(facet_scales)

  ## Pre-process data
  label_trt_group <- attr(data[[trt_group]], "label")
  data[[trt_group]] <- if (!is.null(trt_group_level)) {
    factor(data[[trt_group]], levels = trt_group_level)
  } else {
    factor(data[[trt_group]])
  }
  attr(data[[trt_group]], "label") <- label_trt_group


  xtype <- ifelse(is.factor(data[[time]]) | is.character(data[[time]]), "discrete", "continuous")
  gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")
  if (xtype == "discrete") {
    data[[time]] <- if (!is.null(time_level)) {
      factor(data[[time]], levels = time_level)
    } else {
      factor(data[[time]])
    }
  }

  # Plot
  plot_data <- data %>%
    filter(!!sym(biomarker_var) %in% biomarker)
  unit <- plot_data %>%
    select(!!sym(unit_var)) %>%
    unique() %>%
    magrittr::extract2(1)
  unit1 <- ifelse(is.na(unit) | unit == "", " ", paste0(" (", unit, ") "))
  biomarker1 <- plot_data %>%
    select(!!sym(biomarker_var_label)) %>%
    unique() %>%
    magrittr::extract2(1)
  gtitle <- paste0(biomarker1, unit1, " Values by Treatment @ Visits")
  gylab <- paste0(biomarker1, " ", value_var, " Values")

  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))

  # Add footnote to identify LLOQ and ULOQ values pulled from data
  caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var)

  plot <- ggplot2::ggplot(
    data = plot_data,
    ggplot2::aes(x = !!sym(time), y = !!sym(value_var), color = !!sym(trt_group), group = !!sym(subj_id))
  ) +
    ggplot2::geom_point(size = dot_size, na.rm = TRUE, ggplot2::aes(shape = !!sym(loq_flag_var))) +
    ggplot2::geom_line(linewidth = 0.4, alpha = alpha, na.rm = TRUE) +
    ggplot2::facet_wrap(trt_group, ncol = facet_ncol, scales = facet_scales) +
    ggplot2::labs(caption = caption_loqs_label) +
    ggplot2::theme_bw() +
    ggplot2::ggtitle(gtitle) +
    ggplot2::xlab(gxlab) +
    ggplot2::ylab(gylab) +
    ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin(), hjust = 0.5))

  # Apply y-axis zoom range
  plot <- plot + ggplot2::coord_cartesian(ylim = ylim)

  # add group statistics
  # can't use stat_summary() because of presenting values for groups with all missings
  if (group_stats != "NONE") {
    if (group_stats == "MEAN") {
      plot_data_groupped <- plot_data %>%
        group_by(!!sym(trt_group), !!sym(time)) %>%
        transmute(AGG_VAL = mean(!!sym(value_var), na.rm = TRUE))

      plot_data_groupped$metric <- "Mean"
    } else {
      plot_data_groupped <- plot_data %>%
        group_by(!!sym(trt_group), !!sym(time)) %>%
        transmute(AGG_VAL = stats::median(!!sym(value_var), na.rm = TRUE))

      plot_data_groupped$metric <- "Median"
    }
    plot <- plot +
      ggplot2::geom_line(
        ggplot2::aes(x = !!sym(time), y = .data$AGG_VAL, group = 1, linetype = .data$metric),
        data = plot_data_groupped,
        lwd = 1,
        color = color_comb,
        na.rm = TRUE
      ) +
      ggplot2::guides(linetype = ggplot2::guide_legend("Group statistic", order = 2))
  }
  # Format x-label
  if (xtype == "continuous") {
    plot <- plot +
      ggplot2::scale_x_continuous(breaks = xtick, labels = xlabel, limits = c(NA, NA))
  } else if (xtype == "discrete") {
    plot <- plot +
      ggplot2::scale_x_discrete(breaks = xtick, labels = xlabel)
  }
  if (rotate_xlab) {
    plot <- plot +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }
  # Add manual color
  if (!is.null(color_manual)) {
    plot <- plot +
      ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
  } else {
    plot +
      ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
  }


  # Format font size
  if (!is.null(font_size)) {
    plot <- plot +
      ggplot2::theme(
        plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin()),
        axis.title.x = ggplot2::element_text(size = font_size),
        axis.text.x = ggplot2::element_text(size = font_size),
        axis.title.y = ggplot2::element_text(size = font_size),
        axis.text.y = ggplot2::element_text(size = font_size),
        legend.title = ggplot2::element_text(size = font_size),
        legend.text = ggplot2::element_text(size = font_size),
        strip.text.x = ggplot2::element_text(size = font_size),
        strip.text.y = ggplot2::element_text(size = font_size)
      )
  }
  # Add horizontal line for range based on option
  plot + geom_axes_lines(
    plot_data,
    hline_arb = hline_arb,
    hline_arb_color = hline_arb_color,
    hline_arb_label = hline_arb_label,
    hline_vars = hline_vars,
    hline_vars_colors = hline_vars_colors,
    hline_vars_labels = hline_vars_labels
  )
}

#' Function to create a scatter plot.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#'  `g_scatterplot()` is deprecated. Please use
#'  [g_correlationplot()] instead. Default plot displays scatter facetted by
#'  visit with color attributed treatment arms and symbol attributed `LOQ` values.
#'
#' @param label text string to used to identify plot.
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param biomarker to visualize e.g. `IGG`.
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`.
#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis e.g. `AVAL`.
#' @param trt_group name of variable representing treatment group e.g. `ARM`.
#' @param visit name of variable containing nominal visits e.g. `AVISITCD`.
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
#'   if the default limits are not suitable.
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param color_manual vector of colors applied to treatment values.
#' @param shape_manual vector of symbols applied to `LOQ` values.
#' @param facet_ncol number of facets per row.
#' @param facet set layout to use treatment facetting.
#' @param facet_var variable to use for treatment facetting.
#' @param reg_line include regression line and annotations for slope and coefficient in
#' visualization. Use with facet = TRUE.
#' @param hline y-axis value to position a horizontal line.
#' @param vline x-axis value to position a vertical line.
#' @param rotate_xlab 45 degree rotation of x-axis label values.
#' @param font_size font size control for title, x-axis label, y-axis label and legend.
#' @param dot_size plot dot size.
#' @param reg_text_size font size control for regression line annotations.
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @details Regression uses `deming` model.
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
#' )
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA"
#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)
#'
#' ADLB <- rADLB
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD))
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#'
#' g_scatterplot(
#'   label = "Scatter Plot",
#'   data = ADLB,
#'   param_var = "PARAMCD",
#'   param = c("ALT"),
#'   xaxis_var = "BASE",
#'   yaxis_var = "AVAL",
#'   trt_group = "ARM",
#'   visit = "AVISITCD",
#'   loq_flag_var = "LOQFL",
#'   unit = "AVALU",
#'   color_manual = color_manual,
#'   shape_manual = shape_manual,
#'   facet_ncol = 2,
#'   facet = TRUE,
#'   facet_var = "ARM",
#'   reg_line = TRUE,
#'   hline = NULL,
#'   vline = .5,
#'   rotate_xlab = TRUE,
#'   font_size = 14,
#'   dot_size = 2,
#'   reg_text_size = 3
#' )
g_scatterplot <- function(label = "Scatter Plot",
                          data,
                          param_var = "PARAMCD",
                          param = "CRP",
                          xaxis_var = "BASE",
                          yaxis_var = "AVAL",
                          trt_group = "ARM",
                          visit = "AVISITCD",
                          loq_flag_var = "LOQFL",
                          unit = "AVALU",
                          xlim = c(NA, NA),
                          ylim = c(NA, NA),
                          color_manual = NULL,
                          shape_manual = NULL,
                          facet_ncol = 2,
                          facet = FALSE,
                          facet_var = "ARM",
                          reg_line = FALSE,
                          hline = NULL,
                          vline = NULL,
                          rotate_xlab = FALSE,
                          font_size = 12,
                          dot_size = NULL,
                          reg_text_size = 3) {
  lifecycle::deprecate_soft(
    when = "0.1.15",
    what = "g_scatterplot()",
    details = "You should use goshawk::g_correlationplot instead of goshawk::g_scatterplot"
  )

  checkmate::assert_numeric(xlim, len = 2)
  checkmate::assert_numeric(ylim, len = 2)

  # create scatter plot over time pairwise per treatment arm
  plot_data <- data %>%
    filter(!!sym(param_var) == param)
  # Setup the ggtitle label.  Combine the biomarker and the units (if available)
  ggtitle_label <- ifelse(is.null(unit), paste0(plot_data$PARAM, "@ Visits"),
    ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, "@ Visits"),
      paste0(plot_data$PARAM, " (", plot_data[[unit]], ") @ Visits")
    )
  )
  # Setup the x-axis label.  Combine the biomarker and the units (if available)
  x_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, xaxis_var, "Values"),
    ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, xaxis_var, "Values"),
      paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values")
    )
  )
  # Setup the y-axis label.  Combine the biomarker and the units (if available)
  y_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, yaxis_var, "Values"),
    ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, yaxis_var, "Values"),
      paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", yaxis_var, " Values")
    )
  )
  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
  # create plot foundation
  plot1 <- ggplot2::ggplot(
    data = plot_data,
    ggplot2::aes(
      x = !!sym(xaxis_var),
      y = !!sym(yaxis_var),
      color = !!sym(trt_group)
    )
  ) +
    ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE) +
    ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
    ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol) +
    ggplot2::theme_bw() +
    ggplot2::ggtitle(ggtitle_label) +
    ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
    ggplot2::xlab(x_axis_label) +
    ggplot2::ylab(y_axis_label)
  # add grid faceting to foundation
  if (facet) {
    plot1 <- plot1 +
      ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit)))
  }
  # add regression line
  if (reg_line) {
    slope <- function(x, y) {
      ratio <- stats::sd(x) / stats::sd(y)
      res <- if (!is.na(ratio) && ratio > 0) {
        reg <- mc.deming(y, x, ratio)
        # return the evaluation of the ratio condition as third value in numeric vector
        # for conttroling downstream processing
        c(
          round(reg$b0, 2), round(reg$b1, 2),
          ifelse(!is.na(ratio) && ratio > 0, stats::cor(y, x, method = "spearman", use = "complete.obs"), NA_real_)
        )
      } else {
        # if ratio condition is not met then assign NA to returned vector
        # so that NULL condition does not throw error below
        as.numeric(c(NA, NA, NA))
      }
      return(as_tibble(stats::setNames(as.list(res), c("intercept", "slope", "corr"))))
    }
    sub_data <- plot_data %>%
      select(!!sym(trt_group), !!sym(visit), !!sym(xaxis_var), !!sym(yaxis_var)) %>%
      filter(!is.na(!!sym(yaxis_var)) & !is.na(!!sym(xaxis_var))) %>%
      group_by(!!sym(trt_group), !!sym(visit)) %>%
      do(slope(.data[[yaxis_var]], .data[[xaxis_var]]))

    if (!(all(is.na(sub_data$intercept)) && all(is.na(sub_data$slope)))) {
      plot1 <- plot1 +
        ggplot2::geom_abline(
          data = sub_data,
          # has to put some neutral values for missings, i.e. big & negative intercept + 0 slope
          ggplot2::aes(
            intercept = vapply(.data$intercept, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = -9999),
            slope = vapply(.data$slope, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = 0),
            color = !!sym(trt_group)
          )
        )
    }
    plot1 <- plot1 +
      ggplot2::geom_text(
        data = filter(sub_data, row_number() == 1),
        ggplot2::aes(
          x = -Inf,
          y = Inf,
          hjust = 0,
          vjust = 1,
          label = ifelse(
            !is.na(.data$intercept) & !is.na(.data$slope) & !is.na(.data$corr),
            sprintf("y = %.2f+%.2fX\ncor = %.2f", .data$intercept, .data$slope, .data$corr),
            paste0("Insufficient Data For Regression")
          ),
          color = !!sym(trt_group)
        ),
        size = reg_text_size
      ) +
      ggplot2::labs(caption = paste("Deming Regression Model, Spearman Correlation Method"))
  }
  # Add abline
  if (yaxis_var %in% c("AVAL", "AVALL2", "BASE2", "BASE2L2", "BASE", "BASEL2")) {
    plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 1)
  }
  if (yaxis_var %in% c("CHG2", "CHG")) {
    plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 0)
  }
  if (yaxis_var %in% c("PCHG2", "PCHG")) {
    plot1 <- plot1 + ggplot2::geom_abline(intercept = 100, slope = 0)
  }
  # Format font size
  if (!is.null(font_size)) {
    plot1 <- plot1 +
      ggplot2::theme(
        axis.title.x = ggplot2::element_text(size = font_size),
        axis.text.x = ggplot2::element_text(size = font_size),
        axis.title.y = ggplot2::element_text(size = font_size),
        axis.text.y = ggplot2::element_text(size = font_size),
        legend.title = ggplot2::element_text(size = font_size),
        legend.text = ggplot2::element_text(size = font_size),
        strip.text.x = ggplot2::element_text(size = font_size),
        strip.text.y = ggplot2::element_text(size = font_size)
      )
  }
  # Format treatment color
  if (!is.null(color_manual)) {
    plot1 <- plot1 +
      ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
  } else {
    plot1 +
      ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
  }

  # Format LOQ flag symbol shape
  if (!is.null(shape_manual)) {
    plot1 <- plot1 +
      ggplot2::scale_shape_manual(values = shape_manual, name = "LOQ")
  }
  # Format dot size
  if (!is.null(dot_size)) {
    plot1 <- plot1 +
      ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE)
  }
  # Format x-label
  if (rotate_xlab) {
    plot1 <- plot1 +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }
  # Add horizontal line
  if (!is.null(hline)) {
    plot1 <- plot1 +
      ggplot2::geom_hline(ggplot2::aes(yintercept = hline), color = "red", linetype = "dashed", size = 0.5)
  }
  # Add vertical line
  if (!is.null(vline)) {
    plot1 <- plot1 +
      ggplot2::geom_vline(ggplot2::aes(xintercept = vline), color = "red", linetype = "dashed", size = 0.5)
  }
  plot1
}

#' Helper for identifying any `LLOQ` and `ULOQ` values in `LBSTRESC`. Outcome drives
#' horizontal line functionality display and legend labeling along with display
#' of values in footnote.
#'
#' @details Biomarker Sciences would like to have `LLOQ` and `ULOQ` values available for
#' reference in the visualizations. This also aids in setting the data constraint
#' ranges when `goshawk` functions are run from `teal.goshawk` `UI`.
#'
#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values
#'
#' @import dplyr
#' @keywords internal
#'
#' @examples
#' goshawk:::h_identify_loq_values(loqs_data = goshawk::rADLB, flag_var = "LOQFL")
h_identify_loq_values <- function(loqs_data, flag_var) {
  ifelse(
    !grep("PARAM", names(loqs_data)),
    stop("Assay dataset must include variable PARAM to use the caption_loqs_label function."),
    1
  )
  ifelse(
    !grep("LBSTRESC", names(loqs_data)),
    stop("Assay dataset must include variable LBSTRESC to use the caption_loqs_label function."),
    1
  )

  # filter for records only relevant to loq.
  # get LLOQ value
  lloq <- loqs_data %>%
    filter(!!sym(flag_var) == "Y") %>%
    select("PARAM", "LBSTRESC") %>%
    filter(grepl("<", .data$LBSTRESC, fixed = FALSE)) %>%
    mutate(LLOQC = .data$LBSTRESC, LLOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>%
    group_by(.data$PARAM) %>%
    slice(1) %>%
    ungroup() %>%
    select(-"LBSTRESC")


  # get ULOQ value
  uloq <- loqs_data %>%
    filter(!!sym(flag_var) == "Y") %>%
    select("PARAM", "LBSTRESC") %>%
    filter(grepl(">", .data$LBSTRESC, fixed = FALSE)) %>%
    mutate(ULOQC = .data$LBSTRESC, ULOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>%
    group_by(.data$PARAM) %>%
    slice(1) %>%
    ungroup() %>%
    select(-"LBSTRESC")


  # return LOQ data
  loq_values <- merge(lloq, uloq, by = "PARAM", all = TRUE)
  if (nrow(loq_values) == 0) {
    loq_values <- data.frame(
      PARAM = names(table(droplevels(as.factor(loqs_data$PARAM)))),
      LLOQC = NA,
      LLOQN = NA,
      ULOQC = NA,
      ULOQN = NA
    )
  }

  attr(loq_values[["PARAM"]], "label") <- "Parameter"
  attr(loq_values[["LLOQC"]], "label") <- "Lower Limit of Quantitation (C)"
  attr(loq_values[["LLOQN"]], "label") <- "Lower Limit of Quantitation"
  attr(loq_values[["ULOQC"]], "label") <- "Upper Limit of Quantitation (C)"
  attr(loq_values[["ULOQN"]], "label") <- "Upper Limit of Quantitation"

  return(loq_values)
}

#' Add footnote to identify `LLOQ` and `ULOQ` values identified from data
#'
#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values
#'
#' @import dplyr
#' @keywords internal
#'
#' @examples
#' caption_label <- goshawk:::h_caption_loqs_label(loqs_data = goshawk::rADLB, flag_var = "LOQFL")
h_caption_loqs_label <- function(loqs_data, flag_var) {
  loq_values <- h_identify_loq_values(loqs_data, flag_var)

  lloqc <- ifelse(is.na(loq_values$LLOQC), "NA", as.character(loq_values$LLOQC))
  uloqc <- ifelse(is.na(loq_values$ULOQC), "NA", as.character(loq_values$ULOQC))

  # create caption
  caption_loqs_label <- paste0(
    "Limits of quantification read from study data for ",
    loqs_data$PARAM,
    ": LLOQ is ",
    lloqc,
    ", ULOQ is ",
    uloqc
  )

  return(caption_loqs_label)
}

#' Check that argument is a valid color
#'
#' Checks if the argument can be converted to valid RGB values space. See `grDevices::col2rgb`.
#'
#' @inheritParams checkmate::checkCharacter
#' @param color (`character`)\cr
#'  Valid color convertible to RGB scale by [grDevices::col2rgb()]
#'
#' @inherit checkmate::checkCharacter return
#' @keywords internal
check_color <- function(color,
                        min.len = NULL, # nolint
                        max.len = NULL, # nolint
                        any.missing = TRUE, # nolint
                        all.missing = TRUE, # nolint
                        len = NULL,
                        null.ok = FALSE) { # nolint
  string_check <- checkmate::check_character(
    color,
    min.len = min.len, max.len = max.len, any.missing = any.missing, len = len, null.ok = null.ok
  )
  if (!isTRUE(string_check)) {
    return(string_check)
  }

  res <- sapply(color, function(col) {
    tryCatch(
      is.matrix(grDevices::col2rgb(col)),
      error = function(e) FALSE
    )
  })

  if (any(!res)) {
    "Must be a valid color, convertible to rgb by 'col2rgb'"
  } else {
    TRUE
  }
}

#' @rdname check_color
assert_color <- checkmate::makeAssertionFunction(check_color)

#' Add horizontal and/or vertical lines and their legend labels to a plot
#'
#' This function is currently designed to be used with \code{\link{g_boxplot}}, \code{\link{g_correlationplot}},
#' \code{\link{g_spaghettiplot}}, and ('g_density_distribution_plot'), but may also work in general.
#'
#' @param data ('data.frame') data where `hline_vars` and `vline_var` columns are taken from.
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   Needs `data` to be specified.
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines.
#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines.
#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines.
#' @param vline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   Needs `data` to be specified.
#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables.
#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables.
#'
#' @examples
#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) +
#'   ggplot2::geom_point() +
#'   goshawk:::geom_axes_lines(
#'     hline_arb = c(20, 25, 30),
#'     hline_arb_color = "red",
#'     hline_arb_label = "Hori Line"
#'   )
#' @return \code{ggplot} object
#' @keywords internal
#'
geom_axes_lines <- function(data,
                            hline_arb = numeric(0),
                            hline_arb_color = "red",
                            hline_arb_label = "Horizontal line",
                            hline_vars = character(0),
                            hline_vars_colors = "green",
                            hline_vars_labels = hline_vars,
                            vline_arb = numeric(0),
                            vline_arb_color = "red",
                            vline_arb_label = "Vertical line",
                            vline_vars = character(0),
                            vline_vars_colors = "green",
                            vline_vars_labels = vline_vars) {
  arb_hlines <- if (length(hline_arb) > 0) {
    geom_arb_hline(
      yintercept = hline_arb,
      color = hline_arb_color,
      label = hline_arb_label,
      legend_title = "Horizontal arbitrary line(s)",
      linetype = 2
    )
  }

  range_hlines <- if (length(hline_vars > 0)) {
    geom_range_hline(
      data = data,
      vars = hline_vars,
      color = hline_vars_colors,
      label = hline_vars_labels,
      linetype = 2
    )
  }

  arb_vlines <- if (length(vline_arb) > 0) {
    geom_arb_vline(
      xintercept = vline_arb,
      color = vline_arb_color,
      label = vline_arb_label,
      legend_title = "Vertical arbitrary line(s)",
      linetype = 2
    )
  }

  range_vlines <- if (length(vline_vars) > 0) {
    geom_range_vline(
      data = data,
      vars = vline_vars,
      color = vline_vars_colors,
      label = vline_vars_labels,
      linetype = 2
    )
  }

  Filter(
    function(x) !is.null(x) || !is.na(x),
    list(
      arb_hlines,
      range_hlines,
      arb_vlines,
      range_vlines
    )
  )
}

#' Validate line arguments given in the parameters against the data.
#'
#' helper function to be called by [geom_axes_lines()]
#'
#' @param data (`data.frame`)\cr
#'  should contain `vars` which will be used to create the plot.
#' @param vars (`character`)\cr
#'  names of variables to take the values from. Only first value from the variable will be
#'  applied.
#' @param color (`character`)\cr
#'  colors for the lines defined by variables.
#' @param label (`character`)\cr
#'  labels for the legend to the lines defined by variables.
#'
#' @return (`data.frame`) containing the `values`,`colors` and `labels` fields defining attributes
#'  for horizontal or vertical lines.
#' @keywords internal
#'
validate_line_args <- function(data,
                               vars = character(0),
                               color = "green",
                               label = vars) {
  if (length(vars) > 0) {
    stopifnot(all(vars %in% names(data)))
    checkmate::assert_data_frame(data[vars], types = "numeric")
    checkmate::assert(
      check_color(color, len = 1),
      check_color(color, len = length(vars))
    )
    checkmate::assert_character(label, len = length(vars))


    label <- vapply(
      vars,
      FUN.VALUE = character(1),
      USE.NAMES = FALSE,
      FUN = function(x) {
        if (is.null(attributes(data[[x]])$label)) {
          x
        } else {
          attributes(data[[x]])$label
        }
      }
    )

    vars <- sapply(
      vars,
      USE.NAMES = FALSE,
      function(name) {
        x <- data[[name]]
        vals <- unique(x)
        if (!checkmate::test_number(vals)) {
          warning(sprintf("First value is taken from variable '%s' to draw the straight line", name))
        }
        vals[1]
      }
    )
  } else {
    vars <- numeric(0)
    color <- character(0)
    label <- character(0)
  }

  data.frame(
    values = vars,
    colors = color,
    labels = label
  )
}

#' Straight lines for `ggplot2`
#'
#' Arbitrary lines for `ggplot2`
#' @name geom_straight_lines
#' @param vars (`character`)\cr
#'  names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#' @param xintercept (`numeric`)\cr
#'  Position of the vertical line(s) on the x-axis
#' @param yintercept (`numeric`)\cr
#'  Position of the horizontal line(s) on the y-axis
#' @param label (`character`)\cr
#'  Label to be rendered in the legend.
#'  Should be a single string or vector of length equal to length of `xintercept`.
#' @param color (`character`)\cr
#'  Valid color convertible to RGB scale by [grDevices::col2rgb()].
#'  Should be a single string or vector of length equal to length of `xintercept`.
#'
#' @inherit ggplot2::geom_hline return
#'
#' @keywords internal
#'
NULL

#' @rdname geom_straight_lines
#' @examples
#' # horizontal arbitrary lines
#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5))
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
#'   ggplot2::geom_point() +
#'   goshawk:::geom_arb_hline(
#'     yintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2
#'   )
geom_arb_hline <- function(yintercept,
                           label = "Horizontal line",
                           color = "red",
                           legend_title = "Horizontal line(s)",
                           ...) {
  checkmate::assert_numeric(yintercept, min.len = 1)
  checkmate::assert(
    check_color(color, len = 1),
    check_color(color, len = length(yintercept))
  )
  checkmate::assert(
    checkmate::check_string(label),
    checkmate::check_character(label, len = length(yintercept))
  )
  data <- data.frame(yintercept, color, label, color_var = paste(color, label))

  list(
    ggnewscale::new_scale_color(),
    ggplot2::geom_hline(
      data = data,
      mapping = ggplot2::aes(
        yintercept = yintercept,
        color = .data[["color_var"]], # need legend entry for each color-label combination
      ),
      ...
    ),
    ggplot2::scale_color_manual(
      name = legend_title,
      values = stats::setNames(data$color, data$color_var),
      labels = data$label,
      limits = data$color_var,
      guide = ggplot2::guide_legend(order = 11) # high order to be put after main plot items
    )
  )
}

#' @rdname geom_straight_lines
#' @examples
#' # vertical arbitrary lines
#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5))
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
#'   ggplot2::geom_point() +
#'   goshawk:::geom_arb_vline(
#'     xintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2
#'   )
geom_arb_vline <- function(xintercept,
                           label = "Vertical line",
                           color = "red",
                           legend_title = "Vertical line(s)",
                           ...) {
  checkmate::assert_numeric(xintercept, min.len = 1)
  checkmate::assert(
    check_color(color, len = 1),
    check_color(color, len = length(xintercept))
  )
  checkmate::assert(
    checkmate::check_character(label, len = 1),
    checkmate::check_character(label, len = length(xintercept))
  )

  data <- data.frame(xintercept, color, label, color_var = paste(color, label))

  list(
    ggnewscale::new_scale_color(),
    ggplot2::geom_vline(
      data = data,
      mapping = ggplot2::aes(
        xintercept = xintercept,
        color = .data[["color_var"]], # need legend entry for each color-label combination
      ),
      ...
    ),
    ggplot2::scale_color_manual(
      name = legend_title,
      values = stats::setNames(data$color, data$color_var),
      labels = data$label,
      limits = data$color_var,
      guide = ggplot2::guide_legend(order = 12) # high order to be put after main plot items
    )
  )
}


#' @rdname geom_straight_lines
#' @examples
#' # horizontal range
#'
#' data <- data.frame(
#'   x = seq_len(10),
#'   y = seq_len(10),
#'   color = rep(c("a", "b"), each = 5),
#'   lower = rep(c(2, 3), each = 5),
#'   upper = rep(c(7, 8), each = 5)
#' )
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
#'   ggplot2::geom_point() +
#'   goshawk:::geom_range_hline(
#'     vars = c("lower", "upper"),
#'     data = data.frame(lower = 2, upper = 7),
#'     color = "blue",
#'     linetype = 2
#'   )
geom_range_hline <- function(vars,
                             data,
                             color = "green",
                             label = vars,
                             legend_title = "Horizontal range line(s)",
                             ...) {
  line_data <- validate_line_args(
    data = data,
    vars = vars,
    label = label,
    color = color
  )
  geom_arb_hline(
    yintercept = line_data$values,
    label = line_data$labels,
    color = line_data$colors,
    legend_title = legend_title,
    ...
  )
}

#' @rdname geom_straight_lines
#' @examples
#' # vertical range
#' data <- data.frame(
#'   x = seq_len(10),
#'   y = seq_len(10),
#'   color = rep(c("a", "b"), each = 5),
#'   lower = rep(c(2, 3), each = 5),
#'   upper = rep(c(7, 8), each = 5)
#' )
#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
#'   ggplot2::geom_point() +
#'   goshawk:::geom_range_vline(
#'     vars = c("lower", "upper"),
#'     data = data.frame(lower = 2, upper = 7),
#'     color = "blue",
#'     linetype = 2
#'   )
geom_range_vline <- function(vars,
                             data,
                             color = "green",
                             label = vars,
                             legend_title = "Vertical range line(s)",
                             ...) {
  line_data <- validate_line_args(
    data = data,
    vars = vars,
    label = label,
    color = color
  )
  geom_arb_vline(
    xintercept = line_data$values,
    label = line_data$labels,
    color = line_data$colors,
    legend_title = legend_title,
    ...
  )
}

#' Function to create a boxplot.
#'
#' A box plot is a method for graphically depicting groups of numerical data
#' through their quartiles. Box plots may also have lines extending vertically
#' from the boxes (whiskers) indicating variability outside the upper and lower
#' quartiles, hence the term box-and-whisker. Outliers may be plotted as
#' individual points. Box plots are non-parametric: they display variation in
#' samples of a statistical population without making any assumptions of the
#' underlying statistical distribution. The spacings between the different parts
#' of the box indicate the degree of dispersion (spread) and skewness in the
#' data, and show outliers. In addition to the points themselves, they allow one
#' to visually estimate various L-estimators, notably the interquartile range,
#' midhinge, range, mid-range, and trimean.
#'
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
#' @param biomarker biomarker to visualize e.g. `IGG`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param yaxis_var name of variable containing biomarker results displayed on
#'   Y-axis e.g. `AVAL`.
#' @param trt_group name of variable representing treatment `trt_group` e.g. `ARM`.
#' @param loq_flag_var  name of variable containing `LOQ` flag e.g. `LOQFL`.
#' @param loq_legend `logical` whether to include `LoQ` legend.
#' @param unit biomarker unit label e.g. (U/L)
#' @param color_manual vector of color for `trt_group`
#' @param shape_manual vector of shapes (used with `loq_flag_var`)
#' @param box add boxes to the plot (boolean)
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param facet_var variable to facet the plot by, or `"None"` if no faceting
#'   required.
#' @param xaxis_var variable used to group the data on the x-axis.
#' @param facet_ncol number of facets per row.  NULL = Use the default for `ggplot2::facet_wrap`
#' @param rotate_xlab 45 degree rotation of x-axis label values.
#' @param font_size point size of text to use.  NULL is use default size
#' @param dot_size plot dot size.
#' @param alpha dot transparency (0 = transparent, 1 = opaque)
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   The data inside of the `ggplot2` object must also contain the columns with these variable names
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
#'
#' @author Balazs Toth
#' @author Jeff Tomlinson (tomlinsj) jeffrey.tomlinson@roche.com
#'
#' @return \code{ggplot} object
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(nestcolor)
#'
#' ADLB <- rADLB
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = stringr::str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   mutate(ANRLO = .5, ANRHI = 1) %>%
#'   rowwise() %>%
#'   group_by(PARAMCD) %>%
#'   mutate(LBSTRESC = ifelse(
#'     USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste("<", round(runif(1, min = .5, max = 1))), LBSTRESC
#'   )) %>%
#'   mutate(LBSTRESC = ifelse(
#'     USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste(">", round(runif(1, min = 1, max = 1.5))), LBSTRESC
#'   )) %>%
#'   ungroup()
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
#'
#' # add LLOQ and ULOQ variables
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL")
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
#'
#' g_boxplot(ADLB,
#'   biomarker = "CRP",
#'   param_var = "PARAMCD",
#'   yaxis_var = "AVAL",
#'   trt_group = "ARM",
#'   loq_flag_var = "LOQFL",
#'   loq_legend = FALSE,
#'   unit = "AVALU",
#'   shape_manual = c("N" = 1, "Y" = 2, "NA" = NULL),
#'   facet_var = "AVISIT",
#'   xaxis_var = "STUDYID",
#'   alpha = 0.5,
#'   rotate_xlab = TRUE,
#'   hline_arb = c(.9, 1.2),
#'   hline_arb_color = "blue",
#'   hline_arb_label = "Hori_line_label",
#'   hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'   hline_vars_colors = c("pink", "brown", "purple", "gray"),
#'   hline_vars_labels = c("A", "B", "C", "D")
#' )
g_boxplot <- function(data,
                      biomarker,
                      param_var = "PARAMCD",
                      yaxis_var,
                      trt_group,
                      xaxis_var = NULL,
                      loq_flag_var = "LOQFL",
                      loq_legend = TRUE,
                      unit = NULL,
                      color_manual = NULL,
                      shape_manual = NULL,
                      box = TRUE,
                      ylim = c(NA, NA),
                      dot_size = 2,
                      alpha = 1.0,
                      facet_ncol = NULL,
                      rotate_xlab = FALSE,
                      font_size = NULL,
                      facet_var = NULL,
                      hline_arb = numeric(0),
                      hline_arb_color = "red",
                      hline_arb_label = "Horizontal line",
                      hline_vars = character(0),
                      hline_vars_colors = "green",
                      hline_vars_labels = hline_vars) {
  if (is.null(data[[param_var]])) {
    stop(paste("param_var", param_var, "is not in data."))
  }

  if (!any(data[[param_var]] == biomarker)) {
    stop(paste("biomarker", biomarker, "is not found in param_var", param_var, "."))
  }
  checkmate::assert_flag(loq_legend)
  checkmate::assert_number(dot_size)
  checkmate::assert_numeric(ylim, len = 2)

  # filter input data
  data <- data %>%
    filter(!!sym(param_var) == biomarker)

  if (!is.null(unit)) {
    # check unit is in the dataset
    if (is.null(data[[unit]])) {
      stop(paste("unit variable", unit, "is not in data."))
    }
    # extract the most common unit
    # if there are ties, take the use alphabetic order
    tmp_unit <- data %>%
      count(!!sym(unit)) %>%
      top_n(1, n) %>%
      arrange(!!sym(unit)) %>%
      slice(1) %>%
      select(!!sym(unit)) %>%
      as.character()
    if (is.factor(data[[unit]])) {
      unit <- levels(data[[unit]])[as.numeric(tmp_unit)]
    } else {
      unit <- tmp_unit
    }
  }
  # Setup the Y axis label.  Combine the biomarker and the units (if available)
  y_axis_label <- ifelse(is.null(unit), paste(data$PARAM[1], yaxis_var, "Values"),
    ifelse(unit == "", paste(data$PARAM[1], yaxis_var, "Values"),
      paste0(data$PARAM[1], " (", unit, ") ", yaxis_var, " Values")
    )
  )
  # Setup the ggtitle label.  Combine the biomarker and the units (if available)
  ggtitle_label <- ifelse(is.null(unit), paste(data$PARAM[1], "Distribution by Treatment @ Visits"),
    ifelse(unit == "", paste(data$PARAM[1], "Distribution by Treatment @ Visits"),
      paste0(data$PARAM[1], " (", unit, ") Distribution by Treatment @ Visits")
    )
  )
  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))

  # add footnote to identify LLOQ and ULOQ values pulled from data
  caption_loqs_label <- h_caption_loqs_label(loqs_data = data, flag_var = loq_flag_var)
  # Base plot
  plot1 <- ggplot2::ggplot(data)
  # Add boxes if required
  if (box) {
    plot1 <- plot1 +
      ggplot2::geom_boxplot(
        data = data,
        ggplot2::aes(
          x = !!sym(xaxis_var),
          y = !!sym(yaxis_var),
          fill = NULL
        ),
        outlier.shape = NA,
        na.rm = TRUE
      )
  }
  # Extend is.infinite to include zero length objects.
  is_finite <- function(x) {
    if (length(x) == 0) {
      return(FALSE)
    }
    return(is.finite(x))
  }

  plot1 <- plot1 +
    ggplot2::labs(color = trt_label, x = NULL, y = y_axis_label, caption = caption_loqs_label) +
    ggplot2::theme_bw() +
    ggplot2::ggtitle(ggtitle_label) +
    ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5))
  # Colors supplied?  Use color_manual, otherwise default ggplot coloring.
  plot1 <- if (!is.null(color_manual)) {
    plot1 +
      ggplot2::scale_color_manual(values = color_manual, guide = ggplot2::guide_legend(order = 1))
  } else {
    plot1 +
      ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
  }

  # Format LOQ flag symbol shape
  if (is.null(shape_manual)) {
    shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]])
    shape_manual <- seq_along(shape_names)
    names(shape_manual) <- shape_names
  }
  # add LOQ legend conditionally
  plot1 <- if (!loq_legend) {
    plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none")
  } else {
    plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2))
  }

  plot1 <- plot1 +
    ggplot2::geom_jitter(
      data = data,
      ggplot2::aes(
        x = !!sym(xaxis_var),
        y = !!sym(yaxis_var),
        shape = !!sym(loq_flag_var),
        color = !!sym(trt_group)
      ),
      alpha = alpha,
      position = ggplot2::position_jitter(width = 0.1, height = 0),
      size = dot_size,
      na.rm = TRUE
    )

  # Any limits for the Y axis?
  plot1 <- plot1 + ggplot2::coord_cartesian(ylim = ylim)


  # Add facetting.
  if (!is.null(facet_var)) {
    if (facet_var != "None" & facet_var %in% names(data)) { # nolint
      if (!is_finite(facet_ncol)) facet_ncol <- 0
      if (facet_ncol >= 1) {
        plot1 <- plot1 +
          ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = round(facet_ncol))
      } else {
        plot1 <- plot1 +
          ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)))
      }
    }
  }




  # Format font size
  if (is_finite(font_size)) {
    plot1 <- plot1 +
      ggplot2::theme(
        axis.title.x = ggplot2::element_text(size = font_size),
        axis.text.x = ggplot2::element_text(size = font_size),
        axis.title.y = ggplot2::element_text(size = font_size),
        axis.text.y = ggplot2::element_text(size = font_size),
        legend.title = ggplot2::element_text(size = font_size),
        legend.text = ggplot2::element_text(size = font_size),
        strip.text.x = ggplot2::element_text(size = font_size),
        strip.text.y = ggplot2::element_text(size = font_size)
      )
  }
  # Format x-label
  if (rotate_xlab) {
    plot1 <- plot1 +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }

  # Add horizontal line for range based on option
  plot1 + geom_axes_lines(data,
    hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label,
    hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels
  )
}

#' Function to create a table of descriptive summary statistics to accompany plots.
#'
#' Output descriptive summary statistics table as a data frame. Includes biomarker, treatment,
#' visit,
#' n, mean, median, SD, min, max, %missing values, % `LOQ` values.
#'
#' @param data name of data frame to summarize.
#' @param trt_group treatment group variable name e.g. `ARM`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param biomarker to visualize e.g. `IGG`.
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`.
#' @param facet_var name of variable facetted on typically containing visit values e.g. `AVISITCD`.
#'   If NULL then ignored. It defaults to `"AVISITCD"` when not provided.
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. Defaults to `"LOQFL"`.
#' @param ... additional options
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @details provide additional information as needed. link to specification file
#' \url{https://posit.co/}
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
#' )
#'
#' ADLB <- rADLB
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD))
#'
#' tbl <- t_summarytable(
#'   data = ADLB,
#'   trt_group = "ARM",
#'   param_var = "PARAMCD",
#'   param = c("CRP"),
#'   xaxis_var = "AVAL",
#'   facet_var = "AVISITCD",
#'   loq_flag_var = "LOQFL"
#' )
#' tbl
t_summarytable <- function(data,
                           trt_group,
                           param_var,
                           param,
                           xaxis_var,
                           facet_var = "AVISITCD",
                           loq_flag_var = "LOQFL",
                           ...) {
  if (!is.null(facet_var) && trt_group == facet_var) {
    data[paste0(facet_var, "_")] <- data[facet_var]
    facet_var <- paste0(facet_var, "_")
  }

  table_data <- data %>%
    filter(!!sym(param_var) == param)

  # get unique study id or unique study ids if multiple study data
  study_id <- as.data.frame(table(table_data$STUDYID)) %>%
    mutate(STUDYID = paste(.data$Var1, collapse = "/")) %>%
    rename(StudyID = "STUDYID") %>%
    select("StudyID") %>%
    slice(1)

  # get analysis variable name
  anl_var <- as.data.frame(xaxis_var) %>%
    rename("AnlVar" = xaxis_var)

  min_max_ignore_na <- function(x, type = c("min", "max")) {
    type <- match.arg(type)
    if (all(is.na(x))) {
      return(NA)
    }
    return(
      switch(type,
        min = min,
        max = max
      )(x, na.rm = TRUE)
    )
  }

  # by treatment group table

  sum_data_by_arm <- table_data %>% filter(!!sym(param_var) == param)
  if (!is.null(facet_var)) {
    sum_data_by_arm <- sum_data_by_arm %>%
      group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD, !!sym(facet_var))
  } else {
    sum_data_by_arm <- sum_data_by_arm %>%
      group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD)
  }

  sum_data_by_arm <- sum_data_by_arm %>%
    summarise(
      n = sum(!is.na(!!sym(xaxis_var))),
      Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2),
      Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2),
      PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2),
      PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2)
    )

  if (!is.null(facet_var)) {
    sum_data_by_arm <- sum_data_by_arm %>%
      select(
        all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev",
        "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      ungroup()
  } else {
    sum_data_by_arm <- sum_data_by_arm %>%
      select(
        all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev",
        "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      ungroup()
  }

  # by combined treatment group table
  sum_data_combined_arm <- table_data %>%
    filter(!!sym(param_var) == param)

  if (!is.null(facet_var)) {
    sum_data_combined_arm <- sum_data_combined_arm %>%
      group_by(!!sym(param_var), !!sym(facet_var))
  } else {
    sum_data_combined_arm <- sum_data_combined_arm %>%
      group_by(!!sym(param_var))
  }

  sum_data_combined_arm <- sum_data_combined_arm %>%
    summarise(
      n = sum(!is.na(!!sym(xaxis_var))),
      Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
      Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2),
      Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2),
      PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2),
      PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2),
      MAXTRTORDVIS = max(.data$TRTORD) # identifies the maximum treatment order within visits
    ) %>% # additional use of max function identifies maximum treatment order across all visits.
    mutate(!!trt_group := "Comb.", TRTORD = max(.data$MAXTRTORDVIS) + 1)

  # select only those columns needed to prop
  if (!is.null(facet_var)) {
    sum_data_combined_arm <- sum_data_combined_arm %>%
      select(
        all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev",
        "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      ungroup()

    # combine the two data sets and apply some formatting. Note that R coerces treatment group into
    # character since it is a factor and character
    sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate
      # reorder variables
      select(
        all_of(c(Biomarker = param_var, Treatment = trt_group, Facet = facet_var)),
        "n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      arrange(.data$Biomarker, .data$Facet, .data$TRTORD) %>% # drop variable
      select(-"TRTORD")
  } else {
    sum_data_combined_arm <- sum_data_combined_arm %>%
      select(
        all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev",
        "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      ungroup()

    # combine the two data sets and apply some formatting. Note that R coerces treatment group into
    # character since it is a factor and character
    sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate
      # reorder variables
      select(
        all_of(c(Biomarker = param_var, Treatment = trt_group)),
        "n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
      ) %>%
      arrange(.data$Biomarker, .data$TRTORD) %>% # drop variable
      select(-"TRTORD")
  }

  # add analysis variable as first column
  sum_data <- cbind(study_id, anl_var, sum_data)
}

#' Function to create line plot of summary statistics over time.
#'
#' @param label text string to be displayed as plot label.
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
#' @param biomarker_var name of variable containing biomarker names.
#' @param biomarker_var_label name of variable containing biomarker labels.
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
#' @param biomarker biomarker name to be analyzed.
#' @param value_var name of variable containing biomarker results.
#' @param unit_var name of variable containing biomarker result unit.
#' @param trt_group name of variable representing treatment group.
#' @param trt_group_level vector that can be used to define the factor level of `trt_group`.
#' @param shape categorical variable whose levels are used to split the plot lines.
#' @param shape_type vector of symbol types.
#' @param time name of variable containing visit names.
#' @param time_level vector that can be used to define the factor level of time. Only use it when
#' x-axis variable is character or factor.
#' @param color_manual vector of colors.
#' @param line_type vector of line types.
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param median boolean whether to display median results.
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param xtick a vector to define the tick values of time in x-axis.
#' Default value is `ggplot2::waiver()`.
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values.
#' Default value is `ggplot2::waiver()`.
#' @param rotate_xlab boolean whether to rotate x-axis labels.
#' @param plot_font_size control font size for title, x-axis, y-axis and legend font.
#' @param dot_size plot dot size. Default to 3.
#' @param dodge control position dodge.
#' @param plot_height height of produced plot. 989 pixels by default.
#' @param count_threshold \code{integer} minimum number observations needed to show the appropriate
#' bar and point on the plot. Default: 0
#' @param table_font_size \code{float} controls the font size of the values printed in the table.
#' Default: 12
#' @param display_center_tbl boolean whether to include table of means or medians
#'
#'
#' @author Balazs Toth (toth.balazs@gene.com)
#' @author Wenyi Liu (wenyi.liu@roche.com)
#'
#' @details Currently, the output plot can display mean and median of input value. For mean, the
#' error bar denotes
#' 95\% confidence interval. For median, the error bar denotes median-25% quartile to median+75%
#' quartile.
#'
#' @return \code{ggplot} object
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#' library(dplyr)
#' library(nestcolor)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
#' )
#' color_manual <- c("150mg QD" = "thistle", "Placebo" = "orange", "Combination" = "steelblue")
#' type_manual <- c("150mg QD" = "solid", "Placebo" = "dashed", "Combination" = "dotted")
#'
#' ADSL <- rADSL %>% filter(!(ARM == "B: Placebo" & AGE < 40))
#' ADLB <- rADLB
#' ADLB <- right_join(ADLB, ADSL[, c("STUDYID", "USUBJID")])
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#'
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD))
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = ADLB,
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = NULL,
#'   time = "AVISITCDN",
#'   color_manual = color_manual,
#'   line_type = type_manual,
#'   median = FALSE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c(0, 1, 5),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 600
#' )
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = ADLB,
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = NULL,
#'   time = "AVISITCD",
#'   color_manual = NULL,
#'   line_type = type_manual,
#'   median = TRUE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c("BL", "W 1", "W 5"),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 600
#' )
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = ADLB,
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = NULL,
#'   time = "AVISITCD",
#'   color_manual = color_manual,
#'   line_type = type_manual,
#'   median = FALSE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c("BL", "W 1", "W 5"),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 600,
#'   count_threshold = 90,
#'   table_font_size = 15
#' )
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = ADLB,
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = NULL,
#'   time = "AVISITCDN",
#'   color_manual = color_manual,
#'   line_type = type_manual,
#'   median = TRUE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c(0, 1, 5),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 600
#' )
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = subset(ADLB, SEX %in% c("M", "F")),
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = "SEX",
#'   time = "AVISITCDN",
#'   color_manual = color_manual,
#'   line_type = type_manual,
#'   median = FALSE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c(0, 1, 5),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 1500,
#'   dot_size = 1
#' )
#'
#' g_lineplot(
#'   label = "Line Plot",
#'   data = subset(ADLB, SEX %in% c("M", "F")),
#'   biomarker_var = "PARAMCD",
#'   biomarker = "CRP",
#'   value_var = "AVAL",
#'   trt_group = "ARM",
#'   shape = "SEX",
#'   time = "AVISITCDN",
#'   color_manual = NULL,
#'   median = FALSE,
#'   hline_arb = c(.9, 1.1, 1.2, 1.5),
#'   hline_arb_color = c("green", "red", "blue", "pink"),
#'   hline_arb_label = c("A", "B", "C", "D"),
#'   xtick = c(0, 1, 5),
#'   xlabel = c("Baseline", "Week 1", "Week 5"),
#'   rotate_xlab = FALSE,
#'   plot_height = 1500,
#'   dot_size = 4
#' )
g_lineplot <- function(label = "Line Plot",
                       data,
                       biomarker_var = "PARAMCD",
                       biomarker_var_label = "PARAM",
                       biomarker,
                       value_var = "AVAL",
                       unit_var = "AVALU",
                       loq_flag_var = "LOQFL",
                       ylim = c(NA, NA),
                       trt_group,
                       trt_group_level = NULL,
                       shape = NULL,
                       shape_type = NULL,
                       time,
                       time_level = NULL,
                       color_manual = NULL,
                       line_type = NULL,
                       median = FALSE,
                       hline_arb = numeric(0),
                       hline_arb_color = "red",
                       hline_arb_label = "Horizontal line",
                       xtick = ggplot2::waiver(),
                       xlabel = xtick,
                       rotate_xlab = FALSE,
                       plot_font_size = 12,
                       dot_size = 3,
                       dodge = 0.4,
                       plot_height = 989,
                       count_threshold = 0,
                       table_font_size = 12,
                       display_center_tbl = TRUE) {
  checkmate::assert_numeric(ylim, len = 2)

  ## Pre-process data
  table_font_size <- grid::convertX(grid::unit(table_font_size, "points"), "mm", valueOnly = TRUE)

  ## - convert to factors
  label_trt_group <- attr(data[[trt_group]], "label")
  data[[trt_group]] <- if (is.null(trt_group_level)) {
    factor(data[[trt_group]])
  } else {
    factor(data[[trt_group]], levels = trt_group_level)
  }
  attr(data[[trt_group]], "label") <- label_trt_group

  color_manual <- if (is.null(color_manual)) {
    temp <- if (!is.null(getOption("ggplot2.discrete.colour"))) {
      getOption("ggplot2.discrete.colour")[1:nlevels(data[[trt_group]])]
    } else {
      gg_color_hue(nlevels(data[[trt_group]]))
    }
    names(temp) <- levels(data[[trt_group]])
    temp
  } else {
    stopifnot(all(levels(data[[trt_group]]) %in% names(color_manual)))
    color_manual
  }

  line_type <- if (is.null(line_type)) {
    stats::setNames(rep("dashed", nlevels(data[[trt_group]])), levels(data[[trt_group]]))
  } else {
    stopifnot(all(levels(data[[trt_group]]) %in% names(line_type)))
    line_type
  }

  shape_type <- if (is.null(shape)) {
    NULL
  } else {
    if (is.null(shape_type)) {
      default_shapes <- c(15:18, 3:14, 0:2)
      res <- if (nlevels(data[[shape]]) > length(default_shapes)) {
        rep(default_shapes, ceiling(nlevels(data[[shape]]) / length(default_shapes)))
      } else {
        default_shapes[seq_len(nlevels(data[[shape]]))]
      }
      stats::setNames(res, levels(data[[shape]]))
    } else {
      stopifnot(all(levels(data[[shape]]) %in% names(shape_type)))
      shape_type
    }
  }

  xtype <- if (is.factor(data[[time]]) || is.character(data[[time]])) {
    "discrete"
  } else {
    "continuous"
  }
  if (xtype == "discrete") {
    data[[time]] <- if (is.null(time_level)) {
      factor(data[[time]])
    } else {
      factor(data[[time]], levels = time_level)
    }
  }

  groupings <- c(time, trt_group, shape)
  ## Summary statistics
  sum_data <- data %>%
    filter(!!sym(biomarker_var) == biomarker) %>%
    group_by_at(groupings) %>%
    summarise(
      count = sum(!is.na(!!sym(value_var))),
      mean = mean(!!sym(value_var), na.rm = TRUE),
      CIup = mean(!!sym(value_var), na.rm = TRUE) + 1.96 * stats::sd(!!sym(value_var), na.rm = TRUE) / sqrt(n()),
      CIdown = mean(!!sym(value_var), na.rm = TRUE) - 1.96 * stats::sd(!!sym(value_var), na.rm = TRUE) / sqrt(n()),
      median = stats::median(!!sym(value_var), na.rm = TRUE),
      quant25 = stats::quantile(!!sym(value_var), 0.25, na.rm = TRUE),
      quant75 = stats::quantile(!!sym(value_var), 0.75, na.rm = TRUE)
    ) %>%
    arrange_at(c(trt_group, shape))

  ## Filter out rows with insufficient number of counts
  listin <- list()
  listin[[trt_group]] <- sum_data[[trt_group]]

  if (!is.null(shape)) {
    listin[[shape]] <- sum_data[[shape]]
  }

  int <- unique_name("int", names(sum_data))
  sum_data[[int]] <- new_interaction(listin, sep = " ")
  sum_data[[int]] <- stringr::str_wrap(sum_data[[int]], 12)
  sum_data[[int]] <- factor(sum_data[[int]], sort(unique(sum_data[[int]])))

  unfiltered_data <- sum_data %>% mutate("met_threshold" = count >= count_threshold)
  sum_data <- unfiltered_data %>% filter(.data[["met_threshold"]])

  ## Base plot
  pd <- ggplot2::position_dodge(dodge)
  if (median) {
    line <- "median"
    up_limit <- "quant75"
    down_limit <- "quant25"
  } else {
    line <- "mean"
    up_limit <- "CIup"
    down_limit <- "CIdown"
  }

  filtered_data <- data %>%
    filter(!!sym(biomarker_var) == biomarker)

  unit <- filtered_data %>%
    pull(unit_var) %>%
    unique()

  unit1 <- if (is.na(unit) || unit == "") {
    " "
  } else {
    paste0(" (", unit, ") ")
  }

  biomarker1 <- filtered_data %>%
    pull(biomarker_var_label) %>%
    unique()

  gtitle <- paste0(biomarker1, unit1, stringr::str_to_title(line), " by Treatment @ Visits")
  gylab <- paste0(biomarker1, " ", stringr::str_to_title(line), " of ", value_var, " Values")
  gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")

  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))

  # Add footnote to identify LLOQ and ULOQ values pulled from data
  caption_loqs_label <- h_caption_loqs_label(loqs_data = filtered_data, flag_var = loq_flag_var)

  if (is.null(shape)) {
    plot1 <- ggplot2::ggplot(
      data = sum_data,
      ggplot2::aes(
        x = !!sym(time),
        y = !!sym(line),
        color = !!sym(trt_group),
        linetype = !!sym(trt_group),
        group = !!sym(int)
      )
    ) +
      ggplot2::theme_bw() +
      ggplot2::geom_point(position = pd, size = dot_size) +
      ggplot2::scale_color_manual(
        values = color_manual, name = trt_label, guide = ggplot2::guide_legend(ncol = 3, order = 1)
      ) +
      ggplot2::scale_linetype_manual(
        values = line_type, name = trt_label, guide = ggplot2::guide_legend(ncol = 3, order = 1)
      )
  } else {
    mappings <- sum_data %>%
      ungroup() %>%
      select(!!sym(trt_group), !!sym(shape), int) %>%
      distinct() %>%
      mutate(
        cols = color_manual[as.character(!!sym(trt_group))],
        types = line_type[as.character(!!sym(trt_group))],
        shps = shape_type[!!sym(shape)]
      )

    col_mapping <- stats::setNames(mappings$cols, mappings$int)
    shape_mapping <- stats::setNames(mappings$shps, mappings$int)
    type_mapping <- stats::setNames(mappings$types, mappings$int)

    plot1 <- ggplot2::ggplot(
      data = sum_data,
      ggplot2::aes(
        x = !!sym(time),
        y = !!sym(line),
        color = !!sym(int),
        linetype = !!sym(int),
        group = !!sym(int),
        shape = !!sym(int)
      )
    ) +
      ggplot2::theme_bw() +
      ggplot2::scale_color_manual(" ", values = col_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) +
      ggplot2::scale_linetype_manual(" ", values = type_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) +
      ggplot2::scale_shape_manual(" ", values = shape_mapping, guide = ggplot2::guide_legend(ncol = 3, order = 1)) +
      ggplot2::theme(legend.key.size = grid::unit(1, "cm")) +
      ggplot2::geom_point(position = pd, size = dot_size)
  }

  plot1 <- plot1 +
    ggplot2::geom_line(position = pd) +
    ggplot2::geom_errorbar(
      ggplot2::aes(ymin = !!sym(down_limit), ymax = !!sym(up_limit)),
      width = 0.45, position = pd, linetype = "solid"
    ) +
    ggplot2::ggtitle(gtitle) +
    ggplot2::labs(caption = paste(
      "The output plot can display mean and median of input value.",
      "For mean, the error bar denotes 95% confidence interval.",
      "For median, the bar denotes the first to third quartile.\n",
      caption_loqs_label
    )) +
    ggplot2::xlab(gxlab) +
    ggplot2::ylab(gylab) +
    ggplot2::theme(
      legend.box = "vertical",
      legend.position = "bottom",
      legend.direction = "horizontal",
      plot.title = ggplot2::element_text(size = plot_font_size, margin = ggplot2::margin(), hjust = 0.5),
      axis.title.y = ggplot2::element_text(margin = ggplot2::margin(r = 20))
    )

  # Apply y-axis zoom range
  plot1 <- plot1 +
    ggplot2::coord_cartesian(ylim = ylim)

  # Format x-label
  if (xtype == "continuous") {
    plot1 <- plot1 +
      ggplot2::scale_x_continuous(breaks = xtick, labels = xlabel, limits = c(NA, NA))
  } else if (xtype == "discrete") {
    plot1 <- plot1 +
      ggplot2::scale_x_discrete(breaks = xtick, labels = xlabel)
  }

  if (rotate_xlab) {
    plot1 <- plot1 +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }


  plot1 <- plot1 + geom_axes_lines(
    sum_data,
    hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label
  )

  # Format font size
  if (!is.null(plot_font_size)) {
    plot1 <- plot1 +
      ggplot2::theme(
        axis.title.x = ggplot2::element_text(size = plot_font_size),
        axis.text.x = ggplot2::element_text(size = plot_font_size),
        axis.title.y = ggplot2::element_text(size = plot_font_size),
        axis.text.y = ggplot2::element_text(size = plot_font_size),
        legend.title = ggplot2::element_text(size = plot_font_size),
        legend.text = ggplot2::element_text(size = plot_font_size)
      )
  }

  labels <- levels(unfiltered_data[[int]])
  lines <- sum(stringr::str_count(unique(labels), "\n")) / 2 + length(unique(labels))
  minline <- 36
  tabletotal <- lines * minline * ifelse(display_center_tbl, 2, 1)
  plotsize <- plot_height - tabletotal
  if (plotsize <= 250) {
    stop("Due to number of line splitting levels the current plot height is not sufficient to display plot.
    If applicable, please try a combination of:
      * increasing the plot height using the Plot Aesthetic Settings,
      * increasing the relative height of plot to table(s),
      * increasing the initial maximum plot_height argument during creation of this app,
      * and / or consider removing the mean / median table.")
  }

  if (display_center_tbl) {
    unfiltered_data$center <- if (median) {
      sprintf(ifelse(unfiltered_data$count > 0, "%.2f", ""), unfiltered_data$median)
    } else {
      sprintf(ifelse(unfiltered_data$count > 0, "%.2f", ""), unfiltered_data$mean)
    }
    tbl_central_value_title <- if (median) "Median" else "Mean"
    tbl_central_value <- ggplot2::ggplot(
      unfiltered_data,
      ggplot2::aes(x = !!sym(time), y = !!sym(int), label = .data[["center"]])
    ) +
      ggplot2::geom_text(ggplot2::aes(color = .data[["met_threshold"]]), size = table_font_size) +
      ggplot2::ggtitle(tbl_central_value_title) +
      ggplot2::theme_minimal() +
      ggplot2::scale_y_discrete(labels = labels) +
      ggplot2::theme(
        panel.grid.major = ggplot2::element_blank(),
        legend.position = "none",
        panel.grid.minor = ggplot2::element_blank(),
        panel.border = ggplot2::element_blank(), axis.text.x = ggplot2::element_blank(),
        axis.ticks = ggplot2::element_blank(),
        axis.title.x = ggplot2::element_blank(),
        axis.title.y = ggplot2::element_blank(),
        axis.text.y = ggplot2::element_text(size = plot_font_size),
        plot.title = ggplot2::element_text(face = "bold", size = plot_font_size)
      ) +
      ggplot2::scale_color_manual(values = c("FALSE" = "red", "TRUE" = "black"))
  }

  tbl <- ggplot2::ggplot(
    unfiltered_data,
    ggplot2::aes(x = !!sym(time), y = !!sym(int), label = .data[["count"]])
  ) +
    ggplot2::geom_text(ggplot2::aes(color = .data[["met_threshold"]]), size = table_font_size) +
    ggplot2::ggtitle("Number of observations") +
    ggplot2::theme_minimal() +
    ggplot2::scale_y_discrete(labels = labels) +
    ggplot2::theme(
      panel.grid.major = ggplot2::element_blank(),
      legend.position = "none",
      panel.grid.minor = ggplot2::element_blank(),
      panel.border = ggplot2::element_blank(), axis.text.x = ggplot2::element_blank(),
      axis.ticks = ggplot2::element_blank(),
      axis.title.x = ggplot2::element_blank(),
      axis.title.y = ggplot2::element_blank(),
      axis.text.y = ggplot2::element_text(size = plot_font_size),
      plot.title = ggplot2::element_text(face = "bold", size = plot_font_size)
    ) +
    ggplot2::scale_color_manual(values = c("FALSE" = "red", "TRUE" = "black"))

  # Plot the grobs using plot_grid
  if (display_center_tbl) {
    cowplot::plot_grid(plot1, tbl_central_value, tbl,
      align = "v", ncol = 1,
      rel_heights = c(plotsize, tabletotal / 2, tabletotal / 2)
    )
  } else {
    cowplot::plot_grid(plot1, tbl, align = "v", ncol = 1, rel_heights = c(plotsize, tabletotal))
  }
}

new_interaction <- function(args, drop = FALSE, sep = ".", lex.order = FALSE) { # nolint
  for (i in seq_along(args)) {
    if (is.null(args[[i]])) {
      args[[i]] <- NULL
    }
  }
  if (length(args) == 1) {
    return(paste0(names(args), ":", args[[1]]))
  }
  args <- mapply(function(n, val) paste0(n, ":", val), names(args), args, SIMPLIFY = FALSE)
  interaction(args, drop = drop, sep = sep, lex.order = lex.order)
}

unique_name <- function(newname, old_names) {
  if (newname %in% old_names) {
    unique_name(paste0(newname, "1"), old_names)
  }
  newname
}

gg_color_hue <- function(n) {
  hues <- seq(15, 375, length = n + 1)
  grDevices::hcl(h = hues, l = 65, c = 100)[1:n]
}

#' Function to create a correlation plot.
#'
#' Default plot displays correlation facetted by visit with color attributed treatment arms and
#' symbol attributed `LOQ` values.
#'
#' @param label text string to used to identify plot.
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param xaxis_param x-axis biomarker to visualize e.g. `IGG`.
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`.
#' @param xvar x-axis analysis variable from transposed data set.
#' @param yaxis_param y-axis biomarker to visualize e.g. `IGG`.
#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis.g. `AVAL`.
#' @param yvar y-axis analysis variable from transposed data set.
#' @param trt_group name of variable representing treatment group e.g. `ARM`.
#' @param visit name of variable containing nominal visits e.g. `AVISITCD`.
#' @param loq_flag_var  name of variable containing `LOQ` flag e.g. `LOQFL_COMB`.
#' @param visit_facet visit facet toggle.
#' @param loq_legend `logical` whether to include `LoQ` legend.
#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
#'   if the default limits are not suitable.
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param title_text plot title.
#' @param xaxis_lab x-axis label.
#' @param yaxis_lab y-axis label.
#' @param color_manual vector of colors applied to treatment values.
#' @param shape_manual vector of symbols applied to `LOQ` values. (used with `loq_flag_var`).
#' @param facet_ncol number of facets per row.
#' @param facet set layout to use treatment facetting.
#' @param facet_var variable to use for treatment facetting.
#' @param reg_line include regression line and annotations for slope and coefficient.
#' Use with facet = TRUE.
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param hline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   The data inside of the `ggplot2` object must also contain the columns with these variable names
#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines.
#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines.
#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines.
#' @param vline_vars ('character vector'), names of variables `(ANR*)` or values `(*LOQ)` identifying intercept values.
#'   The data inside of the `ggplot2` object must also contain the columns with these variable names
#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables.
#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables.
#' @param rotate_xlab 45 degree rotation of x-axis label values.
#' @param font_size font size control for title, x-axis label, y-axis label and legend.
#' @param dot_size plot dot size.
#' @param reg_text_size font size control for regression line annotations.
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @details Regression uses `deming` model.
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#' library(tidyr)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD",
#'   "B: Placebo" = "Placebo",
#'   "C: Combination" = "Combination"
#' )
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA"
#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)
#'
#' ADLB <- rADLB
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD)) %>%
#'   mutate(
#'     ANRHI = case_when(
#'       PARAMCD == "ALT" ~ 60,
#'       PARAMCD == "CRP" ~ 70,
#'       PARAMCD == "IGA" ~ 80,
#'       TRUE ~ NA_real_
#'     ),
#'     ANRLO = case_when(
#'       PARAMCD == "ALT" ~ 20,
#'       PARAMCD == "CRP" ~ 30,
#'       PARAMCD == "IGA" ~ 40,
#'       TRUE ~ NA_real_
#'     )
#'   ) %>%
#'   rowwise() %>%
#'   group_by(PARAMCD) %>%
#'   mutate(LBSTRESC = ifelse(
#'     USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
#'   )) %>%
#'   mutate(LBSTRESC = ifelse(
#'     USUBJID %in% sample(USUBJID, 1, replace = TRUE),
#'     paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
#'   )) %>%
#'   ungroup()
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
#'
#' # add LLOQ and ULOQ variables
#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, flag_var = "LOQFL")
#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
#'
#' # given the 2 param and 2 analysis vars we need to transform the data
#' plot_data_t1 <- ADLB %>%
#'   gather(
#'     ANLVARS, ANLVALS, PARAM, LBSTRESC, BASE2, BASE, AVAL, BASE, LOQFL,
#'     ANRHI, ANRLO, ULOQN, LLOQN
#'   ) %>%
#'   mutate(ANL.PARAM = ifelse(ANLVARS %in% c("PARAM", "LBSTRESC", "LOQFL"),
#'     paste0(ANLVARS, "_", PARAMCD),
#'     paste0(ANLVARS, ".", PARAMCD)
#'   )) %>%
#'   select(USUBJID, ARM, ARMCD, AVISITN, AVISITCD, ANL.PARAM, ANLVALS) %>%
#'   spread(ANL.PARAM, ANLVALS)
#'
#' # the transformed analysis value variables are character and need to be converted to numeric for
#' # ggplot
#' # remove records where either of the analysis variables are NA since they will not appear on the
#' # plot and will ensure that LOQFL = NA level is removed
#' plot_data_t2 <- plot_data_t1 %>%
#'   filter(!is.na(BASE.CRP) & !is.na(AVAL.ALT)) %>%
#'   mutate_at(vars(contains(".")), as.numeric) %>%
#'   mutate(
#'     LOQFL_COMB = ifelse(LOQFL_CRP == "Y" | LOQFL_ALT == "Y", "Y", "N")
#'   )
#'
#' g_correlationplot(
#'   label = "Correlation Plot",
#'   data = plot_data_t2,
#'   param_var = "PARAMCD",
#'   xaxis_param = c("CRP"),
#'   xaxis_var = "AVAL",
#'   xvar = "AVAL.CRP",
#'   yaxis_param = c("ALT"),
#'   yaxis_var = "BASE",
#'   yvar = "BASE.ALT",
#'   trt_group = "ARM",
#'   visit = "AVISITCD",
#'   visit_facet = TRUE,
#'   loq_legend = TRUE,
#'   unit = "AVALU",
#'   title_text = "Correlation of ALT to CRP",
#'   xaxis_lab = "CRP",
#'   yaxis_lab = "ALT",
#'   color_manual = color_manual,
#'   shape_manual = shape_manual,
#'   facet_ncol = 4,
#'   facet = FALSE,
#'   facet_var = "ARM",
#'   reg_line = FALSE,
#'   hline_arb = c(15, 25),
#'   hline_arb_color = c("gray", "green"),
#'   hline_arb_label = "Hori_line_label",
#'   vline_arb = c(.5, 1),
#'   vline_arb_color = c("red", "black"),
#'   vline_arb_label = c("Vertical Line A", "Vertical Line B"),
#'   hline_vars = c("ANRHI.ALT", "ANRLO.ALT", "ULOQN.ALT", "LLOQN.ALT"),
#'   hline_vars_colors = c("green", "blue", "purple", "cyan"),
#'   hline_vars_labels = c("ANRHI ALT Label", "ANRLO ALT Label", "ULOQN ALT Label", "LLOQN ALT Label"),
#'   vline_vars = c("ANRHI.CRP", "ANRLO.CRP", "ULOQN.CRP", "LLOQN.CRP"),
#'   vline_vars_colors = c("yellow", "orange", "brown", "gold"),
#'   vline_vars_labels = c("ANRHI CRP Label", "ANRLO CRP Label", "ULOQN CRP Label", "LLOQN CRP Label"),
#'   rotate_xlab = FALSE,
#'   font_size = 14,
#'   dot_size = 2,
#'   reg_text_size = 3
#' )
g_correlationplot <- function(label = "Correlation Plot",
                              data,
                              param_var = "PARAMCD",
                              xaxis_param = "CRP",
                              xaxis_var = "BASE",
                              xvar,
                              yaxis_param = "IGG",
                              yaxis_var = "AVAL",
                              yvar,
                              trt_group = "ARM",
                              visit = "AVISITCD",
                              loq_flag_var = "LOQFL_COMB",
                              visit_facet = TRUE,
                              loq_legend = TRUE,
                              unit = "AVALU",
                              xlim = c(NA, NA),
                              ylim = c(NA, NA),
                              title_text = title_text,
                              xaxis_lab = xaxis_lab,
                              yaxis_lab = yaxis_lab,
                              color_manual = NULL,
                              shape_manual = NULL,
                              facet_ncol = 2,
                              facet = FALSE,
                              facet_var = "ARM",
                              reg_line = FALSE,
                              hline_arb = numeric(0),
                              hline_arb_color = "red",
                              hline_arb_label = "Horizontal line",
                              hline_vars = character(0),
                              hline_vars_colors = "green",
                              hline_vars_labels = hline_vars,
                              vline_arb = numeric(0),
                              vline_arb_color = "red",
                              vline_arb_label = "Vertical line",
                              vline_vars = character(0),
                              vline_vars_colors = "green",
                              vline_vars_labels = vline_vars,
                              rotate_xlab = FALSE,
                              font_size = 12,
                              dot_size = 2,
                              reg_text_size = 3) {
  checkmate::assert_flag(loq_legend)
  checkmate::assert_number(dot_size, lower = 1)
  checkmate::assert_numeric(xlim, len = 2)
  checkmate::assert_numeric(ylim, len = 2)

  # create correlation plot over time pairwise per treatment arm
  plot_data <- data

  # identify param and lbstresc combinations in transposed data variable name
  t_param_var_x <- paste("PARAM", xaxis_param, sep = "_")
  t_lbstresc_var_x <- paste("LBSTRESC", xaxis_param, sep = "_")
  t_param_var_y <- paste("PARAM", yaxis_param, sep = "_")
  t_lbstresc_var_y <- paste("LBSTRESC", yaxis_param, sep = "_")

  xaxis_param_loqs_data <- data %>%
    mutate(
      PARAM = !!sym(t_param_var_x), LBSTRESC = !!sym(t_lbstresc_var_x),
      sym(loq_flag_var) == !!sym(loq_flag_var)
    ) %>%
    select("PARAM", "LBSTRESC", loq_flag_var)

  yaxis_param_loqs_data <- data %>%
    mutate(
      PARAM = !!sym(t_param_var_y), LBSTRESC = !!sym(t_lbstresc_var_y),
      sym(loq_flag_var) == !!sym(loq_flag_var)
    ) %>%
    select("PARAM", "LBSTRESC", loq_flag_var)

  # add footnote to identify xaxis assay LLOQ and ULOQ values pulled from data
  caption_loqs_label_x <- h_caption_loqs_label(loqs_data = xaxis_param_loqs_data, flag_var = loq_flag_var)
  caption_loqs_label_y <- h_caption_loqs_label(loqs_data = yaxis_param_loqs_data, flag_var = loq_flag_var)
  caption_loqs_label_x_y <- paste0(union(caption_loqs_label_x, caption_loqs_label_y), collapse = "\n")

  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))

  # create plot foundation - titles and axes labels are defined in
  # teal.goshawk.tm_g_correlationplot.R
  plot1 <- ggplot2::ggplot(
    data = plot_data,
    ggplot2::aes(
      x = !!sym(xvar),
      y = !!sym(yvar),
      color = !!sym(trt_group)
    )
  ) +
    ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
    ggplot2::theme_bw() +
    ggplot2::labs(caption = caption_loqs_label_x_y) +
    ggplot2::ggtitle(title_text) +
    ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
    ggplot2::xlab(xaxis_lab) +
    ggplot2::ylab(yaxis_lab)

  # conditionally facet
  plot1 <- if (visit_facet && facet) {
    plot1 +
      ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit)))
  } else if (visit_facet) {
    plot1 +
      ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol)
  } else if (facet) {
    plot1 +
      ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol)
  } else {
    plot1
  }

  plot1 <- plot1 +
    ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE)

  # add regression line
  if (reg_line) {
    slope <- function(x, y) {
      if (stats::sd(y) != 0) {
        ratio <- stats::sd(x) / stats::sd(y)
        if (!is.na(ratio) && ratio > 0) {
          reg <- mc.deming(y, x, ratio)
          # return the evaluation of the ratio condition as third value in numeric vector to control
          # downstream processing
          return(c(round(reg$b0, 2), round(reg$b1, 2), !is.na(ratio) & ratio > 0))
        }
      }
      # if ratio condition is not met then assign NA to vector so that NULL condition does not throw
      # the error below
      return(as.numeric(c(NA, NA, NA)))
    }

    sub_data <- filter(plot_data, !is.na(!!sym(yvar)) & !is.na(!!sym(xvar))) %>%
      group_by(!!sym(trt_group), !!sym(visit)) %>%
      mutate(intercept = slope(!!sym(yvar), !!sym(xvar))[1]) %>%
      mutate(slope = slope(!!sym(yvar), !!sym(xvar))[2]) %>%
      mutate(corr = ifelse(
        slope(!!sym(yvar), !!sym(xvar))[3],
        stats::cor(!!sym(yvar), !!sym(xvar), method = "spearman", use = "complete.obs"),
        NA
      ))
    plot1 <- plot1 +
      ggplot2::geom_abline(
        data = filter(sub_data, row_number() == 1), # only need to return 1 row within group_by
        ggplot2::aes(intercept = .data$intercept, slope = .data$slope, color = !!sym(trt_group))
      ) +
      ggplot2::geom_text(
        data = filter(sub_data, row_number() == 1),
        ggplot2::aes_(
          x = -Inf,
          y = Inf,
          hjust = 0,
          vjust = 1,
          label = ~ ifelse(
            !is.na(intercept) & !is.na(slope) & !is.na(corr),
            sprintf("y = %.2f+%.2fX\ncor = %.2f", intercept, slope, corr),
            paste0("Insufficient Data For Regression")
          ),
          color = sym(trt_group)
        ),
        size = reg_text_size,
        show.legend = FALSE
      ) +
      ggplot2::labs(caption = paste0(
        "Deming Regression Model, Spearman Correlation Method.\n",
        caption_loqs_label_x_y
      ))
  }
  # Format font size
  if (!is.null(font_size)) {
    plot1 <- plot1 + ggplot2::theme(
      axis.title.x = ggplot2::element_text(size = font_size),
      axis.text.x = ggplot2::element_text(size = font_size),
      axis.title.y = ggplot2::element_text(size = font_size),
      axis.text.y = ggplot2::element_text(size = font_size),
      legend.title = ggplot2::element_text(size = font_size),
      legend.text = ggplot2::element_text(size = font_size),
      strip.text.x = ggplot2::element_text(size = font_size),
      strip.text.y = ggplot2::element_text(size = font_size)
    )
  }
  # Format treatment color
  plot1 <- if (!is.null(color_manual)) {
    plot1 +
      ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
  } else {
    plot1 +
      ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
  }

  # Format LOQ flag symbol shape
  if (is.null(shape_manual)) {
    shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]])
    shape_manual <- seq_along(shape_names)
    names(shape_manual) <- shape_names
  }
  # add LOQ legend conditionally
  plot1 <- if (!loq_legend) {
    plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none")
  } else {
    plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2))
  }
  # Format x-label
  if (rotate_xlab) {
    plot1 <- plot1 +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }

  plot1 + geom_axes_lines(
    plot_data,
    hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label,
    hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels,
    vline_arb = vline_arb, vline_arb_color = vline_arb_color, vline_arb_label = vline_arb_label,
    vline_vars = vline_vars, vline_vars_colors = vline_vars_colors, vline_vars_labels = vline_vars_labels
  )
}

#' Function to create a density distribution plot.
#'
#' Default plot displays overall density facetted by visit with treatment arms and combined
#' treatment overlaid.
#'
#' @param label text string used to identify plot.
#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param biomarker to visualize e.g. `IGG`.
#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`.
#' @param trt_group name of variable representing treatment group e.g. `ARM`.
#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
#'   if the default limits are not suitable.
#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
#'   if the default limits are not suitable.
#' @param color_manual vector of colors applied to treatment values.
#' @param color_comb name or hex value for combined treatment color.
#' @param comb_line display combined treatment line toggle.
#' @param facet_var variable to use for facetting.
#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
#' @param facet_ncol number of facets per row.
#' @param rotate_xlab 45 degree rotation of x-axis label values.
#' @param font_size font size control for title, x-axis label, y-axis label and legend.
#' @param line_size plot line thickness.
#' @param rug_plot should a rug plot be displayed under the density plot. Note this
#'   option is most useful if the data only contains a single treatment group.
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#'
#' library(stringr)
#'
#' # original ARM value = dose value
#' arm_mapping <- list(
#'   "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
#' )
#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
#'
#' ADLB <- rADLB
#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
#' ADLB <- ADLB %>%
#'   mutate(AVISITCD = case_when(
#'     AVISIT == "SCREENING" ~ "SCR",
#'     AVISIT == "BASELINE" ~ "BL",
#'     grepl("WEEK", AVISIT) ~
#'       paste(
#'         "W",
#'         trimws(
#'           substr(
#'             AVISIT,
#'             start = 6,
#'             stop = str_locate(AVISIT, "DAY") - 1
#'           )
#'         )
#'       ),
#'     TRUE ~ NA_character_
#'   )) %>%
#'   mutate(AVISITCDN = case_when(
#'     AVISITCD == "SCR" ~ -2,
#'     AVISITCD == "BL" ~ 0,
#'     grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
#'     TRUE ~ NA_real_
#'   )) %>%
#'   # use ARMCD values to order treatment in visualization legend
#'   mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
#'     ifelse(grepl("B", ARMCD), 2,
#'       ifelse(grepl("A", ARMCD), 3, NA)
#'     )
#'   )) %>%
#'   mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
#'   mutate(ARM = factor(ARM) %>%
#'     reorder(TRTORD))
#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
#'
#' g_density_distribution_plot(
#'   label = "Density Distribution Plot",
#'   data = ADLB,
#'   param_var = "PARAMCD",
#'   param = c("CRP"),
#'   xaxis_var = "AVAL",
#'   unit = "AVALU",
#'   color_manual = color_manual,
#'   color_comb = "#39ff14",
#'   comb_line = FALSE,
#'   facet_var = "AVISITCD",
#'   hline_arb = 1.75,
#'   hline_arb_color = "black",
#'   hline_arb_label = "Horizontal Line A",
#'   facet_ncol = 2,
#'   rotate_xlab = FALSE,
#'   font_size = 10,
#'   line_size = .5
#' )
g_density_distribution_plot <- function(label = "Density Distribution Plot",
                                        data,
                                        param_var = "PARAMCD",
                                        param = "CRP",
                                        xaxis_var = "AVAL",
                                        trt_group = "ARM",
                                        unit = "AVALU",
                                        loq_flag_var = "LOQFL",
                                        xlim = c(NA, NA),
                                        ylim = c(NA, NA),
                                        color_manual = NULL,
                                        color_comb = "#39ff14",
                                        comb_line = TRUE,
                                        facet_var = "AVISITCD",
                                        hline_arb = character(0),
                                        hline_arb_color = "red",
                                        hline_arb_label = "Horizontal line",
                                        facet_ncol = 2,
                                        rotate_xlab = FALSE,
                                        font_size = 12,
                                        line_size = 2,
                                        rug_plot = FALSE) {
  checkmate::assert_numeric(xlim, len = 2)
  checkmate::assert_numeric(ylim, len = 2)

  plot_data <- data %>%
    filter(!!sym(param_var) == param)

  # Setup the ggtitle label.  Combine the biomarker and the units (if available)
  ggtitle_label <- ifelse(
    is.null(unit),
    paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"),
    ifelse(
      plot_data[[unit]] == "",
      paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"),
      paste0(plot_data$PARAM, " (", plot_data[[unit]], ") Density: Combined Treatment (Comb.) & by Treatment @ Visits")
    )
  )

  # Setup the x-axis label.  Combine the biomarker and the units (if available)
  x_axis_label <- ifelse(
    is.null(unit),
    paste(plot_data$PARAM, xaxis_var, "Values"),
    ifelse(
      plot_data[[unit]] == "",
      paste(plot_data$PARAM, xaxis_var, "Values"),
      paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values")
    )
  )

  # Setup legend label
  trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))

  if (comb_line) {
    plot_data <- dplyr::bind_rows(
      plot_data,
      plot_data %>%
        dplyr::mutate(!!sym(trt_group) := "Combined Dose")
    )
  }

  color_manual <- if (is.null(color_manual)) {
    group_names <- unique(plot_data[[trt_group]])
    color_values <- seq_along(group_names)
    if (!is.null(getOption("ggplot2.discrete.colour"))) {
      color_values <- getOption("ggplot2.discrete.colour")[color_values]
    }
    names(color_values) <- group_names
    color_values
  } else {
    color_manual
  }

  if (comb_line) {
    if (!is.null(color_comb)) {
      color_manual["Combined Dose"] <- color_comb
    } else if (!"Combined Dose" %in% names(color_manual)) {
      color_manual["Combined Dose"] <- length(color_manual) + 1
    }
  }

  # Add footnote to identify LLOQ and ULOQ values pulled from data
  caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var)

  plot1 <- ggplot2::ggplot(plot_data) +
    ggplot2::stat_density(
      ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group)),
      linewidth = line_size,
      geom = "line",
      position = "identity"
    ) +
    ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
    ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol) +
    ggplot2::labs(caption = caption_loqs_label) +
    ggplot2::theme_bw() +
    ggplot2::ggtitle(ggtitle_label) +
    ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
    ggplot2::xlab(paste(x_axis_label)) +
    ggplot2::ylab(paste("Density")) +
    ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))

  if (rug_plot) {
    plot1 <- plot1 +
      ggplot2::geom_rug(ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group)))
  }

  # Format font size
  if (!is.null(font_size)) {
    plot1 <- plot1 +
      ggplot2::theme(
        axis.title.x = ggplot2::element_text(size = font_size),
        axis.text.x = ggplot2::element_text(size = font_size),
        axis.title.y = ggplot2::element_text(size = font_size),
        axis.text.y = ggplot2::element_text(size = font_size),
        legend.title = ggplot2::element_text(size = font_size),
        legend.text = ggplot2::element_text(size = font_size),
        strip.text.x = ggplot2::element_text(size = font_size),
        strip.text.y = ggplot2::element_text(size = font_size)
      )
  }

  # Format x-label
  if (rotate_xlab) {
    plot1 <- plot1 +
      ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
  }

  # Add horizontal line
  plot1 + geom_axes_lines(
    plot_data,
    hline_arb = hline_arb,
    hline_arb_color = hline_arb_color,
    hline_arb_label = hline_arb_label
  )
}

1		#' Function to create a spaghetti plot.
2		#'
3		#' This function is rendered by teal.goshawk module
4		#'
5		#' @param data data frame with variables to be summarized and generate statistics which will display
6		#' in the plot.
7		#' @param subj_id unique subject id variable name.
8		#' @param biomarker_var name of variable containing biomarker names.
9		#' @param biomarker_var_label name of variable containing biomarker labels.
10		#' @param biomarker biomarker name to be analyzed.
11		#' @param value_var name of variable containing biomarker results.
12		#' @param unit_var name of variable containing biomarker units.
13		#' @param trt_group name of variable representing treatment group.
14		#' @param trt_group_level vector that can be used to define the factor level of `trt_group`.
15		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
16		#' @param time name of variable containing visit names.
17		#' @param time_level vector that can be used to define the factor level of time. Only use it when
18		#' x-axis variable is character or factor.
19		#' @param color_manual vector of colors.
20		#' @param color_comb name or hex value for combined treatment color.
21		#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
22		#' if the default limits are not suitable.
23		#' @param alpha subject line transparency (0 = transparent, 1 = opaque)
24		#' @param facet_ncol number of facets per row.
25		#' @param facet_scales passed to `scales` in [`ggplot2::facet_wrap`]. Should scales be fixed (`"fixed"`,
26		#' the default), free (`"free"`), or free in one dimension (`"free_x"`, `"free_y"`)?
27		#' @param xtick a vector to define the tick values of time in x-axis.
28		#' Default value is `ggplot2::waiver()`.
29		#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values. Default
30		#' value is `ggplot2::waiver()`.
31		#' @param rotate_xlab boolean whether to rotate x-axis labels.
32		#' @param font_size control font size for title, x-axis, y-axis and legend font.
33		#' @param dot_size plot dot size. Default to 2.
34		#' @param group_stats control group mean or median overlay.
35		#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
36		#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
37		#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
38		#' @param hline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
39		#' The data inside of the `ggplot2` object must also contain the columns with these variable names
40		#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
41		#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
42		#'
43		#'
44		#' @author Wenyi Liu (wenyi.liu@roche.com)
45		#'
46		#' @return \code{ggplot} object
47		#'
48		#' @export
49		#'
50		#' @examples
51		#' # Example using ADaM structure analysis dataset.
52		#'
53		#' library(stringr)
54		#'
55		#' # original ARM value = dose value
56		#' arm_mapping <- list(
57		#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
58		#' )
59		#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
60		#'
61		#' ADLB <- rADLB
62		#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
63		#' ADLB <- ADLB %>%
64		#' mutate(AVISITCD = case_when(
65		#' AVISIT == "SCREENING" ~ "SCR",
66		#' AVISIT == "BASELINE" ~ "BL",
67		#' grepl("WEEK", AVISIT) ~
68		#' paste(
69		#' "W",
70		#' trimws(
71		#' substr(
72		#' AVISIT,
73		#' start = 6,
74		#' stop = str_locate(AVISIT, "DAY") - 1
75		#' )
76		#' )
77		#' ),
78		#' TRUE ~ NA_character_
79		#' )) %>%
80		#' mutate(AVISITCDN = case_when(
81		#' AVISITCD == "SCR" ~ -2,
82		#' AVISITCD == "BL" ~ 0,
83		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
84		#' TRUE ~ NA_real_
85		#' )) %>%
86		#' # use ARMCD values to order treatment in visualization legend
87		#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
88		#' ifelse(grepl("B", ARMCD), 2,
89		#' ifelse(grepl("A", ARMCD), 3, NA)
90		#' )
91		#' )) %>%
92		#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
93		#' mutate(ARM = factor(ARM) %>%
94		#' reorder(TRTORD)) %>%
95		#' mutate(ANRLO = .5, ANRHI = 1) %>%
96		#' rowwise() %>%
97		#' group_by(PARAMCD) %>%
98		#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
99		#' paste("<", round(runif(1, min = .5, max = .7))), LBSTRESC
100		#' )) %>%
101		#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
102		#' paste(">", round(runif(1, min = .9, max = 1.2))), LBSTRESC
103		#' )) %>%
104		#' ungroup()
105		#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
106		#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
107		#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
108		#'
109		#' # add LLOQ and ULOQ variables
110		#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL")
111		#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
112		#'
113		#' g_spaghettiplot(
114		#' data = ADLB,
115		#' subj_id = "USUBJID",
116		#' biomarker_var = "PARAMCD",
117		#' biomarker = "CRP",
118		#' value_var = "AVAL",
119		#' trt_group = "ARM",
120		#' time = "AVISITCD",
121		#' color_manual = color_manual,
122		#' color_comb = "#39ff14",
123		#' alpha = .02,
124		#' xtick = c("BL", "W 1", "W 4"),
125		#' xlabel = c("Baseline", "Week 1", "Week 4"),
126		#' rotate_xlab = FALSE,
127		#' group_stats = "median",
128		#' hline_vars = c("ANRHI", "ANRLO"),
129		#' hline_vars_colors = c("pink", "brown")
130		#' )
131		#'
132		#' g_spaghettiplot(
133		#' data = ADLB,
134		#' subj_id = "USUBJID",
135		#' biomarker_var = "PARAMCD",
136		#' biomarker = "CRP",
137		#' value_var = "AVAL",
138		#' trt_group = "ARM",
139		#' time = "AVISITCD",
140		#' color_manual = color_manual,
141		#' color_comb = "#39ff14",
142		#' alpha = .02,
143		#' xtick = c("BL", "W 1", "W 4"),
144		#' xlabel = c("Baseline", "Week 1", "Week 4"),
145		#' rotate_xlab = FALSE,
146		#' group_stats = "median",
147		#' hline_arb = 1.3,
148		#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
149		#' hline_vars_colors = c("pink", "brown", "purple", "gray"),
150		#' dot_size = 3
151		#' )
152		#'
153		#' g_spaghettiplot(
154		#' data = ADLB,
155		#' subj_id = "USUBJID",
156		#' biomarker_var = "PARAMCD",
157		#' biomarker = "CRP",
158		#' value_var = "AVAL",
159		#' trt_group = "ARM",
160		#' time = "AVISITCDN",
161		#' color_manual = color_manual,
162		#' color_comb = "#39ff14",
163		#' alpha = .02,
164		#' xtick = c(0, 1, 4),
165		#' xlabel = c("Baseline", "Week 1", "Week 4"),
166		#' rotate_xlab = FALSE,
167		#' group_stats = "median",
168		#' hline_arb = c(.5, .7, 1),
169		#' hline_arb_color = c("blue", "red", "green"),
170		#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
171		#' hline_vars = c("ANRHI", "ANRLO"),
172		#' dot_size = 4
173		#' )
174		#'
175		#' # removing missing levels from the plot with facet_scales
176		#'
177		#' g_spaghettiplot(
178		#' data = ADLB,
179		#' subj_id = "USUBJID",
180		#' biomarker_var = "PARAMCD",
181		#' biomarker = "CRP",
182		#' value_var = "AVAL",
183		#' trt_group = "ARM",
184		#' time = "RACE",
185		#' color_manual = color_manual,
186		#' color_comb = "#39ff14",
187		#' alpha = .02,
188		#' facet_scales = "fixed",
189		#' rotate_xlab = FALSE,
190		#' group_stats = "median",
191		#' hline_arb = c(.5, .7, 1),
192		#' hline_arb_color = c("blue", "red", "green"),
193		#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
194		#' hline_vars = c("ANRHI", "ANRLO")
195		#' )
196		#'
197		#' g_spaghettiplot(
198		#' data = ADLB,
199		#' subj_id = "USUBJID",
200		#' biomarker_var = "PARAMCD",
201		#' biomarker = "CRP",
202		#' value_var = "AVAL",
203		#' trt_group = "ARM",
204		#' time = "RACE",
205		#' color_manual = color_manual,
206		#' color_comb = "#39ff14",
207		#' alpha = .02,
208		#' facet_scales = "free_x",
209		#' rotate_xlab = FALSE,
210		#' group_stats = "median",
211		#' hline_arb = c(.5, .7, 1),
212		#' hline_arb_color = c("blue", "red", "green"),
213		#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
214		#' hline_vars = c("ANRHI", "ANRLO"),
215		#' dot_size = 1
216		#' )
217		#'
218		g_spaghettiplot <- function(data,
219		subj_id = "USUBJID",
220		biomarker_var = "PARAMCD",
221		biomarker_var_label = "PARAM",
222		biomarker,
223		value_var = "AVAL",
224		unit_var = "AVALU",
225		trt_group,
226		trt_group_level = NULL,
227		loq_flag_var = "LOQFL",
228		time,
229		time_level = NULL,
230		color_manual = NULL,
231		color_comb = "#39ff14",
232		ylim = c(NA, NA),
233		alpha = 1.0,
234		facet_ncol = 2,
235		facet_scales = c("fixed", "free", "free_x", "free_y"),
236		xtick = ggplot2::waiver(),
237		xlabel = xtick,
238		rotate_xlab = FALSE,
239		font_size = 12,
240		dot_size = 2,
241		group_stats = "NONE",
242		hline_arb = numeric(0),
243		hline_arb_color = "red",
244		hline_arb_label = "Horizontal line",
245		hline_vars = character(0),
246		hline_vars_colors = "green",
247		hline_vars_labels = hline_vars) {
248	!	checkmate::assert_numeric(ylim, len = 2)
249	!	facet_scales <- match.arg(facet_scales)
250
251		## Pre-process data
252	!	label_trt_group <- attr(data[[trt_group]], "label")
253	!	data[[trt_group]] <- if (!is.null(trt_group_level)) {
254	!	factor(data[[trt_group]], levels = trt_group_level)
255		} else {
256	!	factor(data[[trt_group]])
257		}
258	!	attr(data[[trt_group]], "label") <- label_trt_group
259
260
261	!	xtype <- ifelse(is.factor(data[[time]]) \| is.character(data[[time]]), "discrete", "continuous")
262	!	gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")
263	!	if (xtype == "discrete") {
264	!	data[[time]] <- if (!is.null(time_level)) {
265	!	factor(data[[time]], levels = time_level)
266		} else {
267	!	factor(data[[time]])
268		}
269		}
270
271		# Plot
272	!	plot_data <- data %>%
273	!	filter(!!sym(biomarker_var) %in% biomarker)
274	!	unit <- plot_data %>%
275	!	select(!!sym(unit_var)) %>%
276	!	unique() %>%
277	!	magrittr::extract2(1)
278	!	unit1 <- ifelse(is.na(unit) \| unit == "", " ", paste0(" (", unit, ") "))
279	!	biomarker1 <- plot_data %>%
280	!	select(!!sym(biomarker_var_label)) %>%
281	!	unique() %>%
282	!	magrittr::extract2(1)
283	!	gtitle <- paste0(biomarker1, unit1, " Values by Treatment @ Visits")
284	!	gylab <- paste0(biomarker1, " ", value_var, " Values")
285
286		# Setup legend label
287	!	trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
288
289		# Add footnote to identify LLOQ and ULOQ values pulled from data
290	!	caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var)
291
292	!	plot <- ggplot2::ggplot(
293	!	data = plot_data,
294	!	ggplot2::aes(x = !!sym(time), y = !!sym(value_var), color = !!sym(trt_group), group = !!sym(subj_id))
295		) +
296	!	ggplot2::geom_point(size = dot_size, na.rm = TRUE, ggplot2::aes(shape = !!sym(loq_flag_var))) +
297	!	ggplot2::geom_line(linewidth = 0.4, alpha = alpha, na.rm = TRUE) +
298	!	ggplot2::facet_wrap(trt_group, ncol = facet_ncol, scales = facet_scales) +
299	!	ggplot2::labs(caption = caption_loqs_label) +
300	!	ggplot2::theme_bw() +
301	!	ggplot2::ggtitle(gtitle) +
302	!	ggplot2::xlab(gxlab) +
303	!	ggplot2::ylab(gylab) +
304	!	ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin(), hjust = 0.5))
305
306		# Apply y-axis zoom range
307	!	plot <- plot + ggplot2::coord_cartesian(ylim = ylim)
308
309		# add group statistics
310		# can't use stat_summary() because of presenting values for groups with all missings
311	!	if (group_stats != "NONE") {
312	!	if (group_stats == "MEAN") {
313	!	plot_data_groupped <- plot_data %>%
314	!	group_by(!!sym(trt_group), !!sym(time)) %>%
315	!	transmute(AGG_VAL = mean(!!sym(value_var), na.rm = TRUE))
316
317	!	plot_data_groupped$metric <- "Mean"
318		} else {
319	!	plot_data_groupped <- plot_data %>%
320	!	group_by(!!sym(trt_group), !!sym(time)) %>%
321	!	transmute(AGG_VAL = stats::median(!!sym(value_var), na.rm = TRUE))
322
323	!	plot_data_groupped$metric <- "Median"
324		}
325	!	plot <- plot +
326	!	ggplot2::geom_line(
327	!	ggplot2::aes(x = !!sym(time), y = .data$AGG_VAL, group = 1, linetype = .data$metric),
328	!	data = plot_data_groupped,
329	!	lwd = 1,
330	!	color = color_comb,
331	!	na.rm = TRUE
332		) +
333	!	ggplot2::guides(linetype = ggplot2::guide_legend("Group statistic", order = 2))
334		}
335		# Format x-label
336	!	if (xtype == "continuous") {
337	!	plot <- plot +
338	!	ggplot2::scale_x_continuous(breaks = xtick, labels = xlabel, limits = c(NA, NA))
339	!	} else if (xtype == "discrete") {
340	!	plot <- plot +
341	!	ggplot2::scale_x_discrete(breaks = xtick, labels = xlabel)
342		}
343	!	if (rotate_xlab) {
344	!	plot <- plot +
345	!	ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
346		}
347		# Add manual color
348	!	if (!is.null(color_manual)) {
349	!	plot <- plot +
350	!	ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
351		} else {
352	!	plot +
353	!	ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
354		}
355
356
357		# Format font size
358	!	if (!is.null(font_size)) {
359	!	plot <- plot +
360	!	ggplot2::theme(
361	!	plot.title = ggplot2::element_text(size = font_size, margin = ggplot2::margin()),
362	!	axis.title.x = ggplot2::element_text(size = font_size),
363	!	axis.text.x = ggplot2::element_text(size = font_size),
364	!	axis.title.y = ggplot2::element_text(size = font_size),
365	!	axis.text.y = ggplot2::element_text(size = font_size),
366	!	legend.title = ggplot2::element_text(size = font_size),
367	!	legend.text = ggplot2::element_text(size = font_size),
368	!	strip.text.x = ggplot2::element_text(size = font_size),
369	!	strip.text.y = ggplot2::element_text(size = font_size)
370		)
371		}
372		# Add horizontal line for range based on option
373	!	plot + geom_axes_lines(
374	!	plot_data,
375	!	hline_arb = hline_arb,
376	!	hline_arb_color = hline_arb_color,
377	!	hline_arb_label = hline_arb_label,
378	!	hline_vars = hline_vars,
379	!	hline_vars_colors = hline_vars_colors,
380	!	hline_vars_labels = hline_vars_labels
381		)
382		}

1		#' Function to create a scatter plot.
2		#'
3		#' @description
4		#' `r lifecycle::badge("deprecated")`
5		#'
6		#' `g_scatterplot()` is deprecated. Please use
7		#' [g_correlationplot()] instead. Default plot displays scatter facetted by
8		#' visit with color attributed treatment arms and symbol attributed `LOQ` values.
9		#'
10		#' @param label text string to used to identify plot.
11		#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
12		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
13		#' @param param biomarker to visualize e.g. `IGG`.
14		#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`.
15		#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis e.g. `AVAL`.
16		#' @param trt_group name of variable representing treatment group e.g. `ARM`.
17		#' @param visit name of variable containing nominal visits e.g. `AVISITCD`.
18		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
19		#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
20		#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
21		#' if the default limits are not suitable.
22		#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
23		#' if the default limits are not suitable.
24		#' @param color_manual vector of colors applied to treatment values.
25		#' @param shape_manual vector of symbols applied to `LOQ` values.
26		#' @param facet_ncol number of facets per row.
27		#' @param facet set layout to use treatment facetting.
28		#' @param facet_var variable to use for treatment facetting.
29		#' @param reg_line include regression line and annotations for slope and coefficient in
30		#' visualization. Use with facet = TRUE.
31		#' @param hline y-axis value to position a horizontal line.
32		#' @param vline x-axis value to position a vertical line.
33		#' @param rotate_xlab 45 degree rotation of x-axis label values.
34		#' @param font_size font size control for title, x-axis label, y-axis label and legend.
35		#' @param dot_size plot dot size.
36		#' @param reg_text_size font size control for regression line annotations.
37		#'
38		#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
39		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
40		#'
41		#' @details Regression uses `deming` model.
42		#'
43		#' @export
44		#'
45		#' @examples
46		#' # Example using ADaM structure analysis dataset.
47		#'
48		#' library(stringr)
49		#'
50		#' # original ARM value = dose value
51		#' arm_mapping <- list(
52		#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
53		#' )
54		#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
55		#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA"
56		#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)
57		#'
58		#' ADLB <- rADLB
59		#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
60		#' ADLB <- ADLB %>%
61		#' mutate(AVISITCD = case_when(
62		#' AVISIT == "SCREENING" ~ "SCR",
63		#' AVISIT == "BASELINE" ~ "BL",
64		#' grepl("WEEK", AVISIT) ~
65		#' paste(
66		#' "W",
67		#' trimws(
68		#' substr(
69		#' AVISIT,
70		#' start = 6,
71		#' stop = str_locate(AVISIT, "DAY") - 1
72		#' )
73		#' )
74		#' ),
75		#' TRUE ~ NA_character_
76		#' )) %>%
77		#' mutate(AVISITCDN = case_when(
78		#' AVISITCD == "SCR" ~ -2,
79		#' AVISITCD == "BL" ~ 0,
80		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
81		#' TRUE ~ NA_real_
82		#' )) %>%
83		#' # use ARMCD values to order treatment in visualization legend
84		#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
85		#' ifelse(grepl("B", ARMCD), 2,
86		#' ifelse(grepl("A", ARMCD), 3, NA)
87		#' )
88		#' )) %>%
89		#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
90		#' mutate(ARM = factor(ARM) %>%
91		#' reorder(TRTORD))
92		#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
93		#'
94		#' g_scatterplot(
95		#' label = "Scatter Plot",
96		#' data = ADLB,
97		#' param_var = "PARAMCD",
98		#' param = c("ALT"),
99		#' xaxis_var = "BASE",
100		#' yaxis_var = "AVAL",
101		#' trt_group = "ARM",
102		#' visit = "AVISITCD",
103		#' loq_flag_var = "LOQFL",
104		#' unit = "AVALU",
105		#' color_manual = color_manual,
106		#' shape_manual = shape_manual,
107		#' facet_ncol = 2,
108		#' facet = TRUE,
109		#' facet_var = "ARM",
110		#' reg_line = TRUE,
111		#' hline = NULL,
112		#' vline = .5,
113		#' rotate_xlab = TRUE,
114		#' font_size = 14,
115		#' dot_size = 2,
116		#' reg_text_size = 3
117		#' )
118		g_scatterplot <- function(label = "Scatter Plot",
119		data,
120		param_var = "PARAMCD",
121		param = "CRP",
122		xaxis_var = "BASE",
123		yaxis_var = "AVAL",
124		trt_group = "ARM",
125		visit = "AVISITCD",
126		loq_flag_var = "LOQFL",
127		unit = "AVALU",
128		xlim = c(NA, NA),
129		ylim = c(NA, NA),
130		color_manual = NULL,
131		shape_manual = NULL,
132		facet_ncol = 2,
133		facet = FALSE,
134		facet_var = "ARM",
135		reg_line = FALSE,
136		hline = NULL,
137		vline = NULL,
138		rotate_xlab = FALSE,
139		font_size = 12,
140		dot_size = NULL,
141		reg_text_size = 3) {
142	!	lifecycle::deprecate_soft(
143	!	when = "0.1.15",
144	!	what = "g_scatterplot()",
145	!	details = "You should use goshawk::g_correlationplot instead of goshawk::g_scatterplot"
146		)
147
148	!	checkmate::assert_numeric(xlim, len = 2)
149	!	checkmate::assert_numeric(ylim, len = 2)
150
151		# create scatter plot over time pairwise per treatment arm
152	!	plot_data <- data %>%
153	!	filter(!!sym(param_var) == param)
154		# Setup the ggtitle label. Combine the biomarker and the units (if available)
155	!	ggtitle_label <- ifelse(is.null(unit), paste0(plot_data$PARAM, "@ Visits"),
156	!	ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, "@ Visits"),
157	!	paste0(plot_data$PARAM, " (", plot_data[[unit]], ") @ Visits")
158		)
159		)
160		# Setup the x-axis label. Combine the biomarker and the units (if available)
161	!	x_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, xaxis_var, "Values"),
162	!	ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, xaxis_var, "Values"),
163	!	paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values")
164		)
165		)
166		# Setup the y-axis label. Combine the biomarker and the units (if available)
167	!	y_axis_label <- ifelse(is.null(unit), paste(plot_data$PARAM, yaxis_var, "Values"),
168	!	ifelse(plot_data[[unit]] == "", paste(plot_data$PARAM, yaxis_var, "Values"),
169	!	paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", yaxis_var, " Values")
170		)
171		)
172		# Setup legend label
173	!	trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
174		# create plot foundation
175	!	plot1 <- ggplot2::ggplot(
176	!	data = plot_data,
177	!	ggplot2::aes(
178	!	x = !!sym(xaxis_var),
179	!	y = !!sym(yaxis_var),
180	!	color = !!sym(trt_group)
181		)
182		) +
183	!	ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE) +
184	!	ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
185	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol) +
186	!	ggplot2::theme_bw() +
187	!	ggplot2::ggtitle(ggtitle_label) +
188	!	ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
189	!	ggplot2::xlab(x_axis_label) +
190	!	ggplot2::ylab(y_axis_label)
191		# add grid faceting to foundation
192	!	if (facet) {
193	!	plot1 <- plot1 +
194	!	ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit)))
195		}
196		# add regression line
197	!	if (reg_line) {
198	!	slope <- function(x, y) {
199	!	ratio <- stats::sd(x) / stats::sd(y)
200	!	res <- if (!is.na(ratio) && ratio > 0) {
201	!	reg <- mc.deming(y, x, ratio)
202		# return the evaluation of the ratio condition as third value in numeric vector
203		# for conttroling downstream processing
204	!	c(
205	!	round(reg$b0, 2), round(reg$b1, 2),
206	!	ifelse(!is.na(ratio) && ratio > 0, stats::cor(y, x, method = "spearman", use = "complete.obs"), NA_real_)
207		)
208		} else {
209		# if ratio condition is not met then assign NA to returned vector
210		# so that NULL condition does not throw error below
211	!	as.numeric(c(NA, NA, NA))
212		}
213	!	return(as_tibble(stats::setNames(as.list(res), c("intercept", "slope", "corr"))))
214		}
215	!	sub_data <- plot_data %>%
216	!	select(!!sym(trt_group), !!sym(visit), !!sym(xaxis_var), !!sym(yaxis_var)) %>%
217	!	filter(!is.na(!!sym(yaxis_var)) & !is.na(!!sym(xaxis_var))) %>%
218	!	group_by(!!sym(trt_group), !!sym(visit)) %>%
219	!	do(slope(.data[[yaxis_var]], .data[[xaxis_var]]))
220
221	!	if (!(all(is.na(sub_data$intercept)) && all(is.na(sub_data$slope)))) {
222	!	plot1 <- plot1 +
223	!	ggplot2::geom_abline(
224	!	data = sub_data,
225		# has to put some neutral values for missings, i.e. big & negative intercept + 0 slope
226	!	ggplot2::aes(
227	!	intercept = vapply(.data$intercept, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = -9999),
228	!	slope = vapply(.data$slope, function(x) if (!is.na(x)) x else numeric(1), FUN.VALUE = 0),
229	!	color = !!sym(trt_group)
230		)
231		)
232		}
233	!	plot1 <- plot1 +
234	!	ggplot2::geom_text(
235	!	data = filter(sub_data, row_number() == 1),
236	!	ggplot2::aes(
237	!	x = -Inf,
238	!	y = Inf,
239	!	hjust = 0,
240	!	vjust = 1,
241	!	label = ifelse(
242	!	!is.na(.data$intercept) & !is.na(.data$slope) & !is.na(.data$corr),
243	!	sprintf("y = %.2f+%.2fX\ncor = %.2f", .data$intercept, .data$slope, .data$corr),
244	!	paste0("Insufficient Data For Regression")
245		),
246	!	color = !!sym(trt_group)
247		),
248	!	size = reg_text_size
249		) +
250	!	ggplot2::labs(caption = paste("Deming Regression Model, Spearman Correlation Method"))
251		}
252		# Add abline
253	!	if (yaxis_var %in% c("AVAL", "AVALL2", "BASE2", "BASE2L2", "BASE", "BASEL2")) {
254	!	plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 1)
255		}
256	!	if (yaxis_var %in% c("CHG2", "CHG")) {
257	!	plot1 <- plot1 + ggplot2::geom_abline(intercept = 0, slope = 0)
258		}
259	!	if (yaxis_var %in% c("PCHG2", "PCHG")) {
260	!	plot1 <- plot1 + ggplot2::geom_abline(intercept = 100, slope = 0)
261		}
262		# Format font size
263	!	if (!is.null(font_size)) {
264	!	plot1 <- plot1 +
265	!	ggplot2::theme(
266	!	axis.title.x = ggplot2::element_text(size = font_size),
267	!	axis.text.x = ggplot2::element_text(size = font_size),
268	!	axis.title.y = ggplot2::element_text(size = font_size),
269	!	axis.text.y = ggplot2::element_text(size = font_size),
270	!	legend.title = ggplot2::element_text(size = font_size),
271	!	legend.text = ggplot2::element_text(size = font_size),
272	!	strip.text.x = ggplot2::element_text(size = font_size),
273	!	strip.text.y = ggplot2::element_text(size = font_size)
274		)
275		}
276		# Format treatment color
277	!	if (!is.null(color_manual)) {
278	!	plot1 <- plot1 +
279	!	ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
280		} else {
281	!	plot1 +
282	!	ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
283		}
284
285		# Format LOQ flag symbol shape
286	!	if (!is.null(shape_manual)) {
287	!	plot1 <- plot1 +
288	!	ggplot2::scale_shape_manual(values = shape_manual, name = "LOQ")
289		}
290		# Format dot size
291	!	if (!is.null(dot_size)) {
292	!	plot1 <- plot1 +
293	!	ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE)
294		}
295		# Format x-label
296	!	if (rotate_xlab) {
297	!	plot1 <- plot1 +
298	!	ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
299		}
300		# Add horizontal line
301	!	if (!is.null(hline)) {
302	!	plot1 <- plot1 +
303	!	ggplot2::geom_hline(ggplot2::aes(yintercept = hline), color = "red", linetype = "dashed", size = 0.5)
304		}
305		# Add vertical line
306	!	if (!is.null(vline)) {
307	!	plot1 <- plot1 +
308	!	ggplot2::geom_vline(ggplot2::aes(xintercept = vline), color = "red", linetype = "dashed", size = 0.5)
309		}
310	!	plot1
311		}

1		#' Helper for identifying any `LLOQ` and `ULOQ` values in `LBSTRESC`. Outcome drives
2		#' horizontal line functionality display and legend labeling along with display
3		#' of values in footnote.
4		#'
5		#' @details Biomarker Sciences would like to have `LLOQ` and `ULOQ` values available for
6		#' reference in the visualizations. This also aids in setting the data constraint
7		#' ranges when `goshawk` functions are run from `teal.goshawk` `UI`.
8		#'
9		#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values
10		#'
11		#' @import dplyr
12		#' @keywords internal
13		#'
14		#' @examples
15		#' goshawk:::h_identify_loq_values(loqs_data = goshawk::rADLB, flag_var = "LOQFL")
16		h_identify_loq_values <- function(loqs_data, flag_var) {
17	!	ifelse(
18	!	!grep("PARAM", names(loqs_data)),
19	!	stop("Assay dataset must include variable PARAM to use the caption_loqs_label function."),
20	!	1
21		)
22	!	ifelse(
23	!	!grep("LBSTRESC", names(loqs_data)),
24	!	stop("Assay dataset must include variable LBSTRESC to use the caption_loqs_label function."),
25	!	1
26		)
27
28		# filter for records only relevant to loq.
29		# get LLOQ value
30	!	lloq <- loqs_data %>%
31	!	filter(!!sym(flag_var) == "Y") %>%
32	!	select("PARAM", "LBSTRESC") %>%
33	!	filter(grepl("<", .data$LBSTRESC, fixed = FALSE)) %>%
34	!	mutate(LLOQC = .data$LBSTRESC, LLOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>%
35	!	group_by(.data$PARAM) %>%
36	!	slice(1) %>%
37	!	ungroup() %>%
38	!	select(-"LBSTRESC")
39
40
41		# get ULOQ value
42	!	uloq <- loqs_data %>%
43	!	filter(!!sym(flag_var) == "Y") %>%
44	!	select("PARAM", "LBSTRESC") %>%
45	!	filter(grepl(">", .data$LBSTRESC, fixed = FALSE)) %>%
46	!	mutate(ULOQC = .data$LBSTRESC, ULOQN = as.numeric(gsub("[^0-9.-]", "", .data$LBSTRESC))) %>%
47	!	group_by(.data$PARAM) %>%
48	!	slice(1) %>%
49	!	ungroup() %>%
50	!	select(-"LBSTRESC")
51
52
53		# return LOQ data
54	!	loq_values <- merge(lloq, uloq, by = "PARAM", all = TRUE)
55	!	if (nrow(loq_values) == 0) {
56	!	loq_values <- data.frame(
57	!	PARAM = names(table(droplevels(as.factor(loqs_data$PARAM)))),
58	!	LLOQC = NA,
59	!	LLOQN = NA,
60	!	ULOQC = NA,
61	!	ULOQN = NA
62		)
63		}
64
65	!	attr(loq_values[["PARAM"]], "label") <- "Parameter"
66	!	attr(loq_values[["LLOQC"]], "label") <- "Lower Limit of Quantitation (C)"
67	!	attr(loq_values[["LLOQN"]], "label") <- "Lower Limit of Quantitation"
68	!	attr(loq_values[["ULOQC"]], "label") <- "Upper Limit of Quantitation (C)"
69	!	attr(loq_values[["ULOQN"]], "label") <- "Upper Limit of Quantitation"
70
71	!	return(loq_values)
72		}
73
74		#' Add footnote to identify `LLOQ` and `ULOQ` values identified from data
75		#'
76		#' @param loqs_data (`data frame`)\cr `loqs_data` data set containing assay data with potential `LOQ` values
77		#'
78		#' @import dplyr
79		#' @keywords internal
80		#'
81		#' @examples
82		#' caption_label <- goshawk:::h_caption_loqs_label(loqs_data = goshawk::rADLB, flag_var = "LOQFL")
83		h_caption_loqs_label <- function(loqs_data, flag_var) {
84	!	loq_values <- h_identify_loq_values(loqs_data, flag_var)
85
86	!	lloqc <- ifelse(is.na(loq_values$LLOQC), "NA", as.character(loq_values$LLOQC))
87	!	uloqc <- ifelse(is.na(loq_values$ULOQC), "NA", as.character(loq_values$ULOQC))
88
89		# create caption
90	!	caption_loqs_label <- paste0(
91	!	"Limits of quantification read from study data for ",
92	!	loqs_data$PARAM,
93	!	": LLOQ is ",
94	!	lloqc,
95	!	", ULOQ is ",
96	!	uloqc
97		)
98
99	!	return(caption_loqs_label)
100		}
101
102		#' Check that argument is a valid color
103		#'
104		#' Checks if the argument can be converted to valid RGB values space. See `grDevices::col2rgb`.
105		#'
106		#' @inheritParams checkmate::checkCharacter
107		#' @param color (`character`)\cr
108		#' Valid color convertible to RGB scale by [grDevices::col2rgb()]
109		#'
110		#' @inherit checkmate::checkCharacter return
111		#' @keywords internal
112		check_color <- function(color,
113		min.len = NULL, # nolint
114		max.len = NULL, # nolint
115		any.missing = TRUE, # nolint
116		all.missing = TRUE, # nolint
117		len = NULL,
118		null.ok = FALSE) { # nolint
119	!	string_check <- checkmate::check_character(
120	!	color,
121	!	min.len = min.len, max.len = max.len, any.missing = any.missing, len = len, null.ok = null.ok
122		)
123	!	if (!isTRUE(string_check)) {
124	!	return(string_check)
125		}
126
127	!	res <- sapply(color, function(col) {
128	!	tryCatch(
129	!	is.matrix(grDevices::col2rgb(col)),
130	!	error = function(e) FALSE
131		)
132		})
133
134	!	if (any(!res)) {
135	!	"Must be a valid color, convertible to rgb by 'col2rgb'"
136		} else {
137	!	TRUE
138		}
139		}
140
141		#' @rdname check_color
142		assert_color <- checkmate::makeAssertionFunction(check_color)

1		#' Add horizontal and/or vertical lines and their legend labels to a plot
2		#'
3		#' This function is currently designed to be used with \code{\link{g_boxplot}}, \code{\link{g_correlationplot}},
4		#' \code{\link{g_spaghettiplot}}, and ('g_density_distribution_plot'), but may also work in general.
5		#'
6		#' @param data ('data.frame') data where `hline_vars` and `vline_var` columns are taken from.
7		#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
8		#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
9		#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
10		#' @param hline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
11		#' Needs `data` to be specified.
12		#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
13		#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
14		#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines.
15		#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines.
16		#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines.
17		#' @param vline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
18		#' Needs `data` to be specified.
19		#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables.
20		#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables.
21		#'
22		#' @examples
23		#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(wt, mpg)) +
24		#' ggplot2::geom_point() +
25		#' goshawk:::geom_axes_lines(
26		#' hline_arb = c(20, 25, 30),
27		#' hline_arb_color = "red",
28		#' hline_arb_label = "Hori Line"
29		#' )
30		#' @return \code{ggplot} object
31		#' @keywords internal
32		#'
33		geom_axes_lines <- function(data,
34		hline_arb = numeric(0),
35		hline_arb_color = "red",
36		hline_arb_label = "Horizontal line",
37		hline_vars = character(0),
38		hline_vars_colors = "green",
39		hline_vars_labels = hline_vars,
40		vline_arb = numeric(0),
41		vline_arb_color = "red",
42		vline_arb_label = "Vertical line",
43		vline_vars = character(0),
44		vline_vars_colors = "green",
45		vline_vars_labels = vline_vars) {
46	!	arb_hlines <- if (length(hline_arb) > 0) {
47	!	geom_arb_hline(
48	!	yintercept = hline_arb,
49	!	color = hline_arb_color,
50	!	label = hline_arb_label,
51	!	legend_title = "Horizontal arbitrary line(s)",
52	!	linetype = 2
53		)
54		}
55
56	!	range_hlines <- if (length(hline_vars > 0)) {
57	!	geom_range_hline(
58	!	data = data,
59	!	vars = hline_vars,
60	!	color = hline_vars_colors,
61	!	label = hline_vars_labels,
62	!	linetype = 2
63		)
64		}
65
66	!	arb_vlines <- if (length(vline_arb) > 0) {
67	!	geom_arb_vline(
68	!	xintercept = vline_arb,
69	!	color = vline_arb_color,
70	!	label = vline_arb_label,
71	!	legend_title = "Vertical arbitrary line(s)",
72	!	linetype = 2
73		)
74		}
75
76	!	range_vlines <- if (length(vline_vars) > 0) {
77	!	geom_range_vline(
78	!	data = data,
79	!	vars = vline_vars,
80	!	color = vline_vars_colors,
81	!	label = vline_vars_labels,
82	!	linetype = 2
83		)
84		}
85
86	!	Filter(
87	!	function(x) !is.null(x) \|\| !is.na(x),
88	!	list(
89	!	arb_hlines,
90	!	range_hlines,
91	!	arb_vlines,
92	!	range_vlines
93		)
94		)
95		}
96
97		#' Validate line arguments given in the parameters against the data.
98		#'
99		#' helper function to be called by [geom_axes_lines()]
100		#'
101		#' @param data (`data.frame`)\cr
102		#' should contain `vars` which will be used to create the plot.
103		#' @param vars (`character`)\cr
104		#' names of variables to take the values from. Only first value from the variable will be
105		#' applied.
106		#' @param color (`character`)\cr
107		#' colors for the lines defined by variables.
108		#' @param label (`character`)\cr
109		#' labels for the legend to the lines defined by variables.
110		#'
111		#' @return (`data.frame`) containing the `values`,`colors` and `labels` fields defining attributes
112		#' for horizontal or vertical lines.
113		#' @keywords internal
114		#'
115		validate_line_args <- function(data,
116		vars = character(0),
117		color = "green",
118		label = vars) {
119	!	if (length(vars) > 0) {
120	!	stopifnot(all(vars %in% names(data)))
121	!	checkmate::assert_data_frame(data[vars], types = "numeric")
122	!	checkmate::assert(
123	!	check_color(color, len = 1),
124	!	check_color(color, len = length(vars))
125		)
126	!	checkmate::assert_character(label, len = length(vars))
127
128
129	!	label <- vapply(
130	!	vars,
131	!	FUN.VALUE = character(1),
132	!	USE.NAMES = FALSE,
133	!	FUN = function(x) {
134	!	if (is.null(attributes(data[[x]])$label)) {
135	!	x
136		} else {
137	!	attributes(data[[x]])$label
138		}
139		}
140		)
141
142	!	vars <- sapply(
143	!	vars,
144	!	USE.NAMES = FALSE,
145	!	function(name) {
146	!	x <- data[[name]]
147	!	vals <- unique(x)
148	!	if (!checkmate::test_number(vals)) {
149	!	warning(sprintf("First value is taken from variable '%s' to draw the straight line", name))
150		}
151	!	vals[1]
152		}
153		)
154		} else {
155	!	vars <- numeric(0)
156	!	color <- character(0)
157	!	label <- character(0)
158		}
159
160	!	data.frame(
161	!	values = vars,
162	!	colors = color,
163	!	labels = label
164		)
165		}
166
167		#' Straight lines for `ggplot2`
168		#'
169		#' Arbitrary lines for `ggplot2`
170		#' @name geom_straight_lines
171		#' @param vars (`character`)\cr
172		#' names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
173		#' @param xintercept (`numeric`)\cr
174		#' Position of the vertical line(s) on the x-axis
175		#' @param yintercept (`numeric`)\cr
176		#' Position of the horizontal line(s) on the y-axis
177		#' @param label (`character`)\cr
178		#' Label to be rendered in the legend.
179		#' Should be a single string or vector of length equal to length of `xintercept`.
180		#' @param color (`character`)\cr
181		#' Valid color convertible to RGB scale by [grDevices::col2rgb()].
182		#' Should be a single string or vector of length equal to length of `xintercept`.
183		#'
184		#' @inherit ggplot2::geom_hline return
185		#'
186		#' @keywords internal
187		#'
188		NULL
189
190		#' @rdname geom_straight_lines
191		#' @examples
192		#' # horizontal arbitrary lines
193		#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5))
194		#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
195		#' ggplot2::geom_point() +
196		#' goshawk:::geom_arb_hline(
197		#' yintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2
198		#' )
199		geom_arb_hline <- function(yintercept,
200		label = "Horizontal line",
201		color = "red",
202		legend_title = "Horizontal line(s)",
203		...) {
204	!	checkmate::assert_numeric(yintercept, min.len = 1)
205	!	checkmate::assert(
206	!	check_color(color, len = 1),
207	!	check_color(color, len = length(yintercept))
208		)
209	!	checkmate::assert(
210	!	checkmate::check_string(label),
211	!	checkmate::check_character(label, len = length(yintercept))
212		)
213	!	data <- data.frame(yintercept, color, label, color_var = paste(color, label))
214
215	!	list(
216	!	ggnewscale::new_scale_color(),
217	!	ggplot2::geom_hline(
218	!	data = data,
219	!	mapping = ggplot2::aes(
220	!	yintercept = yintercept,
221	!	color = .data[["color_var"]], # need legend entry for each color-label combination
222		),
223		...
224		),
225	!	ggplot2::scale_color_manual(
226	!	name = legend_title,
227	!	values = stats::setNames(data$color, data$color_var),
228	!	labels = data$label,
229	!	limits = data$color_var,
230	!	guide = ggplot2::guide_legend(order = 11) # high order to be put after main plot items
231		)
232		)
233		}
234
235		#' @rdname geom_straight_lines
236		#' @examples
237		#' # vertical arbitrary lines
238		#' data <- data.frame(x = seq_len(10), y = seq_len(10), color = rep(c("a", "b"), each = 5))
239		#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
240		#' ggplot2::geom_point() +
241		#' goshawk:::geom_arb_vline(
242		#' xintercept = c(2, 5), color = "blue", label = c("h1", "h2"), linetype = 2
243		#' )
244		geom_arb_vline <- function(xintercept,
245		label = "Vertical line",
246		color = "red",
247		legend_title = "Vertical line(s)",
248		...) {
249	!	checkmate::assert_numeric(xintercept, min.len = 1)
250	!	checkmate::assert(
251	!	check_color(color, len = 1),
252	!	check_color(color, len = length(xintercept))
253		)
254	!	checkmate::assert(
255	!	checkmate::check_character(label, len = 1),
256	!	checkmate::check_character(label, len = length(xintercept))
257		)
258
259	!	data <- data.frame(xintercept, color, label, color_var = paste(color, label))
260
261	!	list(
262	!	ggnewscale::new_scale_color(),
263	!	ggplot2::geom_vline(
264	!	data = data,
265	!	mapping = ggplot2::aes(
266	!	xintercept = xintercept,
267	!	color = .data[["color_var"]], # need legend entry for each color-label combination
268		),
269		...
270		),
271	!	ggplot2::scale_color_manual(
272	!	name = legend_title,
273	!	values = stats::setNames(data$color, data$color_var),
274	!	labels = data$label,
275	!	limits = data$color_var,
276	!	guide = ggplot2::guide_legend(order = 12) # high order to be put after main plot items
277		)
278		)
279		}
280
281
282		#' @rdname geom_straight_lines
283		#' @examples
284		#' # horizontal range
285		#'
286		#' data <- data.frame(
287		#' x = seq_len(10),
288		#' y = seq_len(10),
289		#' color = rep(c("a", "b"), each = 5),
290		#' lower = rep(c(2, 3), each = 5),
291		#' upper = rep(c(7, 8), each = 5)
292		#' )
293		#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
294		#' ggplot2::geom_point() +
295		#' goshawk:::geom_range_hline(
296		#' vars = c("lower", "upper"),
297		#' data = data.frame(lower = 2, upper = 7),
298		#' color = "blue",
299		#' linetype = 2
300		#' )
301		geom_range_hline <- function(vars,
302		data,
303		color = "green",
304		label = vars,
305		legend_title = "Horizontal range line(s)",
306		...) {
307	!	line_data <- validate_line_args(
308	!	data = data,
309	!	vars = vars,
310	!	label = label,
311	!	color = color
312		)
313	!	geom_arb_hline(
314	!	yintercept = line_data$values,
315	!	label = line_data$labels,
316	!	color = line_data$colors,
317	!	legend_title = legend_title,
318		...
319		)
320		}
321
322		#' @rdname geom_straight_lines
323		#' @examples
324		#' # vertical range
325		#' data <- data.frame(
326		#' x = seq_len(10),
327		#' y = seq_len(10),
328		#' color = rep(c("a", "b"), each = 5),
329		#' lower = rep(c(2, 3), each = 5),
330		#' upper = rep(c(7, 8), each = 5)
331		#' )
332		#' ggplot2::ggplot(data, ggplot2::aes(x = x, y = y, color = color)) +
333		#' ggplot2::geom_point() +
334		#' goshawk:::geom_range_vline(
335		#' vars = c("lower", "upper"),
336		#' data = data.frame(lower = 2, upper = 7),
337		#' color = "blue",
338		#' linetype = 2
339		#' )
340		geom_range_vline <- function(vars,
341		data,
342		color = "green",
343		label = vars,
344		legend_title = "Vertical range line(s)",
345		...) {
346	!	line_data <- validate_line_args(
347	!	data = data,
348	!	vars = vars,
349	!	label = label,
350	!	color = color
351		)
352	!	geom_arb_vline(
353	!	xintercept = line_data$values,
354	!	label = line_data$labels,
355	!	color = line_data$colors,
356	!	legend_title = legend_title,
357		...
358		)
359		}

1		#' Function to create a boxplot.
2		#'
3		#' A box plot is a method for graphically depicting groups of numerical data
4		#' through their quartiles. Box plots may also have lines extending vertically
5		#' from the boxes (whiskers) indicating variability outside the upper and lower
6		#' quartiles, hence the term box-and-whisker. Outliers may be plotted as
7		#' individual points. Box plots are non-parametric: they display variation in
8		#' samples of a statistical population without making any assumptions of the
9		#' underlying statistical distribution. The spacings between the different parts
10		#' of the box indicate the degree of dispersion (spread) and skewness in the
11		#' data, and show outliers. In addition to the points themselves, they allow one
12		#' to visually estimate various L-estimators, notably the interquartile range,
13		#' midhinge, range, mid-range, and trimean.
14		#'
15		#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
16		#' @param biomarker biomarker to visualize e.g. `IGG`.
17		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
18		#' @param yaxis_var name of variable containing biomarker results displayed on
19		#' Y-axis e.g. `AVAL`.
20		#' @param trt_group name of variable representing treatment `trt_group` e.g. `ARM`.
21		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
22		#' @param loq_legend `logical` whether to include `LoQ` legend.
23		#' @param unit biomarker unit label e.g. (U/L)
24		#' @param color_manual vector of color for `trt_group`
25		#' @param shape_manual vector of shapes (used with `loq_flag_var`)
26		#' @param box add boxes to the plot (boolean)
27		#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
28		#' if the default limits are not suitable.
29		#' @param facet_var variable to facet the plot by, or `"None"` if no faceting
30		#' required.
31		#' @param xaxis_var variable used to group the data on the x-axis.
32		#' @param facet_ncol number of facets per row. NULL = Use the default for `ggplot2::facet_wrap`
33		#' @param rotate_xlab 45 degree rotation of x-axis label values.
34		#' @param font_size point size of text to use. NULL is use default size
35		#' @param dot_size plot dot size.
36		#' @param alpha dot transparency (0 = transparent, 1 = opaque)
37		#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
38		#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
39		#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
40		#' @param hline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
41		#' The data inside of the `ggplot2` object must also contain the columns with these variable names
42		#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
43		#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
44		#'
45		#' @author Balazs Toth
46		#' @author Jeff Tomlinson (tomlinsj) jeffrey.tomlinson@roche.com
47		#'
48		#' @return \code{ggplot} object
49		#'
50		#' @export
51		#'
52		#' @examples
53		#' # Example using ADaM structure analysis dataset.
54		#'
55		#' library(nestcolor)
56		#'
57		#' ADLB <- rADLB
58		#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
59		#' ADLB <- ADLB %>%
60		#' mutate(AVISITCD = case_when(
61		#' AVISIT == "SCREENING" ~ "SCR",
62		#' AVISIT == "BASELINE" ~ "BL",
63		#' grepl("WEEK", AVISIT) ~
64		#' paste(
65		#' "W",
66		#' trimws(
67		#' substr(
68		#' AVISIT,
69		#' start = 6,
70		#' stop = stringr::str_locate(AVISIT, "DAY") - 1
71		#' )
72		#' )
73		#' ),
74		#' TRUE ~ NA_character_
75		#' )) %>%
76		#' mutate(AVISITCDN = case_when(
77		#' AVISITCD == "SCR" ~ -2,
78		#' AVISITCD == "BL" ~ 0,
79		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
80		#' TRUE ~ NA_real_
81		#' )) %>%
82		#' mutate(ANRLO = .5, ANRHI = 1) %>%
83		#' rowwise() %>%
84		#' group_by(PARAMCD) %>%
85		#' mutate(LBSTRESC = ifelse(
86		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
87		#' paste("<", round(runif(1, min = .5, max = 1))), LBSTRESC
88		#' )) %>%
89		#' mutate(LBSTRESC = ifelse(
90		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
91		#' paste(">", round(runif(1, min = 1, max = 1.5))), LBSTRESC
92		#' )) %>%
93		#' ungroup()
94		#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
95		#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
96		#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
97		#'
98		#' # add LLOQ and ULOQ variables
99		#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, "LOQFL")
100		#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
101		#'
102		#' g_boxplot(ADLB,
103		#' biomarker = "CRP",
104		#' param_var = "PARAMCD",
105		#' yaxis_var = "AVAL",
106		#' trt_group = "ARM",
107		#' loq_flag_var = "LOQFL",
108		#' loq_legend = FALSE,
109		#' unit = "AVALU",
110		#' shape_manual = c("N" = 1, "Y" = 2, "NA" = NULL),
111		#' facet_var = "AVISIT",
112		#' xaxis_var = "STUDYID",
113		#' alpha = 0.5,
114		#' rotate_xlab = TRUE,
115		#' hline_arb = c(.9, 1.2),
116		#' hline_arb_color = "blue",
117		#' hline_arb_label = "Hori_line_label",
118		#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
119		#' hline_vars_colors = c("pink", "brown", "purple", "gray"),
120		#' hline_vars_labels = c("A", "B", "C", "D")
121		#' )
122		g_boxplot <- function(data,
123		biomarker,
124		param_var = "PARAMCD",
125		yaxis_var,
126		trt_group,
127		xaxis_var = NULL,
128		loq_flag_var = "LOQFL",
129		loq_legend = TRUE,
130		unit = NULL,
131		color_manual = NULL,
132		shape_manual = NULL,
133		box = TRUE,
134		ylim = c(NA, NA),
135		dot_size = 2,
136		alpha = 1.0,
137		facet_ncol = NULL,
138		rotate_xlab = FALSE,
139		font_size = NULL,
140		facet_var = NULL,
141		hline_arb = numeric(0),
142		hline_arb_color = "red",
143		hline_arb_label = "Horizontal line",
144		hline_vars = character(0),
145		hline_vars_colors = "green",
146		hline_vars_labels = hline_vars) {
147	!	if (is.null(data[[param_var]])) {
148	!	stop(paste("param_var", param_var, "is not in data."))
149		}
150
151	!	if (!any(data[[param_var]] == biomarker)) {
152	!	stop(paste("biomarker", biomarker, "is not found in param_var", param_var, "."))
153		}
154	!	checkmate::assert_flag(loq_legend)
155	!	checkmate::assert_number(dot_size)
156	!	checkmate::assert_numeric(ylim, len = 2)
157
158		# filter input data
159	!	data <- data %>%
160	!	filter(!!sym(param_var) == biomarker)
161
162	!	if (!is.null(unit)) {
163		# check unit is in the dataset
164	!	if (is.null(data[[unit]])) {
165	!	stop(paste("unit variable", unit, "is not in data."))
166		}
167		# extract the most common unit
168		# if there are ties, take the use alphabetic order
169	!	tmp_unit <- data %>%
170	!	count(!!sym(unit)) %>%
171	!	top_n(1, n) %>%
172	!	arrange(!!sym(unit)) %>%
173	!	slice(1) %>%
174	!	select(!!sym(unit)) %>%
175	!	as.character()
176	!	if (is.factor(data[[unit]])) {
177	!	unit <- levels(data[[unit]])[as.numeric(tmp_unit)]
178		} else {
179	!	unit <- tmp_unit
180		}
181		}
182		# Setup the Y axis label. Combine the biomarker and the units (if available)
183	!	y_axis_label <- ifelse(is.null(unit), paste(data$PARAM[1], yaxis_var, "Values"),
184	!	ifelse(unit == "", paste(data$PARAM[1], yaxis_var, "Values"),
185	!	paste0(data$PARAM[1], " (", unit, ") ", yaxis_var, " Values")
186		)
187		)
188		# Setup the ggtitle label. Combine the biomarker and the units (if available)
189	!	ggtitle_label <- ifelse(is.null(unit), paste(data$PARAM[1], "Distribution by Treatment @ Visits"),
190	!	ifelse(unit == "", paste(data$PARAM[1], "Distribution by Treatment @ Visits"),
191	!	paste0(data$PARAM[1], " (", unit, ") Distribution by Treatment @ Visits")
192		)
193		)
194		# Setup legend label
195	!	trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
196
197		# add footnote to identify LLOQ and ULOQ values pulled from data
198	!	caption_loqs_label <- h_caption_loqs_label(loqs_data = data, flag_var = loq_flag_var)
199		# Base plot
200	!	plot1 <- ggplot2::ggplot(data)
201		# Add boxes if required
202	!	if (box) {
203	!	plot1 <- plot1 +
204	!	ggplot2::geom_boxplot(
205	!	data = data,
206	!	ggplot2::aes(
207	!	x = !!sym(xaxis_var),
208	!	y = !!sym(yaxis_var),
209	!	fill = NULL
210		),
211	!	outlier.shape = NA,
212	!	na.rm = TRUE
213		)
214		}
215		# Extend is.infinite to include zero length objects.
216	!	is_finite <- function(x) {
217	!	if (length(x) == 0) {
218	!	return(FALSE)
219		}
220	!	return(is.finite(x))
221		}
222
223	!	plot1 <- plot1 +
224	!	ggplot2::labs(color = trt_label, x = NULL, y = y_axis_label, caption = caption_loqs_label) +
225	!	ggplot2::theme_bw() +
226	!	ggplot2::ggtitle(ggtitle_label) +
227	!	ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5))
228		# Colors supplied? Use color_manual, otherwise default ggplot coloring.
229	!	plot1 <- if (!is.null(color_manual)) {
230	!	plot1 +
231	!	ggplot2::scale_color_manual(values = color_manual, guide = ggplot2::guide_legend(order = 1))
232		} else {
233	!	plot1 +
234	!	ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
235		}
236
237		# Format LOQ flag symbol shape
238	!	if (is.null(shape_manual)) {
239	!	shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]])
240	!	shape_manual <- seq_along(shape_names)
241	!	names(shape_manual) <- shape_names
242		}
243		# add LOQ legend conditionally
244	!	plot1 <- if (!loq_legend) {
245	!	plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none")
246		} else {
247	!	plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2))
248		}
249
250	!	plot1 <- plot1 +
251	!	ggplot2::geom_jitter(
252	!	data = data,
253	!	ggplot2::aes(
254	!	x = !!sym(xaxis_var),
255	!	y = !!sym(yaxis_var),
256	!	shape = !!sym(loq_flag_var),
257	!	color = !!sym(trt_group)
258		),
259	!	alpha = alpha,
260	!	position = ggplot2::position_jitter(width = 0.1, height = 0),
261	!	size = dot_size,
262	!	na.rm = TRUE
263		)
264
265		# Any limits for the Y axis?
266	!	plot1 <- plot1 + ggplot2::coord_cartesian(ylim = ylim)
267
268
269		# Add facetting.
270	!	if (!is.null(facet_var)) {
271	!	if (facet_var != "None" & facet_var %in% names(data)) { # nolint
272	!	if (!is_finite(facet_ncol)) facet_ncol <- 0
273	!	if (facet_ncol >= 1) {
274	!	plot1 <- plot1 +
275	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = round(facet_ncol))
276		} else {
277	!	plot1 <- plot1 +
278	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)))
279		}
280		}
281		}
282
283
284
285
286		# Format font size
287	!	if (is_finite(font_size)) {
288	!	plot1 <- plot1 +
289	!	ggplot2::theme(
290	!	axis.title.x = ggplot2::element_text(size = font_size),
291	!	axis.text.x = ggplot2::element_text(size = font_size),
292	!	axis.title.y = ggplot2::element_text(size = font_size),
293	!	axis.text.y = ggplot2::element_text(size = font_size),
294	!	legend.title = ggplot2::element_text(size = font_size),
295	!	legend.text = ggplot2::element_text(size = font_size),
296	!	strip.text.x = ggplot2::element_text(size = font_size),
297	!	strip.text.y = ggplot2::element_text(size = font_size)
298		)
299		}
300		# Format x-label
301	!	if (rotate_xlab) {
302	!	plot1 <- plot1 +
303	!	ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
304		}
305
306		# Add horizontal line for range based on option
307	!	plot1 + geom_axes_lines(data,
308	!	hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label,
309	!	hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels
310		)
311		}

1		#' Function to create a table of descriptive summary statistics to accompany plots.
2		#'
3		#' Output descriptive summary statistics table as a data frame. Includes biomarker, treatment,
4		#' visit,
5		#' n, mean, median, SD, min, max, %missing values, % `LOQ` values.
6		#'
7		#' @param data name of data frame to summarize.
8		#' @param trt_group treatment group variable name e.g. `ARM`.
9		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
10		#' @param param biomarker to visualize e.g. `IGG`.
11		#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`.
12		#' @param facet_var name of variable facetted on typically containing visit values e.g. `AVISITCD`.
13		#' If NULL then ignored. It defaults to `"AVISITCD"` when not provided.
14		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`. Defaults to `"LOQFL"`.
15		#' @param ... additional options
16		#'
17		#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
18		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
19		#'
20		#' @details provide additional information as needed. link to specification file
21		#' \url{https://posit.co/}
22		#'
23		#' @export
24		#'
25		#' @examples
26		#' # Example using ADaM structure analysis dataset.
27		#'
28		#' library(stringr)
29		#'
30		#' # original ARM value = dose value
31		#' arm_mapping <- list(
32		#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
33		#' )
34		#'
35		#' ADLB <- rADLB
36		#' ADLB <- ADLB %>%
37		#' mutate(AVISITCD = case_when(
38		#' AVISIT == "SCREENING" ~ "SCR",
39		#' AVISIT == "BASELINE" ~ "BL",
40		#' grepl("WEEK", AVISIT) ~
41		#' paste(
42		#' "W",
43		#' trimws(
44		#' substr(
45		#' AVISIT,
46		#' start = 6,
47		#' stop = str_locate(AVISIT, "DAY") - 1
48		#' )
49		#' )
50		#' ),
51		#' TRUE ~ NA_character_
52		#' )) %>%
53		#' mutate(AVISITCDN = case_when(
54		#' AVISITCD == "SCR" ~ -2,
55		#' AVISITCD == "BL" ~ 0,
56		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
57		#' TRUE ~ NA_real_
58		#' )) %>%
59		#' # use ARMCD values to order treatment in visualization legend
60		#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
61		#' ifelse(grepl("B", ARMCD), 2,
62		#' ifelse(grepl("A", ARMCD), 3, NA)
63		#' )
64		#' )) %>%
65		#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
66		#' mutate(ARM = factor(ARM) %>%
67		#' reorder(TRTORD))
68		#'
69		#' tbl <- t_summarytable(
70		#' data = ADLB,
71		#' trt_group = "ARM",
72		#' param_var = "PARAMCD",
73		#' param = c("CRP"),
74		#' xaxis_var = "AVAL",
75		#' facet_var = "AVISITCD",
76		#' loq_flag_var = "LOQFL"
77		#' )
78		#' tbl
79		t_summarytable <- function(data,
80		trt_group,
81		param_var,
82		param,
83		xaxis_var,
84		facet_var = "AVISITCD",
85		loq_flag_var = "LOQFL",
86		...) {
87	!	if (!is.null(facet_var) && trt_group == facet_var) {
88	!	data[paste0(facet_var, "_")] <- data[facet_var]
89	!	facet_var <- paste0(facet_var, "_")
90		}
91
92	!	table_data <- data %>%
93	!	filter(!!sym(param_var) == param)
94
95		# get unique study id or unique study ids if multiple study data
96	!	study_id <- as.data.frame(table(table_data$STUDYID)) %>%
97	!	mutate(STUDYID = paste(.data$Var1, collapse = "/")) %>%
98	!	rename(StudyID = "STUDYID") %>%
99	!	select("StudyID") %>%
100	!	slice(1)
101
102		# get analysis variable name
103	!	anl_var <- as.data.frame(xaxis_var) %>%
104	!	rename("AnlVar" = xaxis_var)
105
106	!	min_max_ignore_na <- function(x, type = c("min", "max")) {
107	!	type <- match.arg(type)
108	!	if (all(is.na(x))) {
109	!	return(NA)
110		}
111	!	return(
112	!	switch(type,
113	!	min = min,
114	!	max = max
115	!	)(x, na.rm = TRUE)
116		)
117		}
118
119		# by treatment group table
120
121	!	sum_data_by_arm <- table_data %>% filter(!!sym(param_var) == param)
122	!	if (!is.null(facet_var)) {
123	!	sum_data_by_arm <- sum_data_by_arm %>%
124	!	group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD, !!sym(facet_var))
125		} else {
126	!	sum_data_by_arm <- sum_data_by_arm %>%
127	!	group_by(!!sym(param_var), !!sym(trt_group), .data$TRTORD)
128		}
129
130	!	sum_data_by_arm <- sum_data_by_arm %>%
131	!	summarise(
132	!	n = sum(!is.na(!!sym(xaxis_var))),
133	!	Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
134	!	Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
135	!	StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
136	!	Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2),
137	!	Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2),
138	!	PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2),
139	!	PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2)
140		)
141
142	!	if (!is.null(facet_var)) {
143	!	sum_data_by_arm <- sum_data_by_arm %>%
144	!	select(
145	!	all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev",
146	!	"Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
147		) %>%
148	!	ungroup()
149		} else {
150	!	sum_data_by_arm <- sum_data_by_arm %>%
151	!	select(
152	!	all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev",
153	!	"Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
154		) %>%
155	!	ungroup()
156		}
157
158		# by combined treatment group table
159	!	sum_data_combined_arm <- table_data %>%
160	!	filter(!!sym(param_var) == param)
161
162	!	if (!is.null(facet_var)) {
163	!	sum_data_combined_arm <- sum_data_combined_arm %>%
164	!	group_by(!!sym(param_var), !!sym(facet_var))
165		} else {
166	!	sum_data_combined_arm <- sum_data_combined_arm %>%
167	!	group_by(!!sym(param_var))
168		}
169
170	!	sum_data_combined_arm <- sum_data_combined_arm %>%
171	!	summarise(
172	!	n = sum(!is.na(!!sym(xaxis_var))),
173	!	Mean = round(mean(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
174	!	Median = round(stats::median(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
175	!	StdDev = round(stats::sd(!!sym(xaxis_var), na.rm = TRUE), digits = 2),
176	!	Min = round(min_max_ignore_na(!!sym(xaxis_var), type = "min"), digits = 2),
177	!	Max = round(min_max_ignore_na(!!sym(xaxis_var), type = "max"), digits = 2),
178	!	PctMiss = round(100 * sum(is.na(!!sym(xaxis_var))) / length(!!sym(xaxis_var)), digits = 2),
179	!	PctLOQ = round(100 * sum(!!sym(loq_flag_var) == "Y", na.rm = TRUE) / length(!!sym(loq_flag_var)), digits = 2),
180	!	MAXTRTORDVIS = max(.data$TRTORD) # identifies the maximum treatment order within visits
181	!	) %>% # additional use of max function identifies maximum treatment order across all visits.
182	!	mutate(!!trt_group := "Comb.", TRTORD = max(.data$MAXTRTORDVIS) + 1)
183
184		# select only those columns needed to prop
185	!	if (!is.null(facet_var)) {
186	!	sum_data_combined_arm <- sum_data_combined_arm %>%
187	!	select(
188	!	all_of(c(param_var, trt_group, facet_var)), "n", "Mean", "Median", "StdDev",
189	!	"Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
190		) %>%
191	!	ungroup()
192
193		# combine the two data sets and apply some formatting. Note that R coerces treatment group into
194		# character since it is a factor and character
195	!	sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate
196		# reorder variables
197	!	select(
198	!	all_of(c(Biomarker = param_var, Treatment = trt_group, Facet = facet_var)),
199	!	"n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
200		) %>%
201	!	arrange(.data$Biomarker, .data$Facet, .data$TRTORD) %>% # drop variable
202	!	select(-"TRTORD")
203		} else {
204	!	sum_data_combined_arm <- sum_data_combined_arm %>%
205	!	select(
206	!	all_of(c(param_var, trt_group)), "n", "Mean", "Median", "StdDev",
207	!	"Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
208		) %>%
209	!	ungroup()
210
211		# combine the two data sets and apply some formatting. Note that R coerces treatment group into
212		# character since it is a factor and character
213	!	sum_data <- rbind(sum_data_by_arm, sum_data_combined_arm) %>% # concatenate
214		# reorder variables
215	!	select(
216	!	all_of(c(Biomarker = param_var, Treatment = trt_group)),
217	!	"n", "Mean", "Median", "StdDev", "Min", "Max", "PctMiss", "PctLOQ", "TRTORD"
218		) %>%
219	!	arrange(.data$Biomarker, .data$TRTORD) %>% # drop variable
220	!	select(-"TRTORD")
221		}
222
223		# add analysis variable as first column
224	!	sum_data <- cbind(study_id, anl_var, sum_data)
225		}

1		#' Function to create a correlation plot.
2		#'
3		#' Default plot displays correlation facetted by visit with color attributed treatment arms and
4		#' symbol attributed `LOQ` values.
5		#'
6		#' @param label text string to used to identify plot.
7		#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
8		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
9		#' @param xaxis_param x-axis biomarker to visualize e.g. `IGG`.
10		#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `BASE`.
11		#' @param xvar x-axis analysis variable from transposed data set.
12		#' @param yaxis_param y-axis biomarker to visualize e.g. `IGG`.
13		#' @param yaxis_var name of variable containing biomarker results displayed on Y-axis.g. `AVAL`.
14		#' @param yvar y-axis analysis variable from transposed data set.
15		#' @param trt_group name of variable representing treatment group e.g. `ARM`.
16		#' @param visit name of variable containing nominal visits e.g. `AVISITCD`.
17		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL_COMB`.
18		#' @param visit_facet visit facet toggle.
19		#' @param loq_legend `logical` whether to include `LoQ` legend.
20		#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
21		#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
22		#' if the default limits are not suitable.
23		#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
24		#' if the default limits are not suitable.
25		#' @param title_text plot title.
26		#' @param xaxis_lab x-axis label.
27		#' @param yaxis_lab y-axis label.
28		#' @param color_manual vector of colors applied to treatment values.
29		#' @param shape_manual vector of symbols applied to `LOQ` values. (used with `loq_flag_var`).
30		#' @param facet_ncol number of facets per row.
31		#' @param facet set layout to use treatment facetting.
32		#' @param facet_var variable to use for treatment facetting.
33		#' @param reg_line include regression line and annotations for slope and coefficient.
34		#' Use with facet = TRUE.
35		#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
36		#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
37		#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
38		#' @param hline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
39		#' The data inside of the `ggplot2` object must also contain the columns with these variable names
40		#' @param hline_vars_colors ('character vector') colors for the horizontal lines defined by variables.
41		#' @param hline_vars_labels ('character vector') labels for the legend to the horizontal lines defined by variables.
42		#' @param vline_arb ('numeric vector') value identifying intercept for arbitrary vertical lines.
43		#' @param vline_arb_color ('character vector') optional, color for the arbitrary vertical lines.
44		#' @param vline_arb_label ('character vector') optional, label for the legend to the arbitrary vertical lines.
45		#' @param vline_vars ('character vector'), names of variables `(ANR)` or values `(LOQ)` identifying intercept values.
46		#' The data inside of the `ggplot2` object must also contain the columns with these variable names
47		#' @param vline_vars_colors ('character vector') colors for the vertical lines defined by variables.
48		#' @param vline_vars_labels ('character vector') labels for the legend to the vertical lines defined by variables.
49		#' @param rotate_xlab 45 degree rotation of x-axis label values.
50		#' @param font_size font size control for title, x-axis label, y-axis label and legend.
51		#' @param dot_size plot dot size.
52		#' @param reg_text_size font size control for regression line annotations.
53		#'
54		#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
55		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
56		#'
57		#' @details Regression uses `deming` model.
58		#'
59		#' @export
60		#'
61		#' @examples
62		#' # Example using ADaM structure analysis dataset.
63		#'
64		#' library(stringr)
65		#' library(tidyr)
66		#'
67		#' # original ARM value = dose value
68		#' arm_mapping <- list(
69		#' "A: Drug X" = "150mg QD",
70		#' "B: Placebo" = "Placebo",
71		#' "C: Combination" = "Combination"
72		#' )
73		#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
74		#' # assign LOQ flag symbols: circles for "N" and triangles for "Y", squares for "NA"
75		#' shape_manual <- c("N" = 1, "Y" = 2, "NA" = 0)
76		#'
77		#' ADLB <- rADLB
78		#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
79		#' ADLB <- ADLB %>%
80		#' mutate(AVISITCD = case_when(
81		#' AVISIT == "SCREENING" ~ "SCR",
82		#' AVISIT == "BASELINE" ~ "BL",
83		#' grepl("WEEK", AVISIT) ~
84		#' paste(
85		#' "W",
86		#' trimws(
87		#' substr(
88		#' AVISIT,
89		#' start = 6,
90		#' stop = str_locate(AVISIT, "DAY") - 1
91		#' )
92		#' )
93		#' ),
94		#' TRUE ~ NA_character_
95		#' )) %>%
96		#' mutate(AVISITCDN = case_when(
97		#' AVISITCD == "SCR" ~ -2,
98		#' AVISITCD == "BL" ~ 0,
99		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
100		#' TRUE ~ NA_real_
101		#' )) %>%
102		#' # use ARMCD values to order treatment in visualization legend
103		#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
104		#' ifelse(grepl("B", ARMCD), 2,
105		#' ifelse(grepl("A", ARMCD), 3, NA)
106		#' )
107		#' )) %>%
108		#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
109		#' mutate(ARM = factor(ARM) %>%
110		#' reorder(TRTORD)) %>%
111		#' mutate(
112		#' ANRHI = case_when(
113		#' PARAMCD == "ALT" ~ 60,
114		#' PARAMCD == "CRP" ~ 70,
115		#' PARAMCD == "IGA" ~ 80,
116		#' TRUE ~ NA_real_
117		#' ),
118		#' ANRLO = case_when(
119		#' PARAMCD == "ALT" ~ 20,
120		#' PARAMCD == "CRP" ~ 30,
121		#' PARAMCD == "IGA" ~ 40,
122		#' TRUE ~ NA_real_
123		#' )
124		#' ) %>%
125		#' rowwise() %>%
126		#' group_by(PARAMCD) %>%
127		#' mutate(LBSTRESC = ifelse(
128		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
129		#' paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
130		#' )) %>%
131		#' mutate(LBSTRESC = ifelse(
132		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
133		#' paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
134		#' )) %>%
135		#' ungroup()
136		#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
137		#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
138		#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
139		#'
140		#' # add LLOQ and ULOQ variables
141		#' ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, flag_var = "LOQFL")
142		#' ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
143		#'
144		#' # given the 2 param and 2 analysis vars we need to transform the data
145		#' plot_data_t1 <- ADLB %>%
146		#' gather(
147		#' ANLVARS, ANLVALS, PARAM, LBSTRESC, BASE2, BASE, AVAL, BASE, LOQFL,
148		#' ANRHI, ANRLO, ULOQN, LLOQN
149		#' ) %>%
150		#' mutate(ANL.PARAM = ifelse(ANLVARS %in% c("PARAM", "LBSTRESC", "LOQFL"),
151		#' paste0(ANLVARS, "_", PARAMCD),
152		#' paste0(ANLVARS, ".", PARAMCD)
153		#' )) %>%
154		#' select(USUBJID, ARM, ARMCD, AVISITN, AVISITCD, ANL.PARAM, ANLVALS) %>%
155		#' spread(ANL.PARAM, ANLVALS)
156		#'
157		#' # the transformed analysis value variables are character and need to be converted to numeric for
158		#' # ggplot
159		#' # remove records where either of the analysis variables are NA since they will not appear on the
160		#' # plot and will ensure that LOQFL = NA level is removed
161		#' plot_data_t2 <- plot_data_t1 %>%
162		#' filter(!is.na(BASE.CRP) & !is.na(AVAL.ALT)) %>%
163		#' mutate_at(vars(contains(".")), as.numeric) %>%
164		#' mutate(
165		#' LOQFL_COMB = ifelse(LOQFL_CRP == "Y" \| LOQFL_ALT == "Y", "Y", "N")
166		#' )
167		#'
168		#' g_correlationplot(
169		#' label = "Correlation Plot",
170		#' data = plot_data_t2,
171		#' param_var = "PARAMCD",
172		#' xaxis_param = c("CRP"),
173		#' xaxis_var = "AVAL",
174		#' xvar = "AVAL.CRP",
175		#' yaxis_param = c("ALT"),
176		#' yaxis_var = "BASE",
177		#' yvar = "BASE.ALT",
178		#' trt_group = "ARM",
179		#' visit = "AVISITCD",
180		#' visit_facet = TRUE,
181		#' loq_legend = TRUE,
182		#' unit = "AVALU",
183		#' title_text = "Correlation of ALT to CRP",
184		#' xaxis_lab = "CRP",
185		#' yaxis_lab = "ALT",
186		#' color_manual = color_manual,
187		#' shape_manual = shape_manual,
188		#' facet_ncol = 4,
189		#' facet = FALSE,
190		#' facet_var = "ARM",
191		#' reg_line = FALSE,
192		#' hline_arb = c(15, 25),
193		#' hline_arb_color = c("gray", "green"),
194		#' hline_arb_label = "Hori_line_label",
195		#' vline_arb = c(.5, 1),
196		#' vline_arb_color = c("red", "black"),
197		#' vline_arb_label = c("Vertical Line A", "Vertical Line B"),
198		#' hline_vars = c("ANRHI.ALT", "ANRLO.ALT", "ULOQN.ALT", "LLOQN.ALT"),
199		#' hline_vars_colors = c("green", "blue", "purple", "cyan"),
200		#' hline_vars_labels = c("ANRHI ALT Label", "ANRLO ALT Label", "ULOQN ALT Label", "LLOQN ALT Label"),
201		#' vline_vars = c("ANRHI.CRP", "ANRLO.CRP", "ULOQN.CRP", "LLOQN.CRP"),
202		#' vline_vars_colors = c("yellow", "orange", "brown", "gold"),
203		#' vline_vars_labels = c("ANRHI CRP Label", "ANRLO CRP Label", "ULOQN CRP Label", "LLOQN CRP Label"),
204		#' rotate_xlab = FALSE,
205		#' font_size = 14,
206		#' dot_size = 2,
207		#' reg_text_size = 3
208		#' )
209		g_correlationplot <- function(label = "Correlation Plot",
210		data,
211		param_var = "PARAMCD",
212		xaxis_param = "CRP",
213		xaxis_var = "BASE",
214		xvar,
215		yaxis_param = "IGG",
216		yaxis_var = "AVAL",
217		yvar,
218		trt_group = "ARM",
219		visit = "AVISITCD",
220		loq_flag_var = "LOQFL_COMB",
221		visit_facet = TRUE,
222		loq_legend = TRUE,
223		unit = "AVALU",
224		xlim = c(NA, NA),
225		ylim = c(NA, NA),
226		title_text = title_text,
227		xaxis_lab = xaxis_lab,
228		yaxis_lab = yaxis_lab,
229		color_manual = NULL,
230		shape_manual = NULL,
231		facet_ncol = 2,
232		facet = FALSE,
233		facet_var = "ARM",
234		reg_line = FALSE,
235		hline_arb = numeric(0),
236		hline_arb_color = "red",
237		hline_arb_label = "Horizontal line",
238		hline_vars = character(0),
239		hline_vars_colors = "green",
240		hline_vars_labels = hline_vars,
241		vline_arb = numeric(0),
242		vline_arb_color = "red",
243		vline_arb_label = "Vertical line",
244		vline_vars = character(0),
245		vline_vars_colors = "green",
246		vline_vars_labels = vline_vars,
247		rotate_xlab = FALSE,
248		font_size = 12,
249		dot_size = 2,
250		reg_text_size = 3) {
251	!	checkmate::assert_flag(loq_legend)
252	!	checkmate::assert_number(dot_size, lower = 1)
253	!	checkmate::assert_numeric(xlim, len = 2)
254	!	checkmate::assert_numeric(ylim, len = 2)
255
256		# create correlation plot over time pairwise per treatment arm
257	!	plot_data <- data
258
259		# identify param and lbstresc combinations in transposed data variable name
260	!	t_param_var_x <- paste("PARAM", xaxis_param, sep = "_")
261	!	t_lbstresc_var_x <- paste("LBSTRESC", xaxis_param, sep = "_")
262	!	t_param_var_y <- paste("PARAM", yaxis_param, sep = "_")
263	!	t_lbstresc_var_y <- paste("LBSTRESC", yaxis_param, sep = "_")
264
265	!	xaxis_param_loqs_data <- data %>%
266	!	mutate(
267	!	PARAM = !!sym(t_param_var_x), LBSTRESC = !!sym(t_lbstresc_var_x),
268	!	sym(loq_flag_var) == !!sym(loq_flag_var)
269		) %>%
270	!	select("PARAM", "LBSTRESC", loq_flag_var)
271
272	!	yaxis_param_loqs_data <- data %>%
273	!	mutate(
274	!	PARAM = !!sym(t_param_var_y), LBSTRESC = !!sym(t_lbstresc_var_y),
275	!	sym(loq_flag_var) == !!sym(loq_flag_var)
276		) %>%
277	!	select("PARAM", "LBSTRESC", loq_flag_var)
278
279		# add footnote to identify xaxis assay LLOQ and ULOQ values pulled from data
280	!	caption_loqs_label_x <- h_caption_loqs_label(loqs_data = xaxis_param_loqs_data, flag_var = loq_flag_var)
281	!	caption_loqs_label_y <- h_caption_loqs_label(loqs_data = yaxis_param_loqs_data, flag_var = loq_flag_var)
282	!	caption_loqs_label_x_y <- paste0(union(caption_loqs_label_x, caption_loqs_label_y), collapse = "\n")
283
284		# Setup legend label
285	!	trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
286
287		# create plot foundation - titles and axes labels are defined in
288		# teal.goshawk.tm_g_correlationplot.R
289	!	plot1 <- ggplot2::ggplot(
290	!	data = plot_data,
291	!	ggplot2::aes(
292	!	x = !!sym(xvar),
293	!	y = !!sym(yvar),
294	!	color = !!sym(trt_group)
295		)
296		) +
297	!	ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
298	!	ggplot2::theme_bw() +
299	!	ggplot2::labs(caption = caption_loqs_label_x_y) +
300	!	ggplot2::ggtitle(title_text) +
301	!	ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
302	!	ggplot2::xlab(xaxis_lab) +
303	!	ggplot2::ylab(yaxis_lab)
304
305		# conditionally facet
306	!	plot1 <- if (visit_facet && facet) {
307	!	plot1 +
308	!	ggplot2::facet_grid(stats::as.formula(paste0(facet_var, " ~ ", visit)))
309	!	} else if (visit_facet) {
310	!	plot1 +
311	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", visit)), ncol = facet_ncol)
312	!	} else if (facet) {
313	!	plot1 +
314	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol)
315		} else {
316	!	plot1
317		}
318
319	!	plot1 <- plot1 +
320	!	ggplot2::geom_point(ggplot2::aes(shape = !!sym(loq_flag_var)), size = dot_size, na.rm = TRUE)
321
322		# add regression line
323	!	if (reg_line) {
324	!	slope <- function(x, y) {
325	!	if (stats::sd(y) != 0) {
326	!	ratio <- stats::sd(x) / stats::sd(y)
327	!	if (!is.na(ratio) && ratio > 0) {
328	!	reg <- mc.deming(y, x, ratio)
329		# return the evaluation of the ratio condition as third value in numeric vector to control
330		# downstream processing
331	!	return(c(round(reg$b0, 2), round(reg$b1, 2), !is.na(ratio) & ratio > 0))
332		}
333		}
334		# if ratio condition is not met then assign NA to vector so that NULL condition does not throw
335		# the error below
336	!	return(as.numeric(c(NA, NA, NA)))
337		}
338
339	!	sub_data <- filter(plot_data, !is.na(!!sym(yvar)) & !is.na(!!sym(xvar))) %>%
340	!	group_by(!!sym(trt_group), !!sym(visit)) %>%
341	!	mutate(intercept = slope(!!sym(yvar), !!sym(xvar))[1]) %>%
342	!	mutate(slope = slope(!!sym(yvar), !!sym(xvar))[2]) %>%
343	!	mutate(corr = ifelse(
344	!	slope(!!sym(yvar), !!sym(xvar))[3],
345	!	stats::cor(!!sym(yvar), !!sym(xvar), method = "spearman", use = "complete.obs"),
346	!	NA
347		))
348	!	plot1 <- plot1 +
349	!	ggplot2::geom_abline(
350	!	data = filter(sub_data, row_number() == 1), # only need to return 1 row within group_by
351	!	ggplot2::aes(intercept = .data$intercept, slope = .data$slope, color = !!sym(trt_group))
352		) +
353	!	ggplot2::geom_text(
354	!	data = filter(sub_data, row_number() == 1),
355	!	ggplot2::aes_(
356	!	x = -Inf,
357	!	y = Inf,
358	!	hjust = 0,
359	!	vjust = 1,
360	!	label = ~ ifelse(
361	!	!is.na(intercept) & !is.na(slope) & !is.na(corr),
362	!	sprintf("y = %.2f+%.2fX\ncor = %.2f", intercept, slope, corr),
363	!	paste0("Insufficient Data For Regression")
364		),
365	!	color = sym(trt_group)
366		),
367	!	size = reg_text_size,
368	!	show.legend = FALSE
369		) +
370	!	ggplot2::labs(caption = paste0(
371	!	"Deming Regression Model, Spearman Correlation Method.\n",
372	!	caption_loqs_label_x_y
373		))
374		}
375		# Format font size
376	!	if (!is.null(font_size)) {
377	!	plot1 <- plot1 + ggplot2::theme(
378	!	axis.title.x = ggplot2::element_text(size = font_size),
379	!	axis.text.x = ggplot2::element_text(size = font_size),
380	!	axis.title.y = ggplot2::element_text(size = font_size),
381	!	axis.text.y = ggplot2::element_text(size = font_size),
382	!	legend.title = ggplot2::element_text(size = font_size),
383	!	legend.text = ggplot2::element_text(size = font_size),
384	!	strip.text.x = ggplot2::element_text(size = font_size),
385	!	strip.text.y = ggplot2::element_text(size = font_size)
386		)
387		}
388		# Format treatment color
389	!	plot1 <- if (!is.null(color_manual)) {
390	!	plot1 +
391	!	ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
392		} else {
393	!	plot1 +
394	!	ggplot2::scale_color_discrete(guide = ggplot2::guide_legend(order = 1))
395		}
396
397		# Format LOQ flag symbol shape
398	!	if (is.null(shape_manual)) {
399	!	shape_names <- unique(data[!is.na(data[[loq_flag_var]]), ][[loq_flag_var]])
400	!	shape_manual <- seq_along(shape_names)
401	!	names(shape_manual) <- shape_names
402		}
403		# add LOQ legend conditionally
404	!	plot1 <- if (!loq_legend) {
405	!	plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = "none")
406		} else {
407	!	plot1 + ggplot2::scale_shape_manual(values = shape_manual, name = "LoQ", guide = ggplot2::guide_legend(order = 2))
408		}
409		# Format x-label
410	!	if (rotate_xlab) {
411	!	plot1 <- plot1 +
412	!	ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
413		}
414
415	!	plot1 + geom_axes_lines(
416	!	plot_data,
417	!	hline_arb = hline_arb, hline_arb_color = hline_arb_color, hline_arb_label = hline_arb_label,
418	!	hline_vars = hline_vars, hline_vars_colors = hline_vars_colors, hline_vars_labels = hline_vars_labels,
419	!	vline_arb = vline_arb, vline_arb_color = vline_arb_color, vline_arb_label = vline_arb_label,
420	!	vline_vars = vline_vars, vline_vars_colors = vline_vars_colors, vline_vars_labels = vline_vars_labels
421		)
422		}

1		#' Function to create a density distribution plot.
2		#'
3		#' Default plot displays overall density facetted by visit with treatment arms and combined
4		#' treatment overlaid.
5		#'
6		#' @param label text string used to identify plot.
7		#' @param data `ADaM` structured analysis laboratory data frame e.g. `ADLB`.
8		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
9		#' @param param biomarker to visualize e.g. `IGG`.
10		#' @param xaxis_var name of variable containing biomarker results displayed on X-axis e.g. `AVAL`.
11		#' @param trt_group name of variable representing treatment group e.g. `ARM`.
12		#' @param loq_flag_var name of variable containing `LOQ` flag e.g. `LOQFL`.
13		#' @param unit name of variable containing biomarker unit e.g. `AVALU`.
14		#' @param xlim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the x-axis
15		#' if the default limits are not suitable.
16		#' @param ylim ('numeric vector') optional, a vector of length 2 to specify the minimum and maximum of the y-axis
17		#' if the default limits are not suitable.
18		#' @param color_manual vector of colors applied to treatment values.
19		#' @param color_comb name or hex value for combined treatment color.
20		#' @param comb_line display combined treatment line toggle.
21		#' @param facet_var variable to use for facetting.
22		#' @param hline_arb ('numeric vector') value identifying intercept for arbitrary horizontal lines.
23		#' @param hline_arb_color ('character vector') optional, color for the arbitrary horizontal lines.
24		#' @param hline_arb_label ('character vector') optional, label for the legend to the arbitrary horizontal lines.
25		#' @param facet_ncol number of facets per row.
26		#' @param rotate_xlab 45 degree rotation of x-axis label values.
27		#' @param font_size font size control for title, x-axis label, y-axis label and legend.
28		#' @param line_size plot line thickness.
29		#' @param rug_plot should a rug plot be displayed under the density plot. Note this
30		#' option is most useful if the data only contains a single treatment group.
31		#'
32		#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
33		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
34		#'
35		#' @export
36		#'
37		#' @examples
38		#' # Example using ADaM structure analysis dataset.
39		#'
40		#' library(stringr)
41		#'
42		#' # original ARM value = dose value
43		#' arm_mapping <- list(
44		#' "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
45		#' )
46		#' color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")
47		#'
48		#' ADLB <- rADLB
49		#' var_labels <- lapply(ADLB, function(x) attributes(x)$label)
50		#' ADLB <- ADLB %>%
51		#' mutate(AVISITCD = case_when(
52		#' AVISIT == "SCREENING" ~ "SCR",
53		#' AVISIT == "BASELINE" ~ "BL",
54		#' grepl("WEEK", AVISIT) ~
55		#' paste(
56		#' "W",
57		#' trimws(
58		#' substr(
59		#' AVISIT,
60		#' start = 6,
61		#' stop = str_locate(AVISIT, "DAY") - 1
62		#' )
63		#' )
64		#' ),
65		#' TRUE ~ NA_character_
66		#' )) %>%
67		#' mutate(AVISITCDN = case_when(
68		#' AVISITCD == "SCR" ~ -2,
69		#' AVISITCD == "BL" ~ 0,
70		#' grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
71		#' TRUE ~ NA_real_
72		#' )) %>%
73		#' # use ARMCD values to order treatment in visualization legend
74		#' mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
75		#' ifelse(grepl("B", ARMCD), 2,
76		#' ifelse(grepl("A", ARMCD), 3, NA)
77		#' )
78		#' )) %>%
79		#' mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
80		#' mutate(ARM = factor(ARM) %>%
81		#' reorder(TRTORD))
82		#' attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
83		#'
84		#' g_density_distribution_plot(
85		#' label = "Density Distribution Plot",
86		#' data = ADLB,
87		#' param_var = "PARAMCD",
88		#' param = c("CRP"),
89		#' xaxis_var = "AVAL",
90		#' unit = "AVALU",
91		#' color_manual = color_manual,
92		#' color_comb = "#39ff14",
93		#' comb_line = FALSE,
94		#' facet_var = "AVISITCD",
95		#' hline_arb = 1.75,
96		#' hline_arb_color = "black",
97		#' hline_arb_label = "Horizontal Line A",
98		#' facet_ncol = 2,
99		#' rotate_xlab = FALSE,
100		#' font_size = 10,
101		#' line_size = .5
102		#' )
103		g_density_distribution_plot <- function(label = "Density Distribution Plot",
104		data,
105		param_var = "PARAMCD",
106		param = "CRP",
107		xaxis_var = "AVAL",
108		trt_group = "ARM",
109		unit = "AVALU",
110		loq_flag_var = "LOQFL",
111		xlim = c(NA, NA),
112		ylim = c(NA, NA),
113		color_manual = NULL,
114		color_comb = "#39ff14",
115		comb_line = TRUE,
116		facet_var = "AVISITCD",
117		hline_arb = character(0),
118		hline_arb_color = "red",
119		hline_arb_label = "Horizontal line",
120		facet_ncol = 2,
121		rotate_xlab = FALSE,
122		font_size = 12,
123		line_size = 2,
124		rug_plot = FALSE) {
125	!	checkmate::assert_numeric(xlim, len = 2)
126	!	checkmate::assert_numeric(ylim, len = 2)
127
128	!	plot_data <- data %>%
129	!	filter(!!sym(param_var) == param)
130
131		# Setup the ggtitle label. Combine the biomarker and the units (if available)
132	!	ggtitle_label <- ifelse(
133	!	is.null(unit),
134	!	paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"),
135	!	ifelse(
136	!	plot_data[[unit]] == "",
137	!	paste(plot_data$PARAM, "Density: Combined Treatment (Comb.) & by Treatment @ Visits"),
138	!	paste0(plot_data$PARAM, " (", plot_data[[unit]], ") Density: Combined Treatment (Comb.) & by Treatment @ Visits")
139		)
140		)
141
142		# Setup the x-axis label. Combine the biomarker and the units (if available)
143	!	x_axis_label <- ifelse(
144	!	is.null(unit),
145	!	paste(plot_data$PARAM, xaxis_var, "Values"),
146	!	ifelse(
147	!	plot_data[[unit]] == "",
148	!	paste(plot_data$PARAM, xaxis_var, "Values"),
149	!	paste0(plot_data$PARAM, " (", plot_data[[unit]], ") ", xaxis_var, " Values")
150		)
151		)
152
153		# Setup legend label
154	!	trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
155
156	!	if (comb_line) {
157	!	plot_data <- dplyr::bind_rows(
158	!	plot_data,
159	!	plot_data %>%
160	!	dplyr::mutate(!!sym(trt_group) := "Combined Dose")
161		)
162		}
163
164	!	color_manual <- if (is.null(color_manual)) {
165	!	group_names <- unique(plot_data[[trt_group]])
166	!	color_values <- seq_along(group_names)
167	!	if (!is.null(getOption("ggplot2.discrete.colour"))) {
168	!	color_values <- getOption("ggplot2.discrete.colour")[color_values]
169		}
170	!	names(color_values) <- group_names
171	!	color_values
172		} else {
173	!	color_manual
174		}
175
176	!	if (comb_line) {
177	!	if (!is.null(color_comb)) {
178	!	color_manual["Combined Dose"] <- color_comb
179	!	} else if (!"Combined Dose" %in% names(color_manual)) {
180	!	color_manual["Combined Dose"] <- length(color_manual) + 1
181		}
182		}
183
184		# Add footnote to identify LLOQ and ULOQ values pulled from data
185	!	caption_loqs_label <- h_caption_loqs_label(loqs_data = plot_data, flag_var = loq_flag_var)
186
187	!	plot1 <- ggplot2::ggplot(plot_data) +
188	!	ggplot2::stat_density(
189	!	ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group)),
190	!	linewidth = line_size,
191	!	geom = "line",
192	!	position = "identity"
193		) +
194	!	ggplot2::coord_cartesian(xlim = xlim, ylim = ylim) +
195	!	ggplot2::facet_wrap(stats::as.formula(paste0(" ~ ", facet_var)), ncol = facet_ncol) +
196	!	ggplot2::labs(caption = caption_loqs_label) +
197	!	ggplot2::theme_bw() +
198	!	ggplot2::ggtitle(ggtitle_label) +
199	!	ggplot2::theme(plot.title = ggplot2::element_text(size = font_size, hjust = 0.5)) +
200	!	ggplot2::xlab(paste(x_axis_label)) +
201	!	ggplot2::ylab(paste("Density")) +
202	!	ggplot2::scale_color_manual(values = color_manual, name = trt_label, guide = ggplot2::guide_legend(order = 1))
203
204	!	if (rug_plot) {
205	!	plot1 <- plot1 +
206	!	ggplot2::geom_rug(ggplot2::aes(x = !!sym(xaxis_var), colour = !!sym(trt_group)))
207		}
208
209		# Format font size
210	!	if (!is.null(font_size)) {
211	!	plot1 <- plot1 +
212	!	ggplot2::theme(
213	!	axis.title.x = ggplot2::element_text(size = font_size),
214	!	axis.text.x = ggplot2::element_text(size = font_size),
215	!	axis.title.y = ggplot2::element_text(size = font_size),
216	!	axis.text.y = ggplot2::element_text(size = font_size),
217	!	legend.title = ggplot2::element_text(size = font_size),
218	!	legend.text = ggplot2::element_text(size = font_size),
219	!	strip.text.x = ggplot2::element_text(size = font_size),
220	!	strip.text.y = ggplot2::element_text(size = font_size)
221		)
222		}
223
224		# Format x-label
225	!	if (rotate_xlab) {
226	!	plot1 <- plot1 +
227	!	ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1))
228		}
229
230		# Add horizontal line
231	!	plot1 + geom_axes_lines(
232	!	plot_data,
233	!	hline_arb = hline_arb,
234	!	hline_arb_color = hline_arb_color,
235	!	hline_arb_label = hline_arb_label
236		)
237		}