teal.goshawk coverage - 26.46%

Files
Source

templ_ui_constraint <- function(ns, label = "Data Constraint") {
  tags$div(
    id = ns("constraint_var_whole"), # give an id to hide it
    radioButtons(ns("constraint_var"), label, choices = "NONE"),
    shinyjs::hidden(tags$div(
      id = ns("constraint_range"),
      tags$div(
        class = "inline-block;",
        numericInput(ns("constraint_range_min"), label = "Min", value = 0, min = 0, max = 0)
      ),
      tags$div(
        class = "inline-block;",
        numericInput(ns("constraint_range_max"), label = "Min", value = 0, min = 0, max = 0)
      )
    )),
    shinyjs::hidden(tags$div(
      id = ns("all_na"),
      helpText("All values are missing (NA)")
    ))
  )
}

keep_data_const_opts_updated <- function(session, input, data, id_param_var) {
  # use reactiveVal so that it only updates when options actually changed and not just data
  choices <- reactiveVal()
  observeEvent(data(), {
    paramname <- input[[id_param_var]]
    req(length(paramname) == 1)

    data_filtered <- data()$ANL %>% dplyr::filter(.data$PARAMCD == paramname)
    choices(c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE")[
      c(TRUE, !all(is.na(data_filtered[["BASE2"]])), !all(is.na(data_filtered[["BASE"]])))
    ])
  })
  observeEvent(choices(), {
    updateRadioButtons(session, "constraint_var", choices = choices())
    # hide when only one option "NONE"
    if (length(choices()) == 1) {
      shinyjs::hide("constraint_var_whole")
    } else {
      shinyjs::show("constraint_var_whole")
    }
  })
}




# param_id: input id that contains values of PARAMCD to filter for
# param_var: currently only "PARAMCD" is supported
constr_anl_q <- function(session, input, data, dataname, param_id, param_var, trt_group, min_rows) {
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")
  dataset_var <- dataname
  if (!identical(param_var, "PARAMCD")) {
    # why is there a variable param_id which is provided to this function and always equal to "param"?
    stop("param_var must be 'PARAMCD'. Otherwise, we cannot currently guarantee the correctness of the code.")
  }

  anl_param <- reactive({
    param_var_value <- input[[param_id]] # value to filter PARAMCD for
    validate(need(param_var_value, "Please select a biomarker"))
    checkmate::assert_string(param_var_value)

    ANL <- data()[[dataname]] # nolint
    validate_has_data(ANL, min_rows)

    validate_has_variable(ANL, param_var)
    validate_has_variable(ANL, "AVISITCD")
    validate_has_variable(ANL, "BASE")
    validate_has_variable(ANL, "BASE2")
    validate_has_variable(ANL, trt_group)

    # analysis
    private_qenv <- data() %>%
      teal.code::eval_code(
        substitute(ANL <- dataname, list(dataname = as.name(dataname))) # nolint
      ) %>%
      teal.code::eval_code(
        code = bquote({
          ANL <- .(as.name(dataset_var)) %>% # nolint
            dplyr::filter(.(as.name(param_var)) == .(param_var_value))
        })
      )
    validate_has_data(private_qenv[["ANL"]], min_rows)
    list(ANL = ANL, qenv = private_qenv)
  })

  observe({
    param_var_value <- input[[param_id]]
    validate(need(param_var_value, "Please select a biomarker"))

    constraint_var <- input[["constraint_var"]]
    validate(need(constraint_var, "select a constraint variable"))

    ANL <- data()[[dataname]] # nolint
    validate_has_data(ANL, min_rows)

    validate_has_variable(ANL, param_var)
    validate_has_variable(ANL, "AVISITCD")
    validate_has_variable(ANL, "BASE")
    validate_has_variable(ANL, "BASE2")

    ANL <- ANL %>% dplyr::filter(!!sym(param_var) == param_var_value) # nolint

    visit_freq <- unique(ANL$AVISITCD)

    # get min max values
    if ((constraint_var == "BASE2" && any(grepl("SCR", visit_freq))) ||
      (constraint_var == "BASE" && any(grepl("BL", visit_freq)))) { # nolint
      val <- stats::na.omit(switch(constraint_var,
        "BASE" = ANL$BASE[ANL$AVISITCD == "BL"],
        "BASE2" = ANL$BASE2[ANL$AVISITCD == "SCR"],
        stop(paste(constraint_var, "not allowed"))
      ))

      if (length(val) == 0 || all(is.na(val))) {
        shinyjs::show("all_na")
        shinyjs::hide("constraint_range")
        args <- list(
          min = list(label = "Min", min = 0, max = 0, value = 0),
          max = list(label = "Max", min = 0, max = 0, value = 0)
        )
        update_min_max(session, args)
      } else {
        rng <- range(val, na.rm = TRUE)

        minmax <- c(floor(rng[1] * 1000) / 1000, ceiling(rng[2] * 1000) / 1000)

        label_min <- sprintf("Min (%s)", minmax[1])
        label_max <- sprintf("Max (%s)", minmax[2])

        args <- list(
          min = list(label = label_min, min = minmax[1], max = minmax[2], value = minmax[1]),
          max = list(label = label_max, min = minmax[1], max = minmax[2], value = minmax[2])
        )

        update_min_max(session, args)
        shinyjs::show("constraint_range") # update before show
        shinyjs::hide("all_na")
      }
    } else if (constraint_var == "NONE") {
      shinyjs::hide("constraint_range") # hide before update
      shinyjs::hide("all_na")

      # force update (and thus refresh) on different constraint_var -> pass unique value for each constraint_var name
      args <- list(
        min = list(label = "Min", min = 0, max = 0, value = 0),
        max = list(label = "Max", min = 0, max = 0, value = 0)
      )

      update_min_max(session, args)
    } else {
      validate(need(FALSE, "This is an invalid data contraint for the filtered data"))
    }
  })

  create_anl_constraint_reactive(anl_param, input, param_id = param_id, min_rows = min_rows)
}

# returns a reactive that applies the `x-axis data constraint`
# More precisely, all patients are filtered out that do not have the range of
# `param_id.constraint_var` in the specified range
# constraint var means that `param_id.constraint_var` is constrained to the filtered range (or NA),
# e.g. `ALT.BASE2` (i.e. `PARAMCD = ALT & range_filter_on(BASE2)`)
create_anl_constraint_reactive <- function(anl_param, input, param_id, min_rows) {
  iv_r <- reactive({
    iv <- shinyvalidate::InputValidator$new()
    iv$condition(~ isTRUE(input$constraint_var != "NONE"))
    iv$add_rule("constraint_range_min", shinyvalidate::sv_required("A contraint minimum value is required"))
    iv$add_rule("constraint_range_max", shinyvalidate::sv_required("A contraint maximum value is required"))
    iv$add_rule(
      "constraint_range_min",
      ~ if (!is.na(input$constraint_range_max) && (.) > input$constraint_range_max) {
        "constraint min needs to be less than max"
      }
    )
    iv$add_rule(
      "constraint_range_max",
      ~ if (!is.na(input$constraint_range_min) && (.) < input$constraint_range_min) {
        "constraint min needs to be less than max"
      }
    )
    iv
  })


  return_val <- reactive({
    private_qenv <- anl_param()$qenv

    # it is assumed that constraint_var is triggering constraint_range which then trigger this clause
    constraint_var <- isolate(input[["constraint_var"]])
    constraint_range_min <- input[["constraint_range_min"]]
    constraint_range_max <- input[["constraint_range_max"]]
    param <- input[[param_id]]
    req(param)

    # filter constraint
    if (constraint_var != "NONE") {
      private_qenv <- teal.code::eval_code(
        object = private_qenv,
        code = bquote({
          # the below includes patients who have at least one non-NA BASE value
          # ideally, a patient should either have all NA values or none at all
          # this could be achieved through preprocessing; otherwise, this is easily overseen
          filtered_usubjids <- ANL %>% # nolint
            dplyr::filter(
              PARAMCD == .(param),
              (.(constraint_range_min) <= .data[[.(constraint_var)]]) &
                (.data[[.(constraint_var)]] <= .(constraint_range_max))
            ) %>%
            dplyr::pull(USUBJID)
          # include patients with all NA values for constraint_var
          filtered_usubjids <- c(
            filtered_usubjids,
            ANL %>%
              dplyr::filter(PARAMCD == .(param)) %>%
              dplyr::group_by(USUBJID) %>%
              dplyr::summarize(all_na = all(is.na(.data[[.(constraint_var)]]))) %>%
              dplyr::filter(all_na) %>%
              dplyr::pull(USUBJID)
          )
          ANL <- ANL %>% dplyr::filter(USUBJID %in% filtered_usubjids) # nolint
        })
      )
      validate_has_data(private_qenv[["ANL"]], min_rows)
    }
    list(ANL = private_qenv[["ANL"]], qenv = private_qenv)
  })

  reactive(
    list(
      value = return_val,
      iv_r = iv_r
    )
  )
}

# for outputting the constraint in the report
formatted_data_constraint <- function(constraint_var, constraint_range_min, constraint_range_max) {
  constraint_var_label <- switch(constraint_var,
    "BASE2" = "Screening",
    "BASE" = "Baseline",
    "None"
  )
  msg <- paste("Data Constraint:", constraint_var_label)
  if (constraint_var_label != "None") {
    msg <- paste(msg, "from", constraint_range_min, "to", constraint_range_max)
  }
  msg
}

update_min_max <- function(session, args) {
  do.call("updateNumericInput", c(list(session = session, inputId = "constraint_range_min"), args$min))
  do.call("updateNumericInput", c(list(session = session, inputId = "constraint_range_max"), args$max))
}

#' UI with a toggleable dichotomous slider to change between slider and numeric input fields
#'
#' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
#' so one can toggle to one or two numeric input fields to set slider instead.
#' The toggle button will show two numeric input field for selecting the from and to range.
#'
#' @md
#' @param id `character` module id
#' @param label `label` label for input field, e.g. slider or numeric inputs
#' @param ... additional parameters to pass to `sliderInput`
#'
#' @name toggle_slider
#' @keywords internal
#' @return `NULL`.
NULL


#' @rdname toggle_slider
toggle_slider_ui <- function(id, label) {
  ns <- NS(id)
  tags$div(
    tags$div(
      style = "display: flex; justify-content: space-between;",
      tags$span(tags$strong(label)),
      tags$div(actionButton(ns("toggle"), "Toggle", class = "btn-xs"))
    ),
    uiOutput(ns("inputs"))
  )
}

#' @keywords internal
#' @rdname toggle_slider
toggle_slider_server <- function(id, data_state, ...) {
  moduleServer(id, function(input, output, session) {
    state <- reactiveValues(
      min = NULL,
      max = NULL,
      value = NULL
    )
    slider_shown <- reactive(input$toggle %% 2 == 0)

    observeEvent(data_state()$range, {
      state$min <- data_state()$range[1]
      state$max <- data_state()$range[2]
      state$value <- data_state()$range
    })

    output$inputs <- renderUI({
      req(state$value)
      if (slider_shown()) {
        tags$div(
          class = "teal-goshawk toggle-slider-container",
          sliderInput(
            inputId = session$ns("slider"),
            label = NULL,
            min = min(data_state()$range[1], state$min),
            max = max(data_state()$range[2], state$max),
            value = state$value,
            step = data_state()$step,
            ticks = TRUE,
            ...
          ),
          tags$script(HTML(sprintf(
            '
              $(".teal-goshawk.toggle-slider-container #%s").ready(function () {
                var tickLabel = document.querySelector(
                  ".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
                );
                var tick = document.querySelector(
                  ".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
                );
                if (tickLabel) {
                  if (parseFloat(tickLabel.style.left) > 95) {
                    tickLabel.style.opacity = "0";
                    tick.style.opacity = "0";
                  }
                } else {
                  console.log("Toggle slider element not found.");
                }
              });
            ',
            session$ns("slider")
          )))
        )
      } else {
        tags$div(
          class = "teal-goshawk toggle-slider-container",
          numericInput(
            inputId = session$ns("value_low"),
            label = "From:",
            value = state$value[1]
          ),
          numericInput(
            inputId = session$ns("value_high"),
            label = "to:",
            value = state$value[2]
          )
        )
      }
    })

    d_slider <- debounce(reactive(input$slider), 500)

    observeEvent(d_slider(), {
      if (!setequal(state$value, d_slider())) {
        state$value <- d_slider()
      }
    })

    d_value_low <- debounce(reactive(input$value_low), 500)
    d_value_high <- debounce(reactive(input$value_high), 500)

    observeEvent(c(d_value_low(), d_value_high()), ignoreInit = TRUE, {
      values <- c(input$value_low, input$value_high)
      if (!setequal(state$value, values)) {
        state$value <- values
        state$min <- values[1]
        state$max <- values[2]
      }
    })

    state
  })
}

#' @keywords internal
#' @rdname toggle_slider
get_data_range_states <- function(varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
  validate(need(varname, "Please select variable"))
  validate(need(paramname, "Please select variable"))
  req(length(paramname) == 1)
  step <- NULL

  ANL <- ANL %>% dplyr::filter(.data$PARAMCD == paramname) # nolint object_name_linter
  validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))

  var <- stats::na.omit(ANL[[varname]])
  minmax <- if (length(var)) c(floor(min(var)), ceiling(max(var))) else c(0, 0)
  if (!is.null(trt_group)) {
    ANL_split <- ANL %>% split(f = factor(paste0(ANL[["AVISITCD"]], ANL[[trt_group]]))) # nolint
    density_maxes <- lapply(ANL_split, function(x) {
      max(stats::density(stats::na.omit(x[[varname]]))$y)
    })
    dmax <- max(unlist(density_maxes))
    minmax <- c(0, round(dmax * 1.2, 5))
    step <- round(dmax / 100, 5)
  }
  list(
    range = c(min = minmax[[1]], max = minmax[[2]]),
    step = step
  )
}

#' Box Plot
#'
#' This teal module renders the UI and calls the functions that create a box plot and accompanying
#' summary table.
#'
#' @param label menu item label of the module in the teal app.
#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
#'  laboratory data frame `ALB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param list of biomarkers of interest.
#' @param yaxis_var name of variable containing biomarker results displayed on y-axis e.g. `AVAL`. When not provided,
#' it defaults to `choices_selected(c("AVAL", "CHG"), "AVAL")`.
#' @param xaxis_var variable to categorize the x-axis. When not provided, it defaults to
#' `choices_selected("AVISITCD", "AVISITCD")`.
#' @param facet_var variable to facet the plots by. When not provided, it defaults to
#' `choices_selected(c("ARM", "ACTARM"), "ARM")`.
#' @param trt_group  \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected
#'  option for variable names representing treatment group e.g. `ARM`.
#' @param color_manual vector of colors applied to treatment values.
#' @param shape_manual vector of symbols applied to `LOQ` values.
#' @param facet_ncol numeric value indicating number of facets per row.
#' @param loq_legend `loq` legend toggle.
#' @param rotate_xlab 45 degree rotation of `x-axis` values.
#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param hline_vars a character vector to name the columns that will define additional horizontal lines.
#' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines.
#' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear
#'  in the legend.
#' @param plot_height controls plot height.
#' @param plot_width optional, controls plot width.
#' @param font_size font size control for title, `x-axis` label, `y-axis` label and legend.
#' @param dot_size plot dot size.
#' @param alpha numeric vector to define transparency of plotted points.
#'
#' @inheritParams teal.widgets::standard_layout
#' @inheritParams teal::module
#'
#' @author Jeff Tomlinson (tomlinsj) jeffrey.tomlinson@roche.com
#' @author Balazs Toth (tothb2) toth.balazs@gene.com
#'
#' @return an \code{\link[teal]{module}} object
#'
#' @export
#'
#' @examplesIf require("nestcolor")
#' # Example using ADaM structure analysis dataset.
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   library(nestcolor)
#'   library(stringr)
#'
#'   # use non-exported function from goshawk
#'   .h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
#'
#'   # original ARM value = dose value
#'   .arm_mapping <- list(
#'     "A: Drug X" = "150mg QD",
#'     "B: Placebo" = "Placebo",
#'     "C: Combination" = "Combination"
#'   )
#'   set.seed(1) # @linksto ADSL ADLB
#'   ADSL <- rADSL
#'   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", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
#'         TRUE ~ as.character(NA)
#'       ),
#'       AVISITCDN = case_when(
#'         AVISITCD == "SCR" ~ -2,
#'         AVISITCD == "BL" ~ 0,
#'         grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
#'         TRUE ~ as.numeric(NA)
#'       ),
#'       AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
#'       TRTORD = case_when(
#'         ARMCD == "ARM C" ~ 1,
#'         ARMCD == "ARM B" ~ 2,
#'         ARMCD == "ARM A" ~ 3
#'       ),
#'       ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
#'       ARM = factor(ARM) %>% reorder(TRTORD),
#'       ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
#'       ACTARM = factor(ACTARM) %>% reorder(TRTORD),
#'       ANRLO = 50,
#'       ANRHI = 75
#'     ) %>%
#'     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[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
#'   attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
#'   attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
#'
#'   # add LLOQ and ULOQ variables
#'   ALB_LOQS <- .h_identify_loq_values(ADLB, "LOQFL")
#'   ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")
#' })
#'
#' join_keys(data) <- default_cdisc_join_keys[names(data)]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_gh_boxplot(
#'       label = "Box Plot",
#'       dataname = "ADLB",
#'       param_var = "PARAMCD",
#'       param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
#'       yaxis_var = choices_selected(c("AVAL", "BASE", "CHG"), "AVAL"),
#'       xaxis_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "STUDYID"), "ARM"),
#'       facet_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "SEX"), "AVISITCD"),
#'       trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
#'       loq_legend = TRUE,
#'       rotate_xlab = FALSE,
#'       hline_arb = c(60, 55),
#'       hline_arb_color = c("grey", "red"),
#'       hline_arb_label = c("default_hori_A", "default_hori_B"),
#'       hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'       hline_vars_colors = c("pink", "brown", "purple", "black"),
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_g_gh_boxplot <- function(label,
                            dataname,
                            param_var,
                            param,
                            yaxis_var = teal.transform::choices_selected(c("AVAL", "CHG"), "AVAL"),
                            xaxis_var = teal.transform::choices_selected("AVISITCD", "AVISITCD"),
                            facet_var = teal.transform::choices_selected(c("ARM", "ACTARM"), "ARM"),
                            trt_group,
                            color_manual = NULL,
                            shape_manual = NULL,
                            facet_ncol = NULL,
                            loq_legend = TRUE,
                            rotate_xlab = 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,
                            plot_height = c(600, 200, 2000),
                            plot_width = NULL,
                            font_size = c(12, 8, 20),
                            dot_size = c(2, 1, 12),
                            alpha = c(0.8, 0.0, 1.0),
                            pre_output = NULL,
                            post_output = NULL,
                            transformators = list()) {
  message("Initializing tm_g_gh_boxplot")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(param_var)
  checkmate::assert_class(param, "choices_selected")
  checkmate::assert_class(yaxis_var, "choices_selected")
  checkmate::assert_class(xaxis_var, "choices_selected")
  checkmate::assert_class(facet_var, "choices_selected")
  checkmate::assert_class(trt_group, "choices_selected")
  checkmate::assert_int(facet_ncol, null.ok = TRUE)
  checkmate::assert_flag(loq_legend)
  checkmate::assert_flag(rotate_xlab)
  checkmate::assert_numeric(font_size, len = 3)
  checkmate::assert_numeric(dot_size, len = 3)
  checkmate::assert_numeric(alpha, len = 3)
  validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
  validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )

  args <- as.list(environment())

  module(
    label = label,
    datanames = dataname,
    server = srv_g_boxplot,
    server_args = list(
      dataname = dataname,
      param_var = param_var,
      color_manual = color_manual,
      shape_manual = shape_manual,
      plot_height = plot_height,
      plot_width = plot_width,
      hline_vars_colors = hline_vars_colors,
      hline_vars_labels = hline_vars_labels,
      module_args = args
    ),
    ui = ui_g_boxplot,
    ui_args = args,
    transformators = transformators
  )
}

ui_g_boxplot <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  teal.widgets::standard_layout(
    output = bslib::page_fluid(
      tags$div(
        teal.widgets::plot_with_settings_ui(id = ns("boxplot"))
      ),
      tags$div(
        tags$br(), tags$hr(),
        tags$h4("Selected Data Points"),
        DT::dataTableOutput(ns("brush_data"))
      ),
      tags$div(
        tags$br(), tags$hr(),
        tags$h4("Descriptive Statistics"),
        DT::dataTableOutput(ns("table_ui"))
      )
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
      tags$br(), tags$br(),
      ###
      templ_ui_dataname(a$dataname),
      uiOutput(ns("axis_selections")),
      templ_ui_constraint(ns, label = "Data Constraint"), # required by constr_anl_q
      if (length(a$hline_vars) > 0) {
        teal.widgets::optionalSelectInput(
          ns("hline_vars"),
          label = "Add Horizontal Range Line(s):",
          choices = a$hline_vars,
          selected = NULL,
          multiple = TRUE
        )
      },
      ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
      bslib::accordion(
        bslib::accordion_panel(
          title = "Plot Aesthetic Settings",
          toggle_slider_ui(
            ns("yrange_scale"),
            label = "Y-Axis Range Zoom"
          ),
          numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
          checkboxInput(ns("loq_legend"), "Display LoQ Legend", a$loq_legend),
          checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab)
        ),
        bslib::accordion_panel(
          title = "Plot settings",
          teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
          teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE),
          teal.widgets::optionalSliderInputValMinMax(ns("alpha"), "Dot Alpha", a$alpha, ticks = FALSE)
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}


srv_g_boxplot <- function(id,
                          data,
                          reporter,
                          filter_panel_api,
                          dataname,
                          param_var,
                          trt_group,
                          color_manual,
                          shape_manual,
                          plot_height,
                          plot_width,
                          hline_vars_colors,
                          hline_vars_labels,
                          module_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
    output$axis_selections <- renderUI({
      env <- shiny::isolate(as.list(data()[[".raw_data"]]))
      resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
      resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
      resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
      resolved_facet_var <- teal.transform::resolve_delayed(module_args$facet_var, env)
      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)

      templ_ui_params_vars(
        session$ns,
        xparam_choices = resolved_param$choices,
        xparam_selected = resolved_param$selected,
        xparam_label = module_args$"Select a Biomarker",
        xchoices = resolved_x$choices,
        xselected = resolved_x$selected,
        ychoices = resolved_y$choices,
        yselected = resolved_y$selected,
        facet_choices = resolved_facet_var$choices,
        facet_selected = resolved_facet_var$selected,
        trt_choices = resolved_trt$choices,
        trt_selected = resolved_trt$selected
      )
    })
    # reused in all modules
    anl_q_output <- constr_anl_q(
      session, input, data, dataname,
      param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
    )

    anl_q <- anl_q_output()$value

    # update sliders for axes taking constraints into account
    data_state <- reactive({
      get_data_range_states(
        varname = input$yaxis_var,
        paramname = input$xaxis_param,
        ANL = anl_q()$ANL
      )
    })
    yrange_slider_state <- toggle_slider_server("yrange_scale", data_state)
    keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")

    horizontal_line <- srv_arbitrary_lines("hline_arb")

    trt_group <- reactive({
      input$trt_group
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
      iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
      iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
      iv$add_rule("xaxis_var", ~ if ((.) %in% c("ACTARM", "ARM") && isTRUE((.) != trt_group())) {
        sprintf("You can not choose %s as x-axis variable for treatment variable %s.", (.), trt_group())
      })
      iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))

      iv$add_rule("facet_var", shinyvalidate::sv_optional())
      iv$add_rule("facet_var", ~ if ((.) %in% c("ACTARM", "ARM") && isTRUE((.) != trt_group())) {
        sprintf("You can not choose %s as faceting variable for treatment variable %s.", (.), trt_group())
      })

      iv_facet <- shinyvalidate::InputValidator$new()
      iv_facet$condition(~ !is.null(input$facet_var))
      iv_facet$add_rule("facet_ncol", plots_per_row_validate_rules(required = FALSE))
      iv$add_validator(iv_facet)

      iv$add_validator(horizontal_line()$iv_r())
      iv$add_validator(anl_q_output()$iv_r())
      iv$enable()
      iv
    })

    create_plot <- debounce(reactive({
      teal::validate_inputs(iv_r())

      req(anl_q())
      # nolint start
      param <- input$xaxis_param
      yaxis <- input$yaxis_var
      xaxis <- input$xaxis_var
      facet_var <- `if`(is.null(input$facet_var), "None", input$facet_var)
      ylim <- yrange_slider_state$value
      facet_ncol <- input$facet_ncol

      alpha <- input$alpha
      font_size <- input$font_size
      dot_size <- input$dot_size
      loq_legend <- input$loq_legend
      rotate_xlab <- input$rotate_xlab

      hline_arb <- horizontal_line()$line_arb
      hline_arb_label <- horizontal_line()$line_arb_label
      hline_arb_color <- horizontal_line()$line_arb_color

      hline_vars <- input$hline_vars
      trt_group <- input$trt_group
      # nolint end

      validate_has_variable(
        anl_q()$ANL,
        yaxis,
        sprintf("Variable %s is not available in data %s", yaxis, dataname)
      )
      validate_has_variable(
        anl_q()$ANL,
        xaxis,
        sprintf("Variable %s is not available in data %s", xaxis, dataname)
      )

      if (!facet_var == "None") {
        validate_has_variable(
          anl_q()$ANL,
          facet_var,
          sprintf("Variable %s is not available in data %s", facet_var, dataname)
        )
      }

      anl_q()$qenv %>% teal.code::eval_code(
        code = bquote({
          p <- goshawk::g_boxplot(
            data = ANL,
            biomarker = .(param),
            xaxis_var = .(xaxis),
            yaxis_var = .(yaxis),
            hline_arb = .(hline_arb),
            hline_arb_label = .(hline_arb_label),
            hline_arb_color = .(hline_arb_color),
            hline_vars = .(hline_vars),
            hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
            hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)]),
            facet_ncol = .(facet_ncol),
            loq_legend = .(loq_legend),
            rotate_xlab = .(rotate_xlab),
            trt_group = .(trt_group),
            ylim = .(ylim),
            color_manual = .(color_manual),
            shape_manual = .(shape_manual),
            facet_var = .(facet_var),
            alpha = .(alpha),
            dot_size = .(dot_size),
            font_size = .(font_size),
            unit = .("AVALU")
          )
          p
        })
      )
    }), 800)

    create_table <- debounce(reactive({
      req(iv_r()$is_valid())
      req(anl_q())
      param <- input$xaxis_param
      xaxis_var <- input$yaxis_var # nolint
      font_size <- input$font_size
      trt_group <- input$trt_group
      facet_var <- input$facet_var

      anl_q()$qenv %>% teal.code::eval_code(
        code = bquote({
          tbl <- goshawk::t_summarytable(
            data = ANL,
            trt_group = .(trt_group),
            param_var = .(param_var),
            param = .(param),
            xaxis_var = .(xaxis_var),
            facet_var = .(facet_var)
          )
          tbl
        })
      )
    }), 800)

    plot_r <- reactive({
      create_plot()[["p"]]
    })

    boxplot_data <- teal.widgets::plot_with_settings_srv(
      id = "boxplot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
      brushing = TRUE
    )

    output$table_ui <- DT::renderDataTable({
      req(create_table())
      tbl <- create_table()[["tbl"]]

      numeric_cols <- setdiff(names(dplyr::select_if(tbl, is.numeric)), "n")

      DT::datatable(tbl,
        rownames = FALSE, options = list(scrollX = TRUE)
      ) %>%
        DT::formatRound(numeric_cols, 4)
    })

    joined_qenvs <- reactive({
      req(create_plot(), create_table())
      c(create_plot(), create_table())
    })

    code <- reactive(teal.code::get_code(joined_qenvs()))

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        constraint_description <- paste(
          "\nFacet By:",
          if (length(input$facet_var) != 0) input$facet_var else "None",
          "\nSelect an X-axis Variable:",
          input$xaxis_var
        )
        card <- report_card_template_goshawk(
          title = "Box Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api,
          constraint_list = list(
            constraint_var = input$constraint_var,
            constraint_range_min = input$constraint_range_min,
            constraint_range_max = input$constraint_range_max
          ),
          constraint_description = constraint_description,
          style = "verbatim"
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = boxplot_data$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(code())
        card
      }
      teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###

    # highlight plot area
    reactive_df <- debounce(reactive({
      boxplot_brush <- boxplot_data$brush()

      ANL <- isolate(anl_q()$ANL) %>% droplevels() # nolint
      validate_has_data(ANL, 2)

      xvar <- isolate(input$xaxis_var)
      yvar <- isolate(input$yaxis_var)
      facetv <- isolate(input$facet_var)
      trt_group <- isolate(input$trt_group)

      req(all(c(xvar, yvar, facetv, trt_group) %in% names(ANL)))

      teal.widgets::clean_brushedPoints(
        dplyr::select(
          ANL, "USUBJID", dplyr::all_of(c(trt_group, facetv)),
          "AVISITCD", "PARAMCD", dplyr::all_of(c(xvar, yvar)), "LOQFL"
        ),
        boxplot_brush
      )
    }), 800)

    output$brush_data <- DT::renderDataTable({
      numeric_cols <- names(dplyr::select_if(reactive_df(), is.numeric))

      DT::datatable(reactive_df(),
        rownames = FALSE, options = list(scrollX = TRUE)
      ) %>%
        DT::formatRound(numeric_cols, 4)
    })

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(code()),
      title = "Show R Code for Boxplot"
    )
  })
}

#' Spaghetti Plot
#'
#' This teal module renders the UI and calls the function
#' that creates a spaghetti plot.
#'
#' @param label menu item label of the module in the teal app.
#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}.
#' E.g. `ADaM` structured laboratory data frame `ADLB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param biomarker selected.
#' @param param_var_label single name of variable in analysis data
#' that includes parameter labels.
#' @param idvar name of unique subject id variable.
#' @param xaxis_var single name of variable in analysis data
#' that is used as x-axis in the plot for the respective goshawk function.
#' @param xaxis_var_level vector that can be used to define the factor level of `xaxis_var`.
#' Only use it when `xaxis_var` is character or factor.
#' @param filter_var data constraint variable.
#' @param yaxis_var single name of variable in analysis data that is used as
#' summary variable in the respective `goshawk` function.
#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
#' for variable names representing treatment group e.g. `ARM`.
#' @param trt_group_level vector that can be used to define factor
#' level of `trt_group`.
#' @param man_color string vector representing customized colors
#' @param color_comb name or hex value for combined treatment color.
#' @param xtick numeric vector to define the tick values of `x-axis`
#' when x variable is numeric. Default value is `waive()`.
#' @param xlabel vector with same length of `xtick` to define the
#' label of `x-axis` tick values. Default value is `waive()`.
#' @param rotate_xlab `logical(1)` value indicating whether to rotate `x-axis` labels
#' @param facet_ncol numeric value indicating number of facets per row.
#' @param free_x `logical(1)` should scales be `"fixed"` (`FALSE`) of `"free"` (`TRUE`) for `x-axis` in
#' \code{\link[ggplot2]{facet_wrap}} \code{scales} parameter.
#' @param plot_height controls plot height.
#' @param plot_width optional, controls plot width.
#' @param font_size control font size for title, `x-axis`, `y-axis` and legend font.
#' @param dot_size plot dot size.
#' @param group_stats control group mean or median overlay.
#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param hline_vars a character vector to name the columns that will define additional horizontal lines.
#' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines.
#' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear
#'  in the legend.
#' @inheritParams teal::module
#' @inheritParams teal.widgets::standard_layout
#'
#' @author Wenyi Liu (luiw2) wenyi.liu@roche.com
#' @author Balazs Toth (tothb2) toth.balazs@gene.com
#'
#' @return \code{shiny} object
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   library(stringr)
#'
#'   # use non-exported function from goshawk
#'   .h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
#'
#'   # original ARM value = dose value
#'   .arm_mapping <- list(
#'     "A: Drug X" = "150mg QD",
#'     "B: Placebo" = "Placebo",
#'     "C: Combination" = "Combination"
#'   )
#'   set.seed(1) # @linksto ADSL ADLB
#'   ADSL <- rADSL
#'   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", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
#'         TRUE ~ as.character(NA)
#'       ),
#'       AVISITCDN = case_when(
#'         AVISITCD == "SCR" ~ -2,
#'         AVISITCD == "BL" ~ 0,
#'         grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
#'         TRUE ~ as.numeric(NA)
#'       ),
#'       AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
#'       TRTORD = case_when(
#'         ARMCD == "ARM C" ~ 1,
#'         ARMCD == "ARM B" ~ 2,
#'         ARMCD == "ARM A" ~ 3
#'       ),
#'       ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
#'       ARM = factor(ARM) %>% reorder(TRTORD),
#'       ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
#'       ACTARM = factor(ACTARM) %>% reorder(TRTORD),
#'       ANRLO = 30,
#'       ANRHI = 75
#'     ) %>%
#'     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[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
#'   attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
#'   attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
#'
#'   # add LLOQ and ULOQ variables
#'   ALB_LOQS <- .h_identify_loq_values(ADLB, "LOQFL")
#'   ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")
#' })
#'
#' join_keys(data) <- default_cdisc_join_keys[names(data)]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_gh_spaghettiplot(
#'       label = "Spaghetti Plot",
#'       dataname = "ADLB",
#'       param_var = "PARAMCD",
#'       param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
#'       idvar = "USUBJID",
#'       xaxis_var = choices_selected(c("Analysis Visit Code" = "AVISITCD"), "AVISITCD"),
#'       yaxis_var = choices_selected(c("AVAL", "CHG", "PCHG"), "AVAL"),
#'       filter_var = choices_selected(
#'         c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE"),
#'         "NONE"
#'       ),
#'       trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
#'       color_comb = "#39ff14",
#'       man_color = c(
#'         "Combination" = "#000000",
#'         "Placebo" = "#fce300",
#'         "150mg QD" = "#5a2f5f"
#'       ),
#'       hline_arb = c(60, 50),
#'       hline_arb_color = c("grey", "red"),
#'       hline_arb_label = c("default A", "default B"),
#'       hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'       hline_vars_colors = c("pink", "brown", "purple", "black"),
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_g_gh_spaghettiplot <- function(label,
                                  dataname,
                                  param_var,
                                  param,
                                  param_var_label = "PARAM",
                                  idvar,
                                  xaxis_var,
                                  yaxis_var,
                                  xaxis_var_level = NULL,
                                  filter_var = yaxis_var,
                                  trt_group,
                                  trt_group_level = NULL,
                                  group_stats = "NONE",
                                  man_color = NULL,
                                  color_comb = NULL,
                                  xtick = ggplot2::waiver(),
                                  xlabel = xtick,
                                  rotate_xlab = FALSE,
                                  facet_ncol = 2,
                                  free_x = FALSE,
                                  plot_height = c(600, 200, 2000),
                                  plot_width = NULL,
                                  font_size = c(12, 8, 20),
                                  dot_size = c(2, 1, 12),
                                  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,
                                  pre_output = NULL,
                                  post_output = NULL,
                                  transformators = list()) {
  message("Initializing tm_g_gh_spaghettiplot")

  # Validate string inputs
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(param_var)
  checkmate::assert_string(param_var_label)
  checkmate::assert_string(idvar)
  checkmate::assert_string(group_stats)

  # Validate choices_selected class inputs
  checkmate::assert_class(param, "choices_selected")
  checkmate::assert_class(xaxis_var, "choices_selected")
  checkmate::assert_class(yaxis_var, "choices_selected")
  checkmate::assert_class(trt_group, "choices_selected")

  # Validate flag inputs
  checkmate::assert_flag(rotate_xlab)
  checkmate::assert_flag(free_x)

  # Validate numeric vector inputs
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3],
    null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(dot_size, len = 3, any.missing = FALSE, finite = TRUE)

  # Validate color manual if provided
  checkmate::assert_character(man_color, null.ok = TRUE)
  checkmate::assert_character(color_comb, null.ok = TRUE)
  checkmate::assert_character(hline_arb_color)
  checkmate::assert_character(hline_arb_label)

  # Validate facet columns
  checkmate::assert_int(facet_ncol, lower = 1)

  # Validate line arguments
  validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
  validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels)

  args <- as.list(environment())

  module(
    label = label,
    server = srv_g_spaghettiplot,
    server_args = list(
      dataname = dataname,
      idvar = idvar,
      param_var = param_var,
      xaxis_var_level = xaxis_var_level,
      trt_group_level = trt_group_level,
      man_color = man_color,
      color_comb = color_comb,
      param_var_label = param_var_label,
      xtick = xtick,
      xlabel = xlabel,
      plot_height = plot_height,
      plot_width = plot_width,
      hline_vars_colors = hline_vars_colors,
      hline_vars_labels = hline_vars_labels,
      module_args = args
    ),
    ui = g_ui_spaghettiplot,
    ui_args = args,
    transformators = transformators,
    datanames = dataname
  )
}

g_ui_spaghettiplot <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  tags$div(
    teal.widgets::standard_layout(
      output = templ_ui_output_datatable(ns),
      encoding = tags$div(
        ### Reporter
        teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
        tags$br(), tags$br(),
        ###
        templ_ui_dataname(a$dataname),
        uiOutput(ns("axis_selections")),
        radioButtons(
          ns("group_stats"),
          "Group Statistics",
          c("None" = "NONE", "Mean" = "MEAN", "Median" = "MEDIAN"),
          inline = TRUE
        ),
        templ_ui_constraint(ns), # required by constr_anl_q
        if (length(a$hline_vars) > 0) {
          teal.widgets::optionalSelectInput(
            ns("hline_vars"),
            label = "Add Horizontal Range Line(s):",
            choices = a$hline_vars,
            selected = NULL,
            multiple = TRUE
          )
        },
        ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
        bslib::accordion(
          bslib::accordion_panel(
            title = "Plot Aesthetic Settings",
            tags$div(
              toggle_slider_ui(
                ns("yrange_scale"),
                label = "Y-Axis Range Zoom"
              ),
              tags$div(
                class = "flex flex-wrap items-center",
                tags$div(
                  class = "mr-1",
                  tags$span(tags$strong("Number of Plots Per Row:"))
                ),
                tags$div(
                  class = "w-65px",
                  numericInput(ns("facet_ncol"), "", a$facet_ncol, min = 1)
                )
              )
            ),
            checkboxInput(ns("free_x"), "Free X-Axis Scales", a$free_x),
            checkboxInput(ns("rotate_xlab"), "Rotate X-Axis Label", a$rotate_xlab),
            teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
            teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE),
            teal.widgets::optionalSliderInputValMinMax(
              ns("alpha"),
              "Line Alpha",
              a$alpha,
              value_min_max = c(0.8, 0.0, 1.0), step = 0.1, ticks = FALSE
            )
          )
        )
      ),
      forms = tagList(
        teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
      ),
      pre_output = a$pre_output,
      post_output = a$post_output
    )
  )
}



srv_g_spaghettiplot <- function(id,
                                data,
                                reporter,
                                filter_panel_api,
                                dataname,
                                idvar,
                                param_var,
                                trt_group,
                                man_color,
                                color_comb,
                                xaxis_var_level,
                                trt_group_level,
                                param_var_label,
                                xtick,
                                xlabel,
                                plot_height,
                                plot_width,
                                hline_vars_colors,
                                hline_vars_labels,
                                module_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
    output$axis_selections <- renderUI({
      env <- shiny::isolate(as.list(data()[[".raw_data"]]))
      resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
      resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
      resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
      templ_ui_params_vars(
        session$ns,
        # xparam and yparam are identical, so we only show the user one
        xparam_choices = resolved_param$choices,
        xparam_selected = resolved_param$selected,
        xparam_label = "Select a Biomarker",
        xchoices = resolved_x$choices,
        xselected = resolved_x$selected,
        ychoices = resolved_y$choices,
        yselected = resolved_y$selected,
        trt_choices = resolved_trt$choices,
        trt_selected = resolved_trt$selected
      )
    })

    # reused in all modules
    anl_q_output <- constr_anl_q(
      session, input, data, dataname,
      param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 1
    )

    anl_q <- anl_q_output()$value

    # update sliders for axes taking constraints into account
    data_state <- reactive({
      get_data_range_states(
        varname = input$yaxis_var,
        paramname = input$xaxis_param,
        ANL = anl_q()$ANL
      )
    })
    yrange_slider <- toggle_slider_server("yrange_scale", data_state)
    keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")

    horizontal_line <- srv_arbitrary_lines("hline_arb")

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
      iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
      iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
      iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))
      iv$add_rule("facet_ncol", plots_per_row_validate_rules())

      iv$add_validator(horizontal_line()$iv_r())
      iv$add_validator(anl_q_output()$iv_r())
      iv$enable()
      iv
    })


    plot_q <- debounce(reactive({
      teal::validate_inputs(iv_r())
      req(anl_q())
      # nolint start
      ylim <- yrange_slider$value
      facet_ncol <- input$facet_ncol
      facet_scales <- ifelse(input$free_x, "free_x", "fixed")

      rotate_xlab <- input$rotate_xlab
      hline_arb <- horizontal_line()$line_arb
      hline_arb_label <- horizontal_line()$line_arb_label
      hline_arb_color <- horizontal_line()$line_arb_color
      group_stats <- input$group_stats
      font_size <- input$font_size
      dot_size <- input$dot_size
      alpha <- input$alpha
      validate(need(input$trt_group, "Please select a treatment variable"))
      trt_group <- input$trt_group

      # Below inputs should trigger plot via updates of other reactive objects (i.e. anl_q()) and some inputs
      param <- input$xaxis_param
      xaxis_var <- input$xaxis_var
      yaxis_var <- input$yaxis_var
      hline_vars <- input$hline_vars
      # nolint end

      private_qenv <- anl_q()$qenv

      # this code is needed to make sure the waiver attribute
      # of ggplot2::waiver is correctly passed to goshawk's spaghettiplot
      if (!methods::is(xtick, "waiver")) {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = bquote(xtick <- .(xtick))
        )
      } else {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = quote(xtick <- ggplot2::waiver())
        )
      }

      if (!methods::is(xlabel, "waiver")) {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = bquote(xlabel <- .(xlabel))
        )
      } else {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = quote(xlabel <- ggplot2::waiver())
        )
      }

      teal.code::eval_code(
        object = private_qenv,
        code = bquote({
          p <- goshawk::g_spaghettiplot(
            data = ANL,
            subj_id = .(idvar),
            biomarker_var = .(param_var),
            biomarker_var_label = .(param_var_label),
            biomarker = .(param),
            value_var = .(yaxis_var),
            trt_group = .(trt_group),
            trt_group_level = .(trt_group_level),
            time = .(xaxis_var),
            time_level = .(xaxis_var_level),
            color_manual = .(man_color),
            color_comb = .(color_comb),
            ylim = .(ylim),
            facet_ncol = .(facet_ncol),
            facet_scales = .(facet_scales),
            hline_arb = .(hline_arb),
            hline_arb_label = .(hline_arb_label),
            hline_arb_color = .(hline_arb_color),
            xtick = xtick,
            xlabel = xlabel,
            rotate_xlab = .(rotate_xlab),
            font_size = .(font_size),
            dot_size = .(dot_size),
            alpha = .(alpha),
            group_stats = .(group_stats),
            hline_vars = .(hline_vars),
            hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
            hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)])
          )
          p
        })
      )
    }), 800)

    plot_r <- reactive({
      plot_q()[["p"]]
    })

    plot_data <- teal.widgets::plot_with_settings_srv(
      id = "plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
      brushing = TRUE
    )

    code <- reactive(teal.code::get_code(plot_q()))

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- report_card_template_goshawk(
          title = "Spaghetti Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api,
          constraint_list = list(
            constraint_var = input$constraint_var,
            constraint_range_min = input$constraint_range_min,
            constraint_range_max = input$constraint_range_max
          )
        )
        card$append_text("Spaghetti Plot", "header3")
        card$append_plot(plot_r(), dim = plot_data$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(code())
        card
      }
      teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###

    reactive_df <- debounce(reactive({
      plot_brush <- plot_data$brush()

      ANL <- isolate(anl_q()$ANL) # nolint
      validate_has_data(ANL, 1)

      xvar <- isolate(input$xaxis_var)
      yvar <- isolate(input$yaxis_var)
      trt_group <- isolate(input$trt_group)

      req(all(c(xvar, yvar) %in% names(ANL)))

      df <- teal.widgets::clean_brushedPoints(
        dplyr::select(
          ANL, "USUBJID", dplyr::all_of(trt_group), "PARAMCD",
          dplyr::all_of(c(xvar, yvar)), "LOQFL"
        ),
        plot_brush
      )
      df[order(df$PARAMCD, df[[trt_group]], df$USUBJID, df[[xvar]]), ]
    }), 800)

    output$brush_data <- DT::renderDataTable({
      numeric_cols <- names(dplyr::select_if(reactive_df(), is.numeric))

      DT::datatable(reactive_df(),
        rownames = FALSE, options = list(scrollX = TRUE)
      ) %>%
        DT::formatRound(numeric_cols, 4)
    })

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(code()),
      title = "Show R Code for Spaghetti Plot"
    )
  })
}

#' UI module to arbitrary lines
#'
#' UI module to input either horizontal or vertical lines to a plot via comma separated values
#'
#' @param id (`character(1)`)\cr
#'  defining namespace of the `shiny` module.
#' @param line_arb (`numeric`)\cr
#'  default values for the `textInput` defining values of arbitrary lines
#' @param line_arb_color (`character`)\cr
#'  default values for the `textInput` defining colors of arbitrary lines
#' @param line_arb_label (`character`)\cr
#'  default values for the `textInput` defining labels of arbitrary lines
#' @param title (`character(1)`)\cr
#'  title of the arbitrary lines input. The default is "Arbitrary Horizontal Lines".
#' @return (`shiny.tag`) an input to define values, colors and labels for arbitrary
#' straight lines.
#' @keywords internal
ui_arbitrary_lines <- function(id, line_arb, line_arb_label, line_arb_color, title = "Arbitrary horizontal lines:") {
  ns <- NS(id)
  tags$div(
    tags$b(
      title,
      bslib::tooltip(
        trigger = icon("circle-info"),
        tags$span(
          "For multiple lines, supply a comma separated list of values."
        )
      )
    ),
    textInput(
      ns("line_arb"),
      "Value:",
      value = paste(line_arb, collapse = ", ")
    ),
    textInput(ns("line_arb_label"), label = "Label:", value = paste(line_arb_label, collapse = ", ")),
    textInput(ns("line_arb_color"), label = "Color:", value = paste(line_arb_color, collapse = ", "))
  )
}
#' Server module to arbitrary lines
#'
#' Server to validate and transform the comma separated values into vectors of values
#' to be passed into goshawk functions.
#' @inheritParams shiny::moduleServer
#' @return (`reactive`) returning a `list` containing `line_arb`, `line_arb_color`,
#'  `line_arb_label` which are validated and could be passed to `goshawk` plot functions.
#' @keywords internal
srv_arbitrary_lines <- function(id) {
  moduleServer(id, function(input, output, session) {
    comma_sep_to_values <- function(values, wrapper_fun = trimws) {
      vals <- strsplit(values, "\\s{0,},\\s{0,}")[[1]]
      suppressWarnings(wrapper_fun(vals))
    }

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("line_arb", shinyvalidate::sv_optional())
      iv$add_rule(
        "line_arb",
        ~ if (any(is.na(comma_sep_to_values(., as.numeric)))) {
          "Arbitrary lines values should be a comma separated list of numbers"
        }
      )

      iv_color <- shinyvalidate::InputValidator$new()
      iv_color$condition(~ length(line_arb()) != 0)

      iv_color$add_rule("line_arb_color", shinyvalidate::sv_optional())
      iv_color$add_rule(
        "line_arb_color",
        ~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
          sprintf(
            "Line input error: number of colors should be equal to 1, the number of lines (%d) or left blank for 'red'",
            length(line_arb())
          )
        }
      )
      iv_color$add_rule("line_arb_color", ~ if (!check_color(comma_sep_to_values(.))) {
        "The line colors entered cannot be converted to colors in R, please check your spelling"
      })
      iv$add_validator(iv_color)


      iv_label <- shinyvalidate::InputValidator$new()
      iv_label$condition(~ length(line_arb()) != 0)

      iv_label$add_rule("line_arb_label", shinyvalidate::sv_optional())
      iv_label$add_rule(
        "line_arb_label",
        ~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
          sprintf(
            "Line input error: number of labels should be equal to 1, the number of lines (%d) or left blank",
            length(line_arb())
          )
        }
      )
      iv$add_validator(iv_label)
      iv
    })

    line_arb <- reactive({
      req(!is.null(input$line_arb))
      comma_sep_to_values(input$line_arb, as.numeric)
    })

    line_arb_label <- reactive({
      if (length(line_arb()) == 0) {
        return(character(0))
      }
      val <- comma_sep_to_values(input$line_arb_label)
      if (length(val) == 0) {
        val <- ""
      }
      val
    })

    line_arb_color <- reactive({
      if (length(line_arb()) == 0) {
        return(character(0))
      }
      val <- comma_sep_to_values(input$line_arb_color)
      if (length(val) == 0 || all(val == "")) {
        val <- "red"
      }
      val
    })

    reactive(
      list(
        iv_r = iv_r,
        line_arb = line_arb(),
        line_arb_color = line_arb_color(),
        line_arb_label = line_arb_label()
      )
    )
  })
}

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

# to check the arbitrary line arguments
validate_line_arb_arg <- function(line_arb, line_arb_color, line_arb_label) {
  checkmate::assert_numeric(line_arb)
  if (length(line_arb) > 0) {
    checkmate::assert(
      checkmate::check_string(line_arb_color),
      checkmate::check_character(line_arb_color, len = length(line_arb))
    )
    checkmate::assert(
      checkmate::check_string(line_arb_label),
      checkmate::check_character(line_arb_label, len = length(line_arb))
    )
  }
}

# to check the variable line arguments
validate_line_vars_arg <- function(line_vars, line_vars_colors, line_vars_labels) {
  checkmate::assert_character(line_vars)
  if (length(line_vars) > 0) {
    checkmate::assert(
      checkmate::check_string(line_vars_colors),
      checkmate::check_character(line_vars_colors, len = length(line_vars))
    )
    checkmate::assert(
      checkmate::check_string(line_vars_labels),
      checkmate::check_character(line_vars_labels, len = length(line_vars))
    )
  }
}

#' Density Distribution Plot
#'
#' This teal module renders the UI and calls the functions that create a density distribution plot
#' and an accompanying summary table.
#'
#' @param label menu item label of the module in the teal app.
#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
#' for variable names representing treatment group e.g. `ARM`.
#' @param color_manual vector of colors applied to treatment values.
#' @param color_comb name or hex value for combined treatment color.
#' @param plot_height controls plot height.
#' @param plot_width optional, controls plot width.
#' @param font_size font size control for title, `x-axis` label, `y-axis` label and legend.
#' @param line_size plot line thickness.
#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param facet_ncol numeric value indicating number of facets per row.
#' @param comb_line display combined treatment line toggle.
#' @param rotate_xlab 45 degree rotation of `x-axis` values.
#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
#' @param param_var name of variable containing biomarker codes e.g. \code{PARAMCD}.
#' @param param biomarker selected.
#' @param xaxis_var name of variable containing biomarker results displayed on `x-axis` e.g. \code{BASE}.
#'
#' @inheritParams teal.widgets::standard_layout
#' @inheritParams teal::module
#'
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @details None
#'
#' @export
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   library(stringr)
#'
#'   # original ARM value = dose value
#'   .arm_mapping <- list(
#'     "A: Drug X" = "150mg QD",
#'     "B: Placebo" = "Placebo",
#'     "C: Combination" = "Combination"
#'   )
#'   set.seed(1) # @linksto ADSL ADLB
#'   ADSL <- rADSL
#'   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", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
#'         TRUE ~ as.character(NA)
#'       ),
#'       AVISITCDN = case_when(
#'         AVISITCD == "SCR" ~ -2,
#'         AVISITCD == "BL" ~ 0,
#'         grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
#'         TRUE ~ as.numeric(NA)
#'       ),
#'       AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
#'       TRTORD = case_when(
#'         ARMCD == "ARM C" ~ 1,
#'         ARMCD == "ARM B" ~ 2,
#'         ARMCD == "ARM A" ~ 3
#'       ),
#'       ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
#'       ARM = factor(ARM) %>% reorder(TRTORD),
#'       ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
#'       ACTARM = factor(ACTARM) %>% reorder(TRTORD)
#'     )
#'
#'   attr(ADLB[["ARM"]], "label") <- .var_labels[["ARM"]]
#'   attr(ADLB[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
#' })
#'
#' join_keys(data) <- default_cdisc_join_keys[names(data)]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_gh_density_distribution_plot(
#'       label = "Density Distribution Plot",
#'       dataname = "ADLB",
#'       param_var = "PARAMCD",
#'       param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
#'       xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
#'       trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
#'       color_manual = c(
#'         "150mg QD" = "#000000",
#'         "Placebo" = "#3498DB",
#'         "Combination" = "#E74C3C"
#'       ),
#'       color_comb = "#39ff14",
#'       comb_line = TRUE,
#'       plot_height = c(500, 200, 2000),
#'       font_size = c(12, 8, 20),
#'       line_size = c(1, .25, 3),
#'       hline_arb = c(.02, .05),
#'       hline_arb_color = c("red", "black"),
#'       hline_arb_label = c("Horizontal Line A", "Horizontal Line B")
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_g_gh_density_distribution_plot <- function(label, # nolint
                                              dataname,
                                              param_var,
                                              param,
                                              xaxis_var,
                                              trt_group,
                                              color_manual = NULL,
                                              color_comb = NULL,
                                              plot_height = c(500, 200, 2000),
                                              plot_width = NULL,
                                              font_size = c(12, 8, 20),
                                              line_size = c(1, .25, 3),
                                              hline_arb = numeric(0),
                                              hline_arb_color = "red",
                                              hline_arb_label = "Horizontal line",
                                              facet_ncol = 2L,
                                              comb_line = TRUE,
                                              rotate_xlab = FALSE,
                                              pre_output = NULL,
                                              post_output = NULL,
                                              transformators = list()) {
  message("Initializing tm_g_gh_density_distribution_plot")
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(param_var)
  checkmate::assert_class(param, "choices_selected")
  checkmate::assert_class(xaxis_var, "choices_selected")
  checkmate::assert_class(trt_group, "choices_selected")
  checkmate::assert_numeric(font_size, len = 3)
  checkmate::assert_numeric(line_size, len = 3)
  checkmate::assert_int(facet_ncol)
  checkmate::assert_flag(comb_line)
  checkmate::assert_flag(rotate_xlab)
  validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )

  args <- as.list(environment())

  module(
    label = label,
    datanames = dataname,
    server = srv_g_density_distribution_plot,
    server_args = list(
      dataname = dataname,
      param_var = param_var,
      param = param,
      color_manual = color_manual,
      color_comb = color_comb,
      plot_height = plot_height,
      plot_width = plot_width,
      module_args = args
    ),
    ui = ui_g_density_distribution_plot,
    ui_args = args,
    transformators = transformators
  )
}

ui_g_density_distribution_plot <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  teal.widgets::standard_layout(
    output = bslib::page_fluid(
      tags$div(
        teal.widgets::plot_with_settings_ui(id = ns("plot"))
      ),
      tags$div(
        tags$br(), tags$hr(),
        tags$h4("Descriptive Statistics"),
        DT::dataTableOutput(ns("table_ui"))
      )
    ),
    encoding = tags$div(
      ### Reporter
      teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
      tags$br(), tags$br(),
      ###
      templ_ui_dataname(a$dataname),
      uiOutput(ns("axis_selections")),
      templ_ui_constraint(ns, label = "Data Constraint"),
      ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
      bslib::accordion(
        bslib::accordion_panel(
          title = "Plot Aesthetic Settings",
          toggle_slider_ui(
            ns("xrange_scale"),
            label = "X-Axis Range Zoom"
          ),
          toggle_slider_ui(
            ns("yrange_scale"),
            label = "Y-Axis Range Zoom"
          ),
          numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
          checkboxInput(ns("comb_line"), "Display Combined line", a$comb_line),
          checkboxInput(ns("rug_plot"), "Include rug plot", value = FALSE),
          checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab)
        ),
        bslib::accordion_panel(
          title = "Plot settings",
          teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
          teal.widgets::optionalSliderInputValMinMax(
            ns("line_size"),
            "Line Size",
            value_min_max = a$line_size,
            step = .25,
            ticks = FALSE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

srv_g_density_distribution_plot <- function(id, # nolint
                                            data,
                                            reporter,
                                            filter_panel_api,
                                            dataname,
                                            param_var,
                                            param,
                                            trt_group,
                                            color_manual,
                                            color_comb,
                                            plot_height,
                                            plot_width,
                                            module_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
    output$axis_selections <- renderUI({
      env <- shiny::isolate(as.list(data()[[".raw_data"]]))
      resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
      resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)

      templ_ui_params_vars(
        session$ns,
        xparam_choices = resolved_param$choices,
        xparam_selected = resolved_param$selected,
        xparam_label = "Select a Biomarker",
        xchoices = resolved_x$choices,
        xselected = resolved_x$selected,
        trt_choices = resolved_trt$choices,
        trt_selected = resolved_trt$selected
      )
    })

    anl_q_output <- constr_anl_q(
      session, input, data, dataname,
      param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
    )

    anl_q <- anl_q_output()$value

    # update sliders for axes taking constraints into account
    data_state_x <- reactive({
      get_data_range_states(
        varname = input$xaxis_var,
        paramname = input$xaxis_param,
        ANL = anl_q()$ANL
      )
    })
    xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
    data_state_y <- reactive({
      get_data_range_states(
        varname = input$xaxis_var,
        paramname = input$xaxis_param,
        ANL = anl_q()$ANL,
        trt_group = "trt_group"
      )
    })
    yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)

    keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")

    horizontal_line <- srv_arbitrary_lines("hline_arb")

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
      iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
      iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
      iv$add_rule("facet_ncol", plots_per_row_validate_rules())

      iv$add_validator(horizontal_line()$iv_r())
      iv$add_validator(anl_q_output()$iv_r())
      iv$enable()
      iv
    })


    create_plot <- debounce(reactive({
      teal::validate_inputs(iv_r())
      req(anl_q())

      # nolint start
      param <- input$xaxis_param
      xaxis_var <- input$xaxis_var
      xlim <- xrange_slider$value
      ylim <- yrange_slider$value
      font_size <- input$font_size
      line_size <- input$line_size
      hline_arb <- horizontal_line()$line_arb
      hline_arb_label <- horizontal_line()$line_arb_label
      hline_arb_color <- horizontal_line()$line_arb_color
      facet_ncol <- input$facet_ncol

      comb_line <- input$comb_line
      rug_plot <- input$rug_plot
      rotate_xlab <- input$rotate_xlab
      trt_group <- input$trt_group
      # nolint end


      teal.code::eval_code(
        object = anl_q()$qenv,
        code = bquote({
          p <- goshawk::g_density_distribution_plot(
            data = ANL,
            param_var = .(param_var),
            param = .(param),
            xaxis_var = .(xaxis_var),
            trt_group = .(trt_group),
            xlim = .(xlim),
            ylim = .(ylim),
            color_manual = .(color_manual),
            color_comb = .(color_comb),
            font_size = .(font_size),
            line_size = .(line_size),
            facet_ncol = .(facet_ncol),
            comb_line = .(comb_line),
            hline_arb = .(hline_arb),
            hline_arb_label = .(hline_arb_label),
            hline_arb_color = .(hline_arb_color),
            rug_plot = .(rug_plot)
          )
          p
        })
      )
    }), 800)

    create_table <- debounce(reactive({
      req(iv_r()$is_valid())
      req(anl_q())
      param <- input$xaxis_param
      xaxis_var <- input$xaxis_var
      font_size <- input$font_size
      trt_group <- input$trt_group

      teal.code::eval_code(
        object = anl_q()$qenv,
        code = bquote({
          tbl <- goshawk::t_summarytable(
            data = ANL,
            trt_group = .(trt_group),
            param_var = .(param_var),
            param = .(param),
            xaxis_var = .(xaxis_var),
            font_size = .(font_size)
          )
          tbl
        })
      )
    }), 800)

    plot_r <- reactive({
      create_plot()[["p"]]
    })

    plot_data <- teal.widgets::plot_with_settings_srv(
      id = "plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
    )

    output$table_ui <- DT::renderDataTable({
      req(create_table())
      tbl <- create_table()[["tbl"]]
      numeric_cols <- names(dplyr::select_if(tbl, is.numeric))

      DT::datatable(tbl,
        rownames = FALSE, options = list(scrollX = TRUE)
      ) %>%
        DT::formatRound(numeric_cols, 2)
    })

    joined_qenvs <- reactive({
      req(create_plot(), create_table())
      c(create_plot(), create_table())
    })

    code <- reactive(teal.code::get_code(joined_qenvs()))

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(code()),
      title = "Show R Code for Density Distribution Plot"
    )

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        card <- report_card_template_goshawk(
          title = "Density Distribution Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api,
          constraint_list = list(
            constraint_var = input$constraint_var,
            constraint_range_min = input$constraint_range_min,
            constraint_range_max = input$constraint_range_max
          )
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = plot_data$dim())
        card$append_text("Descriptive Statistics", "header3")
        card$append_table(
          create_table()[["tbl"]] %>% dplyr::mutate_if(is.numeric, round, 2)
        )
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(code())
        card
      }
      teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###
  })
}

#' Scatter Plot Teal Module For Biomarker Analysis
#'
#' @description Scatter Plot Teal Module For Biomarker Analysis
#'
#' @inheritParams teal.widgets::standard_layout
#' @inheritParams teal::module
#' @param label menu item label of the module in the teal app.
#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
#' laboratory data frame \code{ADLB}.
#' @param param_var name of variable containing biomarker codes e.g. \code{PARAMCD}.
#' @param xaxis_param biomarker selected for `x-axis`.
#' @param yaxis_param biomarker selected for `y-axis`.
#' @param xaxis_var name of variable containing biomarker results displayed on x-axis e.g. \code{BASE}.
#' @param yaxis_var name of variable containing biomarker results displayed on y-axis e.g. \code{AVAL}.
#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
#' for variable names representing treatment group e.g. `ARM`.
#' @param color_manual vector of colors applied to treatment values.
#' @param shape_manual vector of symbols applied to `LOQ` values.
#' @param facet_ncol numeric value indicating number of facets per row.
#' @param trt_facet facet by treatment group \code{trt_group}.
#' @param visit_facet visit facet toggle.
#' @param reg_line include regression line and annotations for slope and coefficient in visualization. Use with facet
#'   TRUE.
#' @param loq_legend `loq` legend toggle.
#' @param rotate_xlab 45 degree rotation of `x-axis` values.
#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param hline_vars a character vector to name the columns that will define additional horizontal lines.
#' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines.
#' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear
#' @param vline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param vline_arb_color a character vector of at most length of \code{vline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param vline_arb_label a character vector of at most length of \code{vline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param vline_vars a character vector to name the columns that will define additional vertical lines.
#' @param vline_vars_colors a character vector naming the colors for the additional vertical lines.
#' @param vline_vars_labels a character vector naming the labels for the additional vertical lines that will appear
#' @param plot_height controls plot height.
#' @param plot_width optional, controls plot width.
#' @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.
#'
#' @export
#'
#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
#' @author Balazs Toth (tothb2)  toth.balazs@gene.com
#'
#' @examples
#' # Example using ADaM structure analysis dataset.
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   library(stringr)
#'
#'   # use non-exported function from goshawk
#'   .h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
#'
#'   # 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)
#'
#'   set.seed(1) # @linksto ADSL ADLB
#'   ADSL <- rADSL
#'   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("[^0-9]*", "", 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 <- .h_identify_loq_values(ADLB, "LOQFL")
#'   ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
#' })
#'
#' join_keys(data) <- default_cdisc_join_keys[names(data)]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_gh_correlationplot(
#'       label = "Correlation Plot",
#'       dataname = "ADLB",
#'       param_var = "PARAMCD",
#'       xaxis_param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
#'       yaxis_param = choices_selected(c("ALT", "CRP", "IGA"), "CRP"),
#'       xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "BASE"),
#'       yaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
#'       trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
#'       color_manual = c(
#'         "Drug X 100mg" = "#000000",
#'         "Placebo" = "#3498DB",
#'         "Combination 100mg" = "#E74C3C"
#'       ),
#'       shape_manual = c("N" = 1, "Y" = 2, "NA" = 0),
#'       plot_height = c(500, 200, 2000),
#'       facet_ncol = 2,
#'       visit_facet = TRUE,
#'       reg_line = FALSE,
#'       loq_legend = TRUE,
#'       font_size = c(12, 8, 20),
#'       dot_size = c(1, 1, 12),
#'       reg_text_size = c(3, 3, 10),
#'       hline_arb = c(40, 50),
#'       hline_arb_label = "arb hori label",
#'       hline_arb_color = c("red", "blue"),
#'       hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'       hline_vars_colors = c("green", "blue", "purple", "cyan"),
#'       hline_vars_labels = c("ANRHI Label", "ANRLO Label", "ULOQN Label", "LLOQN Label"),
#'       vline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
#'       vline_vars_colors = c("yellow", "orange", "brown", "gold"),
#'       vline_vars_labels = c("ANRHI Label", "ANRLO Label", "ULOQN Label", "LLOQN Label"),
#'       vline_arb = c(50, 70),
#'       vline_arb_label = "arb vert A",
#'       vline_arb_color = c("green", "orange")
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_g_gh_correlationplot <- function(label,
                                    dataname,
                                    param_var = "PARAMCD",
                                    xaxis_param = "ALT",
                                    xaxis_var = "BASE",
                                    yaxis_param = "CRP",
                                    yaxis_var = "AVAL",
                                    trt_group,
                                    color_manual = NULL,
                                    shape_manual = NULL,
                                    facet_ncol = 2,
                                    visit_facet = TRUE,
                                    trt_facet = FALSE,
                                    reg_line = FALSE,
                                    loq_legend = TRUE,
                                    rotate_xlab = 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,
                                    plot_height = c(500, 200, 2000),
                                    plot_width = NULL,
                                    font_size = c(12, 8, 20),
                                    dot_size = c(1, 1, 12),
                                    reg_text_size = c(3, 3, 10),
                                    pre_output = NULL,
                                    post_output = NULL,
                                    transformators = list()) {
  message("Initializing tm_g_gh_correlationplot")
  checkmate::assert_class(xaxis_param, "choices_selected")
  checkmate::assert_class(yaxis_param, "choices_selected")
  checkmate::assert_class(xaxis_var, "choices_selected")
  checkmate::assert_class(yaxis_var, "choices_selected")
  checkmate::assert_class(trt_group, "choices_selected")
  checkmate::assert_flag(trt_facet)
  validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
  validate_line_arb_arg(vline_arb, vline_arb_color, vline_arb_label)
  validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels)
  validate_line_vars_arg(vline_vars, vline_vars_colors, vline_vars_labels)
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_numeric(font_size, len = 3)
  checkmate::assert_numeric(dot_size, len = 3)
  checkmate::assert_numeric(reg_text_size, len = 3)

  args <- as.list(environment())

  module(
    label = label,
    datanames = dataname,
    server = srv_g_correlationplot,
    server_args = list(
      dataname = dataname,
      param_var = param_var,
      trt_facet = trt_facet,
      color_manual = color_manual,
      shape_manual = shape_manual,
      plot_height = plot_height,
      plot_width = plot_width,
      hline_vars_colors = hline_vars_colors,
      hline_vars_labels = hline_vars_labels,
      vline_vars_colors = vline_vars_colors,
      vline_vars_labels = vline_vars_labels,
      module_args = args
    ),
    ui = ui_g_correlationplot,
    ui_args = args,
    transformators = transformators
  )
}

ui_g_correlationplot <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  teal.widgets::standard_layout(
    output = templ_ui_output_datatable(ns),
    encoding = tags$div(
      ### Reporter
      teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
      tags$br(), tags$br(),
      ###
      templ_ui_dataname(a$dataname),
      uiOutput(ns("axis_selections")),
      templ_ui_constraint(ns, "X-Axis Data Constraint"), # required by constr_anl_q
      if (length(a$hline_vars) > 0) {
        teal.widgets::optionalSelectInput(
          ns("hline_vars"),
          label = "Add Horizontal Range Line(s):",
          choices = a$hline_vars,
          selected = NULL,
          multiple = TRUE
        )
      },
      ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
      if (length(a$vline_vars) > 0) {
        teal.widgets::optionalSelectInput(
          ns("vline_vars"),
          label = "Add Vertical Range Line(s):",
          choices = a$vline_vars,
          selected = NULL,
          multiple = TRUE
        )
      },
      ui_arbitrary_lines(
        id = ns("vline_arb"),
        a$vline_arb,
        a$vline_arb_label,
        a$vline_arb_color,
        title = "Arbitrary Vertical Lines:"
      ),
      bslib::accordion(
        bslib::accordion_panel(
          title = "Plot Aesthetic Settings",
          toggle_slider_ui(
            ns("xrange_scale"),
            label = "X-Axis Range Zoom"
          ),
          toggle_slider_ui(
            ns("yrange_scale"),
            label = "Y-Axis Range Zoom"
          ),
          numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
          checkboxInput(ns("trt_facet"), "Treatment Variable Faceting", a$trt_facet),
          checkboxInput(ns("visit_facet"), "Visit Faceting", a$visit_facet),
          checkboxInput(ns("reg_line"), "Regression Line", a$reg_line),
          checkboxInput(ns("loq_legend"), "Display LoQ Legend", a$loq_legend),
          checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab)
        ),
        bslib::accordion_panel(
          title = "Plot settings",
          teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
          teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE),
          teal.widgets::optionalSliderInputValMinMax(
            ns("reg_text_size"),
            "Regression Annotations Size",
            a$reg_text_size,
            ticks = FALSE
          )
        )
      )
    ),
    forms = tagList(
      teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
    ),
    pre_output = a$pre_output,
    post_output = a$post_output
  )
}

srv_g_correlationplot <- function(id,
                                  data,
                                  reporter,
                                  filter_panel_api,
                                  dataname,
                                  param_var,
                                  trt_group,
                                  trt_facet,
                                  color_manual,
                                  shape_manual,
                                  plot_height,
                                  plot_width,
                                  hline_vars_colors,
                                  hline_vars_labels,
                                  vline_vars_colors,
                                  vline_vars_labels,
                                  module_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
    output$axis_selections <- renderUI({
      env <- shiny::isolate(as.list(data()[[".raw_data"]]))
      resolved_x_param <- teal.transform::resolve_delayed(module_args$xaxis_param, env)
      resolved_x_var <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
      resolved_y_param <- teal.transform::resolve_delayed(module_args$yaxis_param, env)
      resolved_y_var <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
      templ_ui_params_vars(
        session$ns,
        xparam_choices = resolved_x_param$choices,
        xparam_selected = resolved_x_param$selected,
        xchoices = resolved_x_var$choices,
        xselected = resolved_x_var$selected,
        yparam_choices = resolved_y_param$choices,
        yparam_selected = resolved_y_param$selected,
        ychoices = resolved_y_var$choices,
        yselected = resolved_y_var$selected,
        trt_choices = resolved_trt$choices,
        trt_selected = resolved_trt$selected
      )
    })

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()

      iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select an X-Axis biomarker"))
      iv$add_rule("yaxis_param", shinyvalidate::sv_required("Please select a Y-Axis biomarker"))
      iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
      iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
      iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))
      iv$add_rule("facet_ncol", plots_per_row_validate_rules())

      iv$add_validator(anl_constraint_output()$iv_r())
      iv$add_validator(horizontal_line()$iv_r())
      iv$add_validator(vertical_line()$iv_r())
      iv$enable()
      iv
    })



    # filter selected biomarkers
    anl_param <- reactive({
      dataset_var <- dataname
      ANL <- data()[[dataname]] # nolint
      validate_has_data(ANL, 1)

      if (length(input$hline_vars) > 0) {
        validate(
          need(
            all(input$hline_vars %in% names(ANL)),
            "One or more selected horizontal line variable(s) is/are not names to any column in the data"
          ),
          need(
            all(input$vline_vars %in% names(ANL)),
            "One or more selected vertical line variable(s) is/are not names to any column in the data"
          )
        )
      }

      validate_has_variable(ANL, param_var)

      validate_in(
        input$xaxis_param, unique(ANL[[param_var]]),
        sprintf("X-Axis Biomarker %s is not available in data %s", input$xaxis_param, dataname)
      )

      validate_in(
        input$yaxis_param, unique(ANL[[param_var]]),
        sprintf("Y-Axis Biomarker %s is not available in data %s", input$yaxis_param, dataname)
      )

      validate_has_variable(
        ANL,
        "AVISITCD",
        sprintf("Variable AVISITCD is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        "BASE",
        sprintf("Variable BASE is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        "BASE2",
        sprintf("Variable BASE2 is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        "LOQFL",
        sprintf("Variable LOQFL is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        "PARAM",
        sprintf("Variable PARAM is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        "LBSTRESC",
        sprintf("Variable LBSTRESC is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        input$trt_group,
        sprintf("Variable %s is not available in data %s", input$trt_group, dataname)
      )

      validate_has_variable(
        ANL,
        "USUBJID",
        sprintf("Variable USUBJID is not available in data %s", dataname)
      )

      validate_has_variable(
        ANL,
        input$xaxis_var,
        sprintf("Variable %s is not available in data %s", input$xaxis_var, dataname)
      )

      validate_has_variable(
        ANL,
        input$yaxis_var,
        sprintf("Variable %s is not available in data %s", input$yaxis_var, dataname)
      )

      # analysis
      private_qenv <- data() %>%
        teal.code::eval_code(
          code = bquote({
            ANL <- .(as.name(dataset_var)) %>% # nolint
              dplyr::filter(.data[[.(param_var)]] %in% union(.(input$xaxis_param), .(input$yaxis_param))) %>%
              dplyr::select(
                .(c(
                  "USUBJID", input$trt_group, "AVISITCD", param_var, "PARAM", input$xaxis_var, input$yaxis_var, "AVALU",
                  "LOQFL", "LBSTRESC", unique(c(input$hline_vars, input$vline_vars))
                ))
              )
          })
        )
      validate_has_data(private_qenv[["ANL"]], 1)
      return(list(ANL = ANL, qenv = private_qenv))
    })

    # constraints
    observe({
      req(input$xaxis_param)

      constraint_var <- input$constraint_var
      req(constraint_var)

      # note that filtered is false thus we cannot use anl_param()$ANL
      ANL <- data()[[dataname]] # nolint
      validate_has_data(ANL, 1)

      validate_has_variable(ANL, param_var)
      validate_has_variable(ANL, "AVISITCD")
      validate_has_variable(ANL, "BASE")
      validate_has_variable(ANL, "BASE2")

      ANL <- ANL %>% dplyr::filter(.data[[param_var]] == input$xaxis_param) # nolint

      visit_freq <- unique(ANL$AVISITCD)

      # get min max values
      if ((constraint_var == "BASE2" && any(grepl("SCR", visit_freq))) ||
        (constraint_var == "BASE" && any(grepl("BL", visit_freq)))) { # nolint
        val <- stats::na.omit(switch(constraint_var,
          "BASE" = ANL$BASE[ANL$AVISITCD == "BL"],
          "BASE2" = ANL$BASE2[ANL$AVISITCD == "SCR"],
          stop(paste(constraint_var, "not allowed"))
        ))

        if (length(val) == 0 || all(is.na(val))) {
          shinyjs::show("all_na")
          shinyjs::hide("constraint_range")
          args <- list(
            min = list(label = "Min", min = 0, max = 0, value = 0),
            max = list(label = "Max", min = 0, max = 0, value = 0)
          )
          update_min_max(session, args)
        } else {
          rng <- range(val, na.rm = TRUE)

          minmax <- c(floor(rng[1] * 1000) / 1000, ceiling(rng[2] * 1000) / 1000)

          label_min <- sprintf("Min (%s)", minmax[1])
          label_max <- sprintf("Max (%s)", minmax[2])

          args <- list(
            min = list(label = label_min, min = minmax[1], max = minmax[2], value = minmax[1]),
            max = list(label = label_max, min = minmax[1], max = minmax[2], value = minmax[2])
          )

          update_min_max(session, args)
          shinyjs::show("constraint_range") # update before show
          shinyjs::hide("all_na")
        }
      } else if (constraint_var == "NONE") {
        shinyjs::hide("constraint_range") # hide before update
        shinyjs::hide("all_na")

        # force update (and thus refresh) on different constraint_var -> pass unique value for each constraint_var name
        args <- list(
          min = list(label = "Min", min = 0, max = 0, value = 0),
          max = list(label = "Max", min = 0, max = 0, value = 0)
        )

        update_min_max(session, args)
      } else {
        stop("invalid contraint_var", constraint_var)
      }
    })

    anl_constraint_output <- create_anl_constraint_reactive(anl_param, input, param_id = "xaxis_param", min_rows = 1)
    anl_constraint <- anl_constraint_output()$value

    # update sliders for axes taking constraints into account
    data_state_x <- reactive({
      get_data_range_states(
        varname = input$xaxis_var,
        paramname = input$xaxis_param,
        ANL = anl_constraint()$ANL
      )
    })
    xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
    data_state_y <- reactive({
      get_data_range_states(
        varname = input$yaxis_var,
        paramname = input$yaxis_param,
        ANL = anl_constraint()$ANL
      )
    })
    yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)

    keep_data_const_opts_updated(session, input, anl_constraint, "xaxis_param")

    # selector names after transposition
    xvar <- reactive(paste0(input$xaxis_var, "_", input$xaxis_param))
    yvar <- reactive(paste0(input$yaxis_var, "_", input$yaxis_param))
    xloqfl <- reactive(paste0("LOQFL_", input$xaxis_param))
    yloqfl <- reactive(paste0("LOQFL_", input$yaxis_param))

    # transpose data to plot
    plot_data_transpose <- reactive({
      teal::validate_inputs(iv_r())

      req(anl_constraint())
      ANL <- anl_constraint()$ANL # nolint
      trt_group <- input$trt_group

      qenv <- anl_constraint()$qenv %>% teal.code::eval_code(
        code = bquote({
          ANL_x <- ANL %>% # nolint
            dplyr::filter(.data[[.(param_var)]] == .(input$xaxis_param) & !is.na(.data[[.(input$xaxis_var)]]))
        })
      )

      if (input$xaxis_var == "BASE") {
        qenv <- qenv %>% within({
          ANL_x <- ANL_x %>% # nolint
            dplyr::group_by(.data[["USUBJID"]]) %>%
            dplyr::mutate(LOQFL = .data[["LOQFL"]][.data[["AVISITCD"]] == "BL"]) %>%
            dplyr::ungroup()
        })
      } else if (input$xaxis_var != "AVAL") {
        qenv <- qenv %>% within({
          ANL_x <- ANL_x %>% # nolint
            dplyr::mutate(LOQFL = "N")
        })
      }

      qenv <- qenv %>% teal.code::eval_code(
        code = bquote({
          ANL_y <- ANL %>% # nolint
            dplyr::filter(.data[[.(param_var)]] == .(input$yaxis_param) & !is.na(.data[[.(input$yaxis_var)]]))
        })
      )

      if (input$yaxis_var == "BASE") {
        qenv <- qenv %>% within({
          ANL_y <- ANL_y %>% # nolint
            dplyr::group_by(.data[["USUBJID"]]) %>%
            dplyr::mutate(LOQFL = .data[["LOQFL"]][.data[["AVISITCD"]] == "BL"]) %>%
            dplyr::ungroup()
        })
      } else if (input$yaxis_var != "AVAL") {
        qenv <- qenv %>% within({
          ANL_y <- ANL_y %>% # nolint
            dplyr::mutate(LOQFL = "N")
        })
      }

      qenv <- qenv %>% teal.code::eval_code(
        code = bquote({
          ANL_TRANSPOSED <- dplyr::inner_join( # nolint
            ANL_x, ANL_y,
            by = c("USUBJID", "AVISITCD", .(trt_group)),
            suffix = .(sprintf("_%s", c(input$xaxis_param, input$yaxis_param)))
          )
          ANL_TRANSPOSED <- ANL_TRANSPOSED %>% # nolint
            dplyr::mutate(
              LOQFL_COMB = case_when(
                .data[[.(xloqfl())]] == "Y" | .data[[.(yloqfl())]] == "Y" ~ "Y",
                .data[[.(xloqfl())]] == "N" | .data[[.(yloqfl())]] == "N" ~ "N",
                TRUE ~ "NA"
              )
            )
        })
      )

      validate(need(nrow(qenv[["ANL_TRANSPOSED"]]) > 0, "Plot Data No Observations Left"))
      validate_has_variable(data = qenv[["ANL_TRANSPOSED"]], varname = c(xvar(), yvar(), xloqfl(), yloqfl()))

      qenv <- teal.code::eval_code(
        object = qenv,
        code =
          bquote(attr(ANL_TRANSPOSED[[.(trt_group)]], "label") <- attr(ANL[[.(trt_group)]], "label")) # nolint
      )
      return(list(ANL_TRANSPOSED = qenv[["ANL_TRANSPOSED"]], qenv = qenv))
    })

    plot_labels <- reactive({
      req(anl_constraint())
      ANL <- anl_constraint()$qenv[["ANL"]] # nolint

      xparam <- ANL$PARAM[ANL[[param_var]] == input$xaxis_param][1]
      yparam <- ANL$PARAM[ANL[[param_var]] == input$yaxis_param][1]

      # setup the x-axis label.  Combine the biomarker and the units (if available)
      if (is.null(ANL$AVALU) || all(ANL[["AVALU"]] == "")) {
        title_text <- paste(xparam, "and", yparam, "@ Visits")
        xaxis_lab <- paste(xparam, input$xaxis_var, "Values")
        yaxis_lab <- paste(yparam, input$yaxis_var, "Values")
      } else {
        xunit <- ANL$AVALU[ANL[[param_var]] == input$xaxis_param][1]
        yunit <- ANL$AVALU[ANL[[param_var]] == input$yaxis_param][1]

        title_text <- paste0(xparam, " (", xunit, ") and ", yparam, " (", yunit, ") @ Visits")
        xaxis_lab <- paste0(xparam, " (", xunit, ") ", input$xaxis_var, " Values")
        yaxis_lab <- paste0(yparam, " (", yunit, ") ", input$yaxis_var, " Values")
      }

      list(title_text = title_text, xaxis_lab = xaxis_lab, yaxis_lab = yaxis_lab)
    })

    horizontal_line <- srv_arbitrary_lines("hline_arb")
    vertical_line <- srv_arbitrary_lines("vline_arb")

    # plot
    plot_q <- debounce(reactive({
      req(plot_data_transpose())
      # nolint start
      xaxis_param <- input$xaxis_param
      xaxis_var <- input$xaxis_var
      yaxis_param <- input$yaxis_param
      yaxis_var <- input$yaxis_var
      xlim <- xrange_slider$value
      ylim <- yrange_slider$value
      font_size <- input$font_size
      dot_size <- input$dot_size
      reg_text_size <- input$reg_text_size
      hline_arb <- horizontal_line()$line_arb
      hline_arb_label <- horizontal_line()$line_arb_label
      hline_arb_color <- horizontal_line()$line_arb_color
      hline_vars <- if (length(input$hline_vars) == 0) {
        NULL
      } else {
        paste0(input$hline_vars, "_", yaxis_param)
      }
      vline_arb <- vertical_line()$line_arb
      vline_arb_label <- vertical_line()$line_arb_label
      vline_arb_color <- vertical_line()$line_arb_color
      vline_vars <- if (length(input$vline_vars) == 0) {
        NULL
      } else {
        paste0(input$vline_vars, "_", xaxis_param)
      }
      facet_ncol <- input$facet_ncol
      validate(need(
        is.na(facet_ncol) || (as.numeric(facet_ncol) > 0 && as.numeric(facet_ncol) %% 1 == 0),
        "Number of plots per row must be a positive integer"
      ))
      visit_facet <- input$visit_facet
      facet <- input$trt_facet
      reg_line <- input$reg_line
      loq_legend <- input$loq_legend
      rotate_xlab <- input$rotate_xlab
      # nolint end
      title_text <- plot_labels()$title_text
      xaxis_lab <- plot_labels()$xaxis_lab
      yaxis_lab <- plot_labels()$yaxis_lab
      validate(need(input$trt_group, "Please select a treatment variable"))
      trt_group <- input$trt_group

      teal.code::eval_code(
        object = plot_data_transpose()$qenv,
        code = bquote({
          # re-establish treatment variable label
          p <- goshawk::g_correlationplot(
            data = ANL_TRANSPOSED,
            param_var = .(param_var),
            xaxis_param = .(xaxis_param),
            xaxis_var = .(xaxis_var),
            xvar = .(xvar()),
            yaxis_param = .(yaxis_param),
            yaxis_var = .(yaxis_var),
            yvar = .(yvar()),
            trt_group = .(trt_group),
            xlim = .(xlim),
            ylim = .(ylim),
            title_text = .(title_text),
            xaxis_lab = .(xaxis_lab),
            yaxis_lab = .(yaxis_lab),
            color_manual = .(color_manual),
            shape_manual = .(shape_manual),
            facet_ncol = .(facet_ncol),
            visit_facet = .(visit_facet),
            facet = .(facet),
            facet_var = .(trt_group),
            reg_line = .(reg_line),
            font_size = .(font_size),
            dot_size = .(dot_size),
            reg_text_size = .(reg_text_size),
            loq_legend = .(loq_legend),
            rotate_xlab = .(rotate_xlab),
            hline_arb = .(hline_arb),
            hline_arb_label = .(hline_arb_label),
            hline_arb_color = .(hline_arb_color),
            hline_vars = .(hline_vars),
            hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
            hline_vars_labels = .(paste(hline_vars_labels[seq_along(hline_vars)], "-", yaxis_param)),
            vline_arb = .(vline_arb),
            vline_arb_label = .(vline_arb_label),
            vline_arb_color = .(vline_arb_color),
            vline_vars = .(vline_vars),
            vline_vars_colors = .(vline_vars_colors[seq_along(vline_vars)]),
            vline_vars_labels = .(paste(vline_vars_labels[seq_along(vline_vars)], "-", xaxis_param))
          )
          p
        })
      )
    }), 800)

    plot_r <- reactive(plot_q()[["p"]])

    plot_data <- teal.widgets::plot_with_settings_srv(
      id = "plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
      brushing = TRUE
    )

    code <- reactive(teal.code::get_code(plot_q()))

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        constraint_description <- paste(
          "\nTreatment Variable Faceting:",
          input$trt_facet,
          "\nRegression Line:",
          input$reg_line
        )
        card <- report_card_template_goshawk(
          title = "Correlation Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api,
          constraint_list = list(
            constraint_var = input$constraint_var,
            constraint_range_min = input$constraint_range_min,
            constraint_range_max = input$constraint_range_max
          ),
          constraint_description = constraint_description,
          style = "verbatim"
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = plot_data$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(code())
        card
      }
      teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###

    reactive_df <- debounce(reactive({
      req(iv_r()$is_valid())
      plot_brush <- plot_data$brush()

      ANL_TRANSPOSED <- isolate(plot_data_transpose()$ANL_TRANSPOSED) # nolint

      df <- teal.widgets::clean_brushedPoints(
        dplyr::select(
          ANL_TRANSPOSED, "USUBJID", dplyr::all_of(input$trt_group), "AVISITCD",
          dplyr::all_of(c(xvar(), yvar())), "LOQFL_COMB"
        ),
        plot_brush
      )
    }), 800)

    # highlight plot area
    output$brush_data <- DT::renderDataTable({
      numeric_cols <- names(dplyr::select_if(reactive_df(), is.numeric))

      DT::datatable(reactive_df(),
        rownames = FALSE, options = list(scrollX = TRUE)
      ) %>%
        DT::formatRound(numeric_cols, 4)
    })

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(code()),
      title = "Show R Code for Correlation Plot"
    )
  })
}

#' Line plot
#'
#' This teal module renders the UI and calls the function that creates a line plot.
#'
#' @inheritParams teal.widgets::standard_layout
#' @inheritParams teal::module
#' @param label menu item label of the module in the teal app.
#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
#' laboratory data frame `ADLB`.
#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
#' @param param biomarker selected.
#' @param param_var_label single name of variable in analysis data that includes parameter labels.
#' @param xaxis_var single name of variable in analysis data that is used as x-axis in the plot for the
#' respective `goshawk` function.
#' @param xvar_level vector that can be used to define the factor level of `xvar`. Only use it when
#' `xvar` is character or factor.
#' @param filter_var data constraint variable.
#' @param filter_var_choices data constraint variable choices.
#' @param yaxis_var single name of variable in analysis data that is used as summary variable in the
#' respective `goshawk` function.
#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
#' for variable names representing treatment group e.g. `ARM`.
#' @param trt_group_level vector that can be used to define factor level of `trt_group`.
#' @param shape_choices Vector or \code{choices_selected} object with names of `ADSL` variables which
#' can be used to change shape
#' @param color_manual string vector representing customized colors
#' @param stat string of statistics
#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
#' naming the color for the arbitrary horizontal lines.
#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
#' naming the label for the arbitrary horizontal lines.
#' @param xtick numeric vector to define the tick values of x-axis when x variable is numeric.
#' Default value is waive().
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values.
#' Default value is waive().
#' @param rotate_xlab `logical(1)` value indicating whether to rotate `x-axis` labels.
#' @param plot_height controls plot height.
#' @param plot_width optional, controls plot width.
#' @param plot_font_size control font size for title, `x-axis`, `y-axis` and legend font.
#' @param dodge controls the position dodge of error bar
#' @param count_threshold minimum count of observations (as listed in the output table) to plot
#' nodes on the graph
#' @param table_font_size controls the font size of values in the table
#' @param dot_size plot dot size.
#' @param plot_relative_height_value numeric value between 500 and 5000 for controlling the starting value
#' of the relative plot height slider
#' @author Wenyi Liu (luiw2) wenyi.liu@roche.com
#' @author Balazs Toth (tothb2) toth.balazs@gene.com
#'
#' @return \code{shiny} object
#'
#' @export
#'
#' @examplesIf require("nestcolor")
#' # Example using ADaM structure analysis dataset.
#' data <- teal_data()
#' data <- within(data, {
#'   library(dplyr)
#'   library(stringr)
#'   library(nestcolor)
#'
#'   # original ARM value = dose value
#'   .arm_mapping <- list(
#'     "A: Drug X" = "150mg QD",
#'     "B: Placebo" = "Placebo",
#'     "C: Combination" = "Combination"
#'   )
#'   set.seed(1) # @linksto ADSL ADLB
#'   ADSL <- rADSL
#'   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", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
#'         TRUE ~ as.character(NA)
#'       ),
#'       AVISITCDN = case_when(
#'         AVISITCD == "SCR" ~ -2,
#'         AVISITCD == "BL" ~ 0,
#'         grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
#'         TRUE ~ as.numeric(NA)
#'       ),
#'       AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
#'       TRTORD = case_when(
#'         ARMCD == "ARM C" ~ 1,
#'         ARMCD == "ARM B" ~ 2,
#'         ARMCD == "ARM A" ~ 3
#'       ),
#'       ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
#'       ARM = factor(ARM) %>% reorder(TRTORD),
#'       ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
#'       ACTARM = factor(ACTARM) %>% reorder(TRTORD)
#'     )
#'   attr(ADLB[["ARM"]], "label") <- .var_labels[["ARM"]]
#'   attr(ADLB[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
#' })
#'
#' join_keys(data) <- default_cdisc_join_keys[names(data)]
#'
#' app <- init(
#'   data = data,
#'   modules = modules(
#'     tm_g_gh_lineplot(
#'       label = "Line Plot",
#'       dataname = "ADLB",
#'       param_var = "PARAMCD",
#'       param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
#'       shape_choices = c("SEX", "RACE"),
#'       xaxis_var = choices_selected("AVISITCD", "AVISITCD"),
#'       yaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
#'       trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
#'       hline_arb = c(20.5, 19.5),
#'       hline_arb_color = c("red", "green"),
#'       hline_arb_label = c("A", "B")
#'     )
#'   )
#' )
#' if (interactive()) {
#'   shinyApp(app$ui, app$server)
#' }
#'
tm_g_gh_lineplot <- function(label,
                             dataname,
                             param_var,
                             param,
                             param_var_label = "PARAM",
                             xaxis_var,
                             yaxis_var,
                             xvar_level = NULL,
                             filter_var = yaxis_var,
                             filter_var_choices = filter_var,
                             trt_group,
                             trt_group_level = NULL,
                             shape_choices = NULL,
                             stat = "mean",
                             hline_arb = numeric(0),
                             hline_arb_color = "red",
                             hline_arb_label = "Horizontal line",
                             color_manual = c(
                               getOption("ggplot2.discrete.colour"),
                               c("#ff0000", "#008000", "#4ca3dd", "#8a2be2")
                             )[1:4],
                             xtick = ggplot2::waiver(),
                             xlabel = xtick,
                             rotate_xlab = FALSE,
                             plot_height = c(600, 200, 4000),
                             plot_width = NULL,
                             plot_font_size = c(12, 8, 20),
                             dodge = c(0.4, 0, 1),
                             pre_output = NULL,
                             post_output = NULL,
                             count_threshold = 0,
                             table_font_size = c(12, 4, 20),
                             dot_size = c(2, 1, 12),
                             plot_relative_height_value = 1000,
                             transformators = list()) {
  message("Initializing tm_g_gh_lineplot")
  # Validate string inputs
  checkmate::assert_string(label)
  checkmate::assert_string(dataname)
  checkmate::assert_string(param_var)
  checkmate::assert_string(param_var_label)
  checkmate::assert_string(stat)

  # Validate choices_selected class inputs
  checkmate::assert_class(param, "choices_selected")
  checkmate::assert_class(xaxis_var, "choices_selected")
  checkmate::assert_class(yaxis_var, "choices_selected")
  checkmate::assert_class(trt_group, "choices_selected")

  # Validate flag inputs
  checkmate::assert_flag(rotate_xlab)

  # Validate numeric vector inputs
  checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
  checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
  checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(
    plot_width[1],
    lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
  )
  checkmate::assert_numeric(table_font_size, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
  checkmate::assert_numeric(dot_size, len = 3)
  checkmate::assert_numeric(
    table_font_size[1],
    lower = table_font_size[2], upper = table_font_size[3],
    null.ok = TRUE, .var.name = "table_font_size"
  )
  checkmate::assert_number(plot_relative_height_value, lower = 500, upper = 5000)
  checkmate::assert_number(count_threshold)

  # Validate color manual if provided
  checkmate::assert_character(color_manual, null.ok = TRUE)
  checkmate::assert_character(hline_arb_color)
  checkmate::assert_character(hline_arb_label)

  # Validate line arguments
  validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)

  args <- as.list(environment())

  module(
    label = label,
    server = srv_lineplot,
    server_args = list(
      dataname = dataname,
      param_var = param_var,
      color_manual = color_manual,
      xvar_level = xvar_level,
      trt_group_level = trt_group_level,
      shape_choices = shape_choices,
      param_var_label = param_var_label,
      xtick = xtick,
      xlabel = xlabel,
      plot_height = plot_height,
      plot_width = plot_width,
      module_args = args
    ),
    ui = ui_lineplot,
    ui_args = args,
    transformators = transformators,
    datanames = dataname
  )
}

ui_lineplot <- function(id, ...) {
  ns <- NS(id)
  a <- list(...)

  shiny::tagList(
    teal.widgets::standard_layout(
      output = teal.widgets::plot_with_settings_ui(id = ns("plot")),
      encoding = tags$div(
        ### Reporter
        teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
        tags$br(), tags$br(),
        ###
        templ_ui_dataname(a$dataname),
        uiOutput(ns("axis_selections")),
        uiOutput(ns("shape_ui")),
        radioButtons(ns("stat"), "Select a Statistic:", c("mean", "median"), a$stat),
        checkboxInput(ns("include_stat"), "Include Statistic Table", value = TRUE),
        tags$div(
          sliderInput(
            ns("relative_height"),
            tags$div(
              "Relative height of plot to table(s)",
              bslib::tooltip(
                trigger = icon("circle-info"),
                tags$span(
                  paste(
                    "The larger the value selected the greater the size of the plot relative\nto",
                    "the size of the tables. Note the units of this slider are arbitrary.\nTo",
                    "change the total size of the plot and table(s)\nuse",
                    "the plot resizing controls available at the top right of the plot."
                  )
                )
              )
            ),
            min = 500,
            max = 5000,
            step = 50,
            value = a$plot_relative_height_value,
            ticks = FALSE
          ),
        ),
        templ_ui_constraint(ns), # required by constr_anl_q
        ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
        bslib::accordion(
          bslib::accordion_panel(
            title = "Plot Aesthetic Settings",
            toggle_slider_ui(
              ns("yrange_scale"),
              label = "Y-Axis Range Zoom"
            ),
            checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab),
            numericInput(ns("count_threshold"), "Contributing Observations Threshold:", a$count_threshold)
          ),
          bslib::accordion_panel(
            title = "Plot settings",
            teal.widgets::optionalSliderInputValMinMax(ns("dodge"), "Error Bar Position Dodge", a$dodge, ticks = FALSE),
            bslib::accordion(
              bslib::accordion_panel(
                title = "Line Settings",
                uiOutput(ns("lines"))
              ),
              bslib::accordion_panel(
                title = "Symbol settings",
                uiOutput(ns("symbols"))
              )
            ),
            teal.widgets::optionalSliderInputValMinMax(
              ns("plot_font_size"),
              "Font Size",
              a$plot_font_size,
              ticks = FALSE
            ),
            teal.widgets::optionalSliderInputValMinMax(
              ns("dot_size"),
              "Dot Size",
              a$dot_size,
              ticks = FALSE
            )
          ),
          bslib::accordion_panel(
            title = "Table settings",
            teal.widgets::optionalSliderInputValMinMax(
              ns("table_font_size"),
              "Table Font Size",
              a$table_font_size,
              ticks = FALSE
            )
          )
        )
      ),
      forms = tagList(
        teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
      ),
      pre_output = a$pre_output,
      post_output = a$post_output
    )
  )
}

srv_lineplot <- function(id,
                         data,
                         reporter,
                         filter_panel_api,
                         dataname,
                         param_var,
                         trt_group,
                         color_manual,
                         xvar_level,
                         trt_group_level,
                         shape_choices,
                         param_var_label,
                         xtick,
                         xlabel,
                         plot_height,
                         plot_width,
                         module_args) {
  with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
  with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
  checkmate::assert_class(data, "reactive")
  checkmate::assert_class(shiny::isolate(data()), "teal_data")

  moduleServer(id, function(input, output, session) {
    teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
    ns <- session$ns

    output$axis_selections <- renderUI({
      env <- shiny::isolate(as.list(data()[[".raw_data"]]))
      resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
      resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
      resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
      resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
      templ_ui_params_vars(
        ns,
        # xparam and yparam are identical, so we only show the user one
        xparam_choices = resolved_param$choices,
        xparam_selected = resolved_param$selected,
        xparam_label = "Select a Biomarker",
        xchoices = resolved_x$choices,
        xselected = resolved_x$selected,
        ychoices = resolved_y$choices,
        yselected = resolved_y$selected,
        trt_choices = resolved_trt$choices,
        trt_selected = resolved_trt$selected
      )
    })

    output$shape_ui <- renderUI({
      if (!is.null(shape_choices)) {
        if (methods::is(shape_choices, "choices_selected")) {
          choices <- get_choices(shape_choices$choices)
          selected <- shape_choices$selected
        } else {
          choices <- shape_choices
          selected <- NULL
        }
        teal.widgets::optionalSelectInput(
          ns("shape"),
          "Select Line Splitting Variable",
          choices = choices, selected = selected
        )
      }
    })

    anl_q_output <- constr_anl_q(
      session = session,
      input = input,
      data = data,
      dataname = dataname,
      param_id = "xaxis_param",
      param_var = param_var,
      trt_group = input$trt_group,
      min_rows = 2
    )

    anl_q <- anl_q_output()$value

    keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")

    horizontal_line <- srv_arbitrary_lines("hline_arb")

    iv_r <- reactive({
      iv <- shinyvalidate::InputValidator$new()
      iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
      iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
      iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
      iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))

      iv$add_validator(horizontal_line()$iv_r())
      iv$add_validator(anl_q_output()$iv_r())
      iv$enable()
      iv
    })


    # update sliders for axes
    data_state <- reactive({
      varname <- input[["yaxis_var"]]
      validate(need(varname, "Please select variable"))

      ANL <- anl_q()$ANL # nolint
      validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))

      shape <- if (!(is.null(input$shape) || input$shape == "None")) {
        input$shape
      } else {
        NULL
      }

      # we don't need to additionally filter for paramvar here as in get_data_range_states because
      # xaxis_var and yaxis_var are always distinct
      sum_data <- ANL %>%
        dplyr::group_by_at(c(input$xaxis_var, input$trt_group, shape)) %>%
        dplyr::summarise(
          upper = if (input$stat == "mean") {
            mean(!!sym(varname), na.rm = TRUE) +
              1.96 * stats::sd(!!sym(varname), na.rm = TRUE) / sqrt(dplyr::n())
          } else {
            stats::quantile(!!sym(varname), 0.75, na.rm = TRUE)
          },
          lower = if (input$stat == "mean") {
            mean(!!sym(varname), na.rm = TRUE) -
              1.96 * stats::sd(!!sym(varname), na.rm = TRUE) / sqrt(dplyr::n())
          } else {
            stats::quantile(!!sym(varname), 0.25, na.rm = TRUE)
          }
        )

      minmax <- grDevices::extendrange(
        r = c(
          floor(min(sum_data$lower, na.rm = TRUE) * 10) / 10,
          ceiling(max(sum_data$upper, na.rm = TRUE) * 10) / 10
        ),
        f = 0.05
      )

      # we don't use get_data_range_states because this module computes the data ranges
      # not from the constrained ANL, but rather by first grouping and computing confidence
      # intervals
      list(
        range = c(min = minmax[[1]], max = minmax[[2]])
      )
    })
    yrange_slider <- toggle_slider_server("yrange_scale", data_state)

    line_color_defaults <- color_manual
    line_type_defaults <- c(
      "blank",
      "solid",
      "dashed",
      "dotted",
      "dotdash",
      "longdash",
      "twodash",
      "1F",
      "F1",
      "4C88C488",
      "12345678"
    )

    line_color_selected <- reactive({
      req(input$trt_group)
      anl_arm <- as.factor(isolate(anl_q())$ANL[[input$trt_group]])
      anl_arm_nlevels <- nlevels(anl_arm)
      anl_arm_levels <- levels(anl_arm)

      stats::setNames(
        vapply(
          seq_len(anl_arm_nlevels),
          function(idx) {
            x <- input[[paste0("line_color_", idx)]]
            anl_arm_level <- anl_arm_levels[[idx]]
            if (length(x)) {
              x
            } else if (anl_arm_level %in% names(line_color_defaults)) {
              line_color_defaults[[anl_arm_level]]
            } else if (idx <= length(line_color_defaults)) {
              line_color_defaults[[idx]]
            } else {
              "#000000"
            }
          },
          character(1)
        ),
        anl_arm_levels
      )
    })
    line_type_selected <- reactive({
      req(input$trt_group)
      anl_arm <- as.factor(isolate(anl_q())$ANL[[input$trt_group]])
      anl_arm_nlevels <- nlevels(anl_arm)
      anl_arm_levels <- levels(anl_arm)

      stats::setNames(
        vapply(
          seq_len(anl_arm_nlevels),
          function(idx) {
            x <- input[[paste0("line_type_", idx)]]
            if (is.null(x)) "solid" else x
          },
          character(1)
        ),
        anl_arm_levels
      )
    })

    output$lines <- renderUI({
      req(input$trt_group)
      anl_arm <- as.factor(anl_q()$ANL[[input$trt_group]])
      anl_arm_nlevels <- nlevels(anl_arm)
      anl_arm_levels <- levels(anl_arm)

      tagList(
        lapply(
          seq_len(anl_arm_nlevels),
          function(idx) {
            x <- anl_arm_levels[[idx]]
            color_input <- colourpicker::colourInput(
              ns(paste0("line_color_", idx)),
              "Color:",
              isolate(line_color_selected()[[idx]])
            )
            type_input <- selectInput(
              ns(paste0("line_type_", idx)),
              "Type:",
              choices = line_type_defaults,
              selected = isolate(line_type_selected()[[idx]])
            )
            tags$div(
              tags$label("Line configuration for:", tags$code(x)),
              tags$div(
                color_input,
                type_input
              )
            )
          }
        )
      )
    })

    symbol_type_start <- c(
      "circle",
      "square",
      "diamond",
      "triangle",
      "circle open",
      "square open",
      "diamond open",
      "triangle open",
      "triangle down open",
      "circle cross",
      "square cross",
      "circle plus",
      "square plus",
      "diamond plus",
      "square triangle",
      "plus",
      "cross",
      "asterisk"
    )
    symbol_type_defaults <- reactiveVal(symbol_type_start)

    # reset shapes when different splitting variable is selected
    observeEvent(
      eventExpr = input$shape,
      handlerExpr = symbol_type_defaults(symbol_type_start),
      ignoreNULL = TRUE
    )

    observe({
      req(input$shape)
      req(anl_q())
      anl_shape <- anl_q()$ANL[[input$shape]]
      anl_shape_nlevels <- nlevels(anl_shape)
      symbol_type_to_set <- symbol_type_defaults()[pmin(length(symbol_type_defaults()), seq_len(anl_shape_nlevels))]
      symbol_type_defaults(symbol_type_to_set)
    })

    symbol_type_selected <- reactive({
      req(anl_q())
      if (is.null(input$shape)) {
        return(NULL)
      }
      anl_shape <- isolate(anl_q()$ANL[[input$shape]])
      anl_shape_nlevels <- nlevels(anl_shape)
      anl_shape_levels <- levels(anl_shape)

      stats::setNames(
        vapply(
          seq_len(anl_shape_nlevels),
          function(idx) {
            x <- input[[paste0("symbol_type_", idx)]]
            if (is.null(x)) isolate(symbol_type_defaults())[[idx]] else x
          },
          character(1)
        ),
        anl_shape_levels
      )
    })

    output$symbols <- renderUI({
      req(symbol_type_defaults())
      validate(need(input$shape, "Please select line splitting variable first."))

      anl_shape <- isolate(anl_q()$ANL[[input$shape]])
      validate(need(is.factor(anl_shape), "Line splitting variable must be a factor."))

      anl_shape_nlevels <- nlevels(anl_shape)
      anl_shape_levels <- levels(anl_shape)
      symbol_def <- symbol_type_defaults()

      tagList(
        lapply(
          seq_len(anl_shape_nlevels),
          function(idx) {
            x <- anl_shape_levels[[idx]]
            x_color <- symbol_def[[idx]]
            selectInput(
              ns(paste0("symbol_type_", idx)),
              HTML(paste0("Symbol for: ", tags$code(x))),
              choices = symbol_type_start,
              selected = x_color
            )
          }
        )
      )
    })

    plot_q <- debounce(reactive({
      teal::validate_inputs(iv_r())
      req(anl_q(), line_color_selected(), line_type_selected())
      # nolint start
      ylim <- yrange_slider$value
      plot_font_size <- input$plot_font_size
      dot_size <- input$dot_size
      dodge <- input$dodge
      rotate_xlab <- input$rotate_xlab
      count_threshold <- `if`(is.na(as.numeric(input$count_threshold)), 0, as.numeric(input$count_threshold))
      table_font_size <- input$table_font_size

      median <- ifelse(input$stat == "median", TRUE, FALSE)
      relative_height <- input$relative_height
      trt_group <- input$trt_group
      color_selected <- line_color_selected()
      type_selected <- line_type_selected()
      symbol_selected <- symbol_type_selected()
      include_stat <- input$include_stat

      param <- input$xaxis_param
      xaxis <- input$xaxis_var
      yaxis <- input$yaxis_var
      # nolint end

      shape <- if (!(is.null(input$shape) || input$shape == "None")) {
        input$shape
      } else {
        NULL
      }

      validate(
        need(
          nrow(anl_q()$ANL[stats::complete.cases(anl_q()$ANL[, c(yaxis, xaxis)]), ]) >= 2,
          "Number of complete rows on x and y axis variables is less than 2"
        )
      )

      private_qenv <- anl_q()$qenv

      if (!methods::is(xtick, "waiver") && !is.null(xtick)) {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = bquote({
            keep_index <- which(.(xtick) %in% ANL[[.(xaxis)]])
            xtick <- (.(xtick))[keep_index] # extra parentheses needed for edge case, e.g. 1:5[keep_index]
            xlabel <- (.(xlabel))[keep_index]
          })
        )
      } else if (methods::is(xtick, "waiver")) {
        private_qenv <- teal.code::eval_code(
          object = private_qenv,
          code = "
            xtick <- ggplot2::waiver()
            xlabel <- ggplot2::waiver()
          "
        )
      }

      hline_arb <- horizontal_line()$line_arb
      hline_arb_label <- horizontal_line()$line_arb_label
      hline_arb_color <- horizontal_line()$line_arb_color

      teal.code::eval_code(
        object = private_qenv,
        code = bquote({
          p <- goshawk::g_lineplot(
            data = ANL[stats::complete.cases(ANL[, c(.(yaxis), .(xaxis))]), ],
            biomarker_var = .(param_var),
            biomarker_var_label = .(param_var_label),
            biomarker = .(param),
            value_var = .(yaxis),
            ylim = .(ylim),
            trt_group = .(trt_group),
            trt_group_level = .(trt_group_level),
            shape = .(shape),
            shape_type = .(symbol_selected),
            time = .(xaxis),
            time_level = .(xvar_level),
            color_manual = .(color_selected),
            line_type = .(type_selected),
            median = .(median),
            hline_arb = .(hline_arb),
            hline_arb_label = .(hline_arb_label),
            hline_arb_color = .(hline_arb_color),
            xtick = .(if (!is.null(xtick)) quote(xtick) else xtick),
            xlabel = .(if (!is.null(xtick)) quote(xlabel) else xlabel),
            rotate_xlab = .(rotate_xlab),
            plot_height = .(relative_height), # in g_lineplot this is relative height of plot to table
            plot_font_size = .(plot_font_size),
            dot_size = .(dot_size),
            dodge = .(dodge),
            count_threshold = .(count_threshold),
            table_font_size = .(table_font_size),
            display_center_tbl = .(include_stat)
          )
          p
        })
      )
    }), 800)

    plot_r <- reactive(plot_q()[["p"]])

    plot_data <- teal.widgets::plot_with_settings_srv(
      id = "plot",
      plot_r = plot_r,
      height = plot_height,
      width = plot_width,
    )

    code <- reactive(teal.code::get_code(plot_q()))

    ### REPORTER
    if (with_reporter) {
      card_fun <- function(comment, label) {
        constraint_description <- paste(
          "\nSelect Line Splitting Variable:",
          if (!is.null(input$shape)) input$shape else "None",
          "\nContributing Observations Threshold:",
          input$count_threshold
        )
        card <- report_card_template_goshawk(
          title = "Line Plot",
          label = label,
          with_filter = with_filter,
          filter_panel_api = filter_panel_api,
          constraint_list = list(
            constraint_var = input$constraint_var,
            constraint_range_min = input$constraint_range_min,
            constraint_range_max = input$constraint_range_max
          ),
          constraint_description = constraint_description,
          style = "verbatim"
        )
        card$append_text("Plot", "header3")
        card$append_plot(plot_r(), dim = plot_data$dim())
        if (!comment == "") {
          card$append_text("Comment", "header3")
          card$append_text(comment)
        }
        card$append_src(code())
        card
      }
      teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
    }
    ###

    teal.widgets::verbatim_popup_srv(
      id = "rcode",
      verbatim_content = reactive(code()),
      title = "Show R Code for Line Plot"
    )
  })
}

templ_ui_output_datatable <- function(ns) {
  bslib::page_fluid(
    teal.widgets::plot_with_settings_ui(id = ns("plot")),
    tags$br(), tags$hr(),
    tags$h4("Selected Data Points"),
    tags$div(
      DT::dataTableOutput(ns("brush_data"))
    )
  )
}

templ_ui_dataname <- function(dataname) {
  tags$label(dataname, "Data Settings", class = "text-primary")
}

# UI to create params (biomarker, value of PARAMCD) and vars (column, e.g. AVAL column) select fields for x and y
templ_ui_params_vars <- function(ns,
                                 # x
                                 xparam_choices = NULL,
                                 xparam_selected = NULL,
                                 xparam_label = NULL, # biomarker, e.g. ALT
                                 xchoices = NULL,
                                 xselected = NULL,
                                 xvar_label = NULL, # variable, e.g. AVAL
                                 # y
                                 yparam_choices = NULL,
                                 yparam_selected = NULL,
                                 yparam_label = NULL, # biomarker, e.g. ALT
                                 ychoices = NULL,
                                 yselected = NULL,
                                 yvar_label = NULL, # variable, e.g. AVAL
                                 # facet_var
                                 facet_choices = NULL,
                                 facet_selected = NULL,
                                 # trt_group
                                 trt_choices = NULL,
                                 trt_selected = NULL,
                                 multiple = FALSE) {
  if (is.null(xparam_choices) && !is.null(xchoices) && !is.null(yparam_choices)) {
    # otherwise, xchoices will appear first without any biomarker to select and this looks odd in the UI
    stop(
      "You have to specify xparam choices rather than yparamchoices
      if both xvar and yvar should be values for the same biomarker."
    )
  }
  tagList(
    if (!is.null(trt_choices)) {
      teal.widgets::optionalSelectInput(
        ns("trt_group"),
        label = "Select Treatment Variable",
        choices = trt_choices,
        selected = trt_selected,
        multiple = FALSE
      )
    },
    if (!is.null(xparam_choices)) {
      teal.widgets::optionalSelectInput(
        ns("xaxis_param"),
        `if`(is.null(xparam_label), "Select an X-Axis Biomarker", xparam_label),
        xparam_choices,
        `if`(is.null(xparam_selected), xparam_choices[1], xparam_selected),
        multiple = FALSE
      )
    },
    if (!is.null(xchoices)) {
      teal.widgets::optionalSelectInput(
        ns("xaxis_var"),
        `if`(is.null(xvar_label), "Select an X-Axis Variable", xvar_label),
        xchoices, xselected,
        multiple = multiple
      )
    },
    if (!is.null(yparam_choices)) {
      teal.widgets::optionalSelectInput(
        ns("yaxis_param"),
        `if`(is.null(yparam_label), "Select an Y-Axis Biomarker", yparam_label),
        yparam_choices,
        `if`(is.null(yparam_selected), yparam_choices[1], yparam_selected),
        multiple = FALSE
      )
    },
    if (!is.null(ychoices)) {
      teal.widgets::optionalSelectInput(
        ns("yaxis_var"),
        `if`(is.null(yvar_label), "Select a Y-Axis Variable", yvar_label),
        ychoices, yselected,
        multiple = multiple
      )
    },
    if (!is.null(facet_choices)) {
      teal.widgets::optionalSelectInput(
        ns("facet_var"),
        label = "Facet by",
        choices = facet_choices,
        selected = facet_selected,
        multiple = FALSE
      )
    }
  )
}

#' helper for writing arm mapping and ordering code.
#'
#' Provides lines of code for left hand side of arm mapping. user must provide right hand side
#'
#' @details SPA configure study specific pre-processing for deploying `goshawk`. writing the code for `ARM` mapping and
#' ordering is tedious. this function helps to get that started by providing the left hand side of the
#' mapping and ordering syntax. call the function and then copy and paste the resulting code from the console
#' into the app.R file.
#'
#' @param df_armvar the dataframe and column name containing treatment code. e.g. `ADSL$ARMCD`
#' @param code controls whether mapping or ordering code is written to console. Valid values: `"M"` and `"O"`.
#'
#' @export
#'
#' @examples
#' ADSL <- rADSL
#'
#' # get treatment mapping code
#' maptrt(df_armvar = ADSL$ARMCD, code = "M")
#'
#' # get treatment ordering code
#' maptrt(df_armvar = ADSL$ARMCD, code = "O")
maptrt <- function(df_armvar, code = c("M", "O")) {
  code <- match.arg(code)

  # get arm variable
  trtvar <- strsplit(deparse(substitute(df_armvar)), "[$]")[[1]][2]

  dftrt <- data.frame(unique(df_armvar)) %>%
    dplyr::mutate(trt_mapping = paste0("\"", unique(df_armvar), "\"", " = \"\",")) %>%
    dplyr::mutate(trt_ordering = paste0(eval(trtvar), " == \"", unique(df_armvar), "\"", " ~  ,"))

  if (toupper(code) == "M") {
    print(unname(dftrt["trt_mapping"]), row.names = FALSE)
  } else if (toupper(code) == "O") {
    print(unname(dftrt["trt_ordering"]), row.names = FALSE)
  }
}

plots_per_row_validate_rules <- function(required = TRUE) {
  msg <- "Number of plots per row must be a positive integer"
  shinyvalidate::compose_rules(
    if (required) {
      shinyvalidate::sv_required(msg)
    } else {
      shinyvalidate::sv_optional()
    },
    shinyvalidate::sv_integer(msg),
    shinyvalidate::sv_gt(0, message_fmt = msg)
  )
}

#' Template Function for `TealReportCard` Creation and Customization in `teal.goshawk`
#'
#' This function generates a report card with a title,
#' an optional description, and the option to append the filter state list.
#' Additionally, it display selected constraint options.
#'
#' @inheritParams teal::report_card_template
#' @param constraint_list (`list`) a list containing constraint variables, including:
#'   - constraint_var (`character(1)`) the constraint variable name.
#'   - constraint_range_min (`numeric(1)`) the minimum constraint range value.
#'   - constraint_range_max (`numeric(1)`) the maximum constraint range value.
#' @param constraint_description (`character(1)`)  description of the constraints.
#' @param style (`character(1)`)  style of the constraint text block.
#'   options: `default`, `verbatim` (default is `default`).
#'
#' @return (`TealReportCard`) populated with a title, description, and filter state
#'
#' @keywords internal
report_card_template_goshawk <- function(title,
                                         label,
                                         with_filter,
                                         filter_panel_api,
                                         constraint_list,
                                         constraint_description = NULL,
                                         style = "default") {
  checkmate::assert_subset(names(constraint_list), c("constraint_var", "constraint_range_min", "constraint_range_max"))
  checkmate::assert_string(constraint_description, null.ok = TRUE)
  checkmate::assert_choice(style, c("default", "verbatim"))

  card <- teal::report_card_template(
    title = title,
    label = label,
    with_filter = with_filter,
    filter_panel_api = filter_panel_api
  )

  card$append_text("Selected Options", "header3")
  card$append_text(
    paste(
      formatted_data_constraint(
        constraint_list$constraint_var,
        constraint_list$constraint_range_min,
        constraint_list$constraint_range_max
      ),
      constraint_description
    ),
    style = style
  )
  card
}

#' Get Choices
#'
#' This function returns choices based on the class of the input.
#' If the input is of class `delayed_data`, it returns the `subset` of the input.
#' If `subset` is NULL and the input contains `var_label` and `var_choices`,
#' it throws an error prompting to resolve delayed inputs.
#' Otherwise, it returns the input as is.
#'
#' @param choices An object that contains choices.
#' @return A vector of choices.
#' @keywords internal
get_choices <- function(choices) {
  if (inherits(choices, "delayed_data")) {
    if (is.null(choices$subset)) {
      if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
        stop(
          "Resolve delayed inputs by evaluating the code within the provided datasets.
          Check ?teal.transform::resolve_delayed for more information."
        )
      } else {
        stop("Subset is NULL and necessary fields are missing.")
      }
    } else {
      choices$subset
    }
  } else {
    choices
  }
}

#' Scatter Plot Teal Module For Biomarker Analysis
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `tm_g_gh_scatterplot` is deprecated.
#' Please use [tm_g_gh_correlationplot] instead.
#'
#' @param ... function is deprecated.
#'
#' @export
tm_g_gh_scatterplot <- function(...) {
  lifecycle::deprecate_stop(
    when = "0.1.15",
    what = "tm_g_gh_scatterplot()",
    details = "You should use teal.goshawk::tm_g_gh_correlationplot instead of teal.goshawk::tm_g_gh_scatterplot"
  )
}

1		#' UI with a toggleable dichotomous slider to change between slider and numeric input fields
2		#'
3		#' This is useful when a slider should be shown, but it is sometimes hard to configure sliders,
4		#' so one can toggle to one or two numeric input fields to set slider instead.
5		#' The toggle button will show two numeric input field for selecting the from and to range.
6		#'
7		#' @md
8		#' @param id `character` module id
9		#' @param label `label` label for input field, e.g. slider or numeric inputs
10		#' @param ... additional parameters to pass to `sliderInput`
11		#'
12		#' @name toggle_slider
13		#' @keywords internal
14		#' @return `NULL`.
15		NULL
16
17
18		#' @rdname toggle_slider
19		toggle_slider_ui <- function(id, label) {
20	12x	ns <- NS(id)
21	12x	tags$div(
22	12x	tags$div(
23	12x	style = "display: flex; justify-content: space-between;",
24	12x	tags$span(tags$strong(label)),
25	12x	tags$div(actionButton(ns("toggle"), "Toggle", class = "btn-xs"))
26		),
27	12x	uiOutput(ns("inputs"))
28		)
29		}
30
31		#' @keywords internal
32		#' @rdname toggle_slider
33		toggle_slider_server <- function(id, data_state, ...) {
34	6x	moduleServer(id, function(input, output, session) {
35	6x	state <- reactiveValues(
36	6x	min = NULL,
37	6x	max = NULL,
38	6x	value = NULL
39		)
40	6x	slider_shown <- reactive(input$toggle %% 2 == 0)
41
42	6x	observeEvent(data_state()$range, {
43	7x	state$min <- data_state()$range[1]
44	7x	state$max <- data_state()$range[2]
45	7x	state$value <- data_state()$range
46		})
47
48	6x	output$inputs <- renderUI({
49	28x	req(state$value)
50	22x	if (slider_shown()) {
51	11x	tags$div(
52	11x	class = "teal-goshawk toggle-slider-container",
53	11x	sliderInput(
54	11x	inputId = session$ns("slider"),
55	11x	label = NULL,
56	11x	min = min(data_state()$range[1], state$min),
57	11x	max = max(data_state()$range[2], state$max),
58	11x	value = state$value,
59	11x	step = data_state()$step,
60	11x	ticks = TRUE,
61		...
62		),
63	11x	tags$script(HTML(sprintf(
64		'
65	11x	$(".teal-goshawk.toggle-slider-container #%s").ready(function () {
66	11x	var tickLabel = document.querySelector(
67	11x	".teal-goshawk.toggle-slider-container .irs-grid-text.js-grid-text-9"
68		);
69	11x	var tick = document.querySelector(
70	11x	".teal-goshawk.toggle-slider-container .irs-grid-pol:nth-last-child(6)"
71		);
72	11x	if (tickLabel) {
73	11x	if (parseFloat(tickLabel.style.left) > 95) {
74	11x	tickLabel.style.opacity = "0";
75	11x	tick.style.opacity = "0";
76		}
77		} else {
78	11x	console.log("Toggle slider element not found.");
79		}
80		});
81		',
82	11x	session$ns("slider")
83		)))
84		)
85		} else {
86	11x	tags$div(
87	11x	class = "teal-goshawk toggle-slider-container",
88	11x	numericInput(
89	11x	inputId = session$ns("value_low"),
90	11x	label = "From:",
91	11x	value = state$value[1]
92		),
93	11x	numericInput(
94	11x	inputId = session$ns("value_high"),
95	11x	label = "to:",
96	11x	value = state$value[2]
97		)
98		)
99		}
100		})
101
102	6x	d_slider <- debounce(reactive(input$slider), 500)
103
104	6x	observeEvent(d_slider(), {
105	11x	if (!setequal(state$value, d_slider())) {
106	1x	state$value <- d_slider()
107		}
108		})
109
110	6x	d_value_low <- debounce(reactive(input$value_low), 500)
111	6x	d_value_high <- debounce(reactive(input$value_high), 500)
112
113	6x	observeEvent(c(d_value_low(), d_value_high()), ignoreInit = TRUE, {
114	16x	values <- c(input$value_low, input$value_high)
115	16x	if (!setequal(state$value, values)) {
116	6x	state$value <- values
117	6x	state$min <- values[1]
118	6x	state$max <- values[2]
119		}
120		})
121
122	6x	state
123		})
124		}
125
126		#' @keywords internal
127		#' @rdname toggle_slider
128		get_data_range_states <- function(varname, paramname, ANL, trt_group = NULL, step = NULL) { # nolint object_name_linter
129	13x	validate(need(varname, "Please select variable"))
130	7x	validate(need(paramname, "Please select variable"))
131	7x	req(length(paramname) == 1)
132	7x	step <- NULL
133
134	7x	ANL <- ANL %>% dplyr::filter(.data$PARAMCD == paramname) # nolint object_name_linter
135	7x	validate_has_variable(ANL, varname, paste("variable", varname, "does not exist"))
136
137	7x	var <- stats::na.omit(ANL[[varname]])
138	7x	minmax <- if (length(var)) c(floor(min(var)), ceiling(max(var))) else c(0, 0)
139	7x	if (!is.null(trt_group)) {
140	!	ANL_split <- ANL %>% split(f = factor(paste0(ANL[["AVISITCD"]], ANL[[trt_group]]))) # nolint
141	!	density_maxes <- lapply(ANL_split, function(x) {
142	!	max(stats::density(stats::na.omit(x[[varname]]))$y)
143		})
144	!	dmax <- max(unlist(density_maxes))
145	!	minmax <- c(0, round(dmax * 1.2, 5))
146	!	step <- round(dmax / 100, 5)
147		}
148	7x	list(
149	7x	range = c(min = minmax[[1]], max = minmax[[2]]),
150	7x	step = step
151		)
152		}

1		#' UI module to arbitrary lines
2		#'
3		#' UI module to input either horizontal or vertical lines to a plot via comma separated values
4		#'
5		#' @param id (`character(1)`)\cr
6		#' defining namespace of the `shiny` module.
7		#' @param line_arb (`numeric`)\cr
8		#' default values for the `textInput` defining values of arbitrary lines
9		#' @param line_arb_color (`character`)\cr
10		#' default values for the `textInput` defining colors of arbitrary lines
11		#' @param line_arb_label (`character`)\cr
12		#' default values for the `textInput` defining labels of arbitrary lines
13		#' @param title (`character(1)`)\cr
14		#' title of the arbitrary lines input. The default is "Arbitrary Horizontal Lines".
15		#' @return (`shiny.tag`) an input to define values, colors and labels for arbitrary
16		#' straight lines.
17		#' @keywords internal
18		ui_arbitrary_lines <- function(id, line_arb, line_arb_label, line_arb_color, title = "Arbitrary horizontal lines:") {
19	12x	ns <- NS(id)
20	12x	tags$div(
21	12x	tags$b(
22	12x	title,
23	12x	bslib::tooltip(
24	12x	trigger = icon("circle-info"),
25	12x	tags$span(
26	12x	"For multiple lines, supply a comma separated list of values."
27		)
28		)
29		),
30	12x	textInput(
31	12x	ns("line_arb"),
32	12x	"Value:",
33	12x	value = paste(line_arb, collapse = ", ")
34		),
35	12x	textInput(ns("line_arb_label"), label = "Label:", value = paste(line_arb_label, collapse = ", ")),
36	12x	textInput(ns("line_arb_color"), label = "Color:", value = paste(line_arb_color, collapse = ", "))
37		)
38		}
39		#' Server module to arbitrary lines
40		#'
41		#' Server to validate and transform the comma separated values into vectors of values
42		#' to be passed into goshawk functions.
43		#' @inheritParams shiny::moduleServer
44		#' @return (`reactive`) returning a `list` containing `line_arb`, `line_arb_color`,
45		#' `line_arb_label` which are validated and could be passed to `goshawk` plot functions.
46		#' @keywords internal
47		srv_arbitrary_lines <- function(id) {
48	6x	moduleServer(id, function(input, output, session) {
49	6x	comma_sep_to_values <- function(values, wrapper_fun = trimws) {
50	230x	vals <- strsplit(values, "\\s{0,},\\s{0,}")[[1]]
51	230x	suppressWarnings(wrapper_fun(vals))
52		}
53
54	6x	iv_r <- reactive({
55	6x	iv <- shinyvalidate::InputValidator$new()
56	6x	iv$add_rule("line_arb", shinyvalidate::sv_optional())
57	6x	iv$add_rule(
58	6x	"line_arb",
59	6x	~ if (any(is.na(comma_sep_to_values(., as.numeric)))) {
60	!	"Arbitrary lines values should be a comma separated list of numbers"
61		}
62		)
63
64	6x	iv_color <- shinyvalidate::InputValidator$new()
65	6x	iv_color$condition(~ length(line_arb()) != 0)
66
67	6x	iv_color$add_rule("line_arb_color", shinyvalidate::sv_optional())
68	6x	iv_color$add_rule(
69	6x	"line_arb_color",
70	6x	~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
71	!	sprintf(
72	!	"Line input error: number of colors should be equal to 1, the number of lines (%d) or left blank for 'red'",
73	!	length(line_arb())
74		)
75		}
76		)
77	6x	iv_color$add_rule("line_arb_color", ~ if (!check_color(comma_sep_to_values(.))) {
78	!	"The line colors entered cannot be converted to colors in R, please check your spelling"
79		})
80	6x	iv$add_validator(iv_color)
81
82
83	6x	iv_label <- shinyvalidate::InputValidator$new()
84	6x	iv_label$condition(~ length(line_arb()) != 0)
85
86	6x	iv_label$add_rule("line_arb_label", shinyvalidate::sv_optional())
87	6x	iv_label$add_rule(
88	6x	"line_arb_label",
89	6x	~ if (!length(comma_sep_to_values(.)) %in% c(1, length(line_arb()))) {
90	!	sprintf(
91	!	"Line input error: number of labels should be equal to 1, the number of lines (%d) or left blank",
92	!	length(line_arb())
93		)
94		}
95		)
96	6x	iv$add_validator(iv_label)
97	6x	iv
98		})
99
100	6x	line_arb <- reactive({
101	6x	req(!is.null(input$line_arb))
102	6x	comma_sep_to_values(input$line_arb, as.numeric)
103		})
104
105	6x	line_arb_label <- reactive({
106	6x	if (length(line_arb()) == 0) {
107	!	return(character(0))
108		}
109	6x	val <- comma_sep_to_values(input$line_arb_label)
110	6x	if (length(val) == 0) {
111	!	val <- ""
112		}
113	6x	val
114		})
115
116	6x	line_arb_color <- reactive({
117	6x	if (length(line_arb()) == 0) {
118	!	return(character(0))
119		}
120	6x	val <- comma_sep_to_values(input$line_arb_color)
121	6x	if (length(val) == 0 \|\| all(val == "")) {
122	!	val <- "red"
123		}
124	6x	val
125		})
126
127	6x	reactive(
128	6x	list(
129	6x	iv_r = iv_r,
130	6x	line_arb = line_arb(),
131	6x	line_arb_color = line_arb_color(),
132	6x	line_arb_label = line_arb_label()
133		)
134		)
135		})
136		}
137
138		check_color <- function(col) {
139	53x	tryCatch(
140	53x	is.matrix(grDevices::col2rgb(col)),
141	53x	error = function(e) FALSE
142		)
143		}
144
145		# to check the arbitrary line arguments
146		validate_line_arb_arg <- function(line_arb, line_arb_color, line_arb_label) {
147	6x	checkmate::assert_numeric(line_arb)
148	6x	if (length(line_arb) > 0) {
149	6x	checkmate::assert(
150	6x	checkmate::check_string(line_arb_color),
151	6x	checkmate::check_character(line_arb_color, len = length(line_arb))
152		)
153	6x	checkmate::assert(
154	6x	checkmate::check_string(line_arb_label),
155	6x	checkmate::check_character(line_arb_label, len = length(line_arb))
156		)
157		}
158		}
159
160		# to check the variable line arguments
161		validate_line_vars_arg <- function(line_vars, line_vars_colors, line_vars_labels) {
162	6x	checkmate::assert_character(line_vars)
163	6x	if (length(line_vars) > 0) {
164	6x	checkmate::assert(
165	6x	checkmate::check_string(line_vars_colors),
166	6x	checkmate::check_character(line_vars_colors, len = length(line_vars))
167		)
168	6x	checkmate::assert(
169	6x	checkmate::check_string(line_vars_labels),
170	6x	checkmate::check_character(line_vars_labels, len = length(line_vars))
171		)
172		}
173		}

1		templ_ui_constraint <- function(ns, label = "Data Constraint") {
2	12x	tags$div(
3	12x	id = ns("constraint_var_whole"), # give an id to hide it
4	12x	radioButtons(ns("constraint_var"), label, choices = "NONE"),
5	12x	shinyjs::hidden(tags$div(
6	12x	id = ns("constraint_range"),
7	12x	tags$div(
8	12x	class = "inline-block;",
9	12x	numericInput(ns("constraint_range_min"), label = "Min", value = 0, min = 0, max = 0)
10		),
11	12x	tags$div(
12	12x	class = "inline-block;",
13	12x	numericInput(ns("constraint_range_max"), label = "Min", value = 0, min = 0, max = 0)
14		)
15		)),
16	12x	shinyjs::hidden(tags$div(
17	12x	id = ns("all_na"),
18	12x	helpText("All values are missing (NA)")
19		))
20		)
21		}
22
23		keep_data_const_opts_updated <- function(session, input, data, id_param_var) {
24		# use reactiveVal so that it only updates when options actually changed and not just data
25	6x	choices <- reactiveVal()
26	6x	observeEvent(data(), {
27	7x	paramname <- input[[id_param_var]]
28	7x	req(length(paramname) == 1)
29
30	7x	data_filtered <- data()$ANL %>% dplyr::filter(.data$PARAMCD == paramname)
31	7x	choices(c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE")[
32	7x	c(TRUE, !all(is.na(data_filtered[["BASE2"]])), !all(is.na(data_filtered[["BASE"]])))
33		])
34		})
35	6x	observeEvent(choices(), {
36	6x	updateRadioButtons(session, "constraint_var", choices = choices())
37		# hide when only one option "NONE"
38	6x	if (length(choices()) == 1) {
39	!	shinyjs::hide("constraint_var_whole")
40		} else {
41	6x	shinyjs::show("constraint_var_whole")
42		}
43		})
44		}
45
46
47
48
49		# param_id: input id that contains values of PARAMCD to filter for
50		# param_var: currently only "PARAMCD" is supported
51		constr_anl_q <- function(session, input, data, dataname, param_id, param_var, trt_group, min_rows) {
52	6x	checkmate::assert_class(data, "reactive")
53	6x	checkmate::assert_class(shiny::isolate(data()), "teal_data")
54	6x	dataset_var <- dataname
55	6x	if (!identical(param_var, "PARAMCD")) {
56		# why is there a variable param_id which is provided to this function and always equal to "param"?
57	!	stop("param_var must be 'PARAMCD'. Otherwise, we cannot currently guarantee the correctness of the code.")
58		}
59
60	6x	anl_param <- reactive({
61	13x	param_var_value <- input[[param_id]] # value to filter PARAMCD for
62	13x	validate(need(param_var_value, "Please select a biomarker"))
63	7x	checkmate::assert_string(param_var_value)
64
65	7x	ANL <- data()[[dataname]] # nolint
66	7x	validate_has_data(ANL, min_rows)
67
68	7x	validate_has_variable(ANL, param_var)
69	7x	validate_has_variable(ANL, "AVISITCD")
70	7x	validate_has_variable(ANL, "BASE")
71	7x	validate_has_variable(ANL, "BASE2")
72	7x	validate_has_variable(ANL, trt_group)
73
74		# analysis
75	7x	private_qenv <- data() %>%
76	7x	teal.code::eval_code(
77	7x	substitute(ANL <- dataname, list(dataname = as.name(dataname))) # nolint
78		) %>%
79	7x	teal.code::eval_code(
80	7x	code = bquote({
81	7x	ANL <- .(as.name(dataset_var)) %>% # nolint
82	7x	dplyr::filter(.(as.name(param_var)) == .(param_var_value))
83		})
84		)
85	7x	validate_has_data(private_qenv[["ANL"]], min_rows)
86	7x	list(ANL = ANL, qenv = private_qenv)
87		})
88
89	6x	observe({
90	13x	param_var_value <- input[[param_id]]
91	13x	validate(need(param_var_value, "Please select a biomarker"))
92
93	7x	constraint_var <- input[["constraint_var"]]
94	7x	validate(need(constraint_var, "select a constraint variable"))
95
96	7x	ANL <- data()[[dataname]] # nolint
97	7x	validate_has_data(ANL, min_rows)
98
99	7x	validate_has_variable(ANL, param_var)
100	7x	validate_has_variable(ANL, "AVISITCD")
101	7x	validate_has_variable(ANL, "BASE")
102	7x	validate_has_variable(ANL, "BASE2")
103
104	7x	ANL <- ANL %>% dplyr::filter(!!sym(param_var) == param_var_value) # nolint
105
106	7x	visit_freq <- unique(ANL$AVISITCD)
107
108		# get min max values
109	7x	if ((constraint_var == "BASE2" && any(grepl("SCR", visit_freq))) \|\|
110	7x	(constraint_var == "BASE" && any(grepl("BL", visit_freq)))) { # nolint
111	!	val <- stats::na.omit(switch(constraint_var,
112	!	"BASE" = ANL$BASE[ANL$AVISITCD == "BL"],
113	!	"BASE2" = ANL$BASE2[ANL$AVISITCD == "SCR"],
114	!	stop(paste(constraint_var, "not allowed"))
115		))
116
117	!	if (length(val) == 0 \|\| all(is.na(val))) {
118	!	shinyjs::show("all_na")
119	!	shinyjs::hide("constraint_range")
120	!	args <- list(
121	!	min = list(label = "Min", min = 0, max = 0, value = 0),
122	!	max = list(label = "Max", min = 0, max = 0, value = 0)
123		)
124	!	update_min_max(session, args)
125		} else {
126	!	rng <- range(val, na.rm = TRUE)
127
128	!	minmax <- c(floor(rng[1] * 1000) / 1000, ceiling(rng[2] * 1000) / 1000)
129
130	!	label_min <- sprintf("Min (%s)", minmax[1])
131	!	label_max <- sprintf("Max (%s)", minmax[2])
132
133	!	args <- list(
134	!	min = list(label = label_min, min = minmax[1], max = minmax[2], value = minmax[1]),
135	!	max = list(label = label_max, min = minmax[1], max = minmax[2], value = minmax[2])
136		)
137
138	!	update_min_max(session, args)
139	!	shinyjs::show("constraint_range") # update before show
140	!	shinyjs::hide("all_na")
141		}
142	7x	} else if (constraint_var == "NONE") {
143	7x	shinyjs::hide("constraint_range") # hide before update
144	7x	shinyjs::hide("all_na")
145
146		# force update (and thus refresh) on different constraint_var -> pass unique value for each constraint_var name
147	7x	args <- list(
148	7x	min = list(label = "Min", min = 0, max = 0, value = 0),
149	7x	max = list(label = "Max", min = 0, max = 0, value = 0)
150		)
151
152	7x	update_min_max(session, args)
153		} else {
154	!	validate(need(FALSE, "This is an invalid data contraint for the filtered data"))
155		}
156		})
157
158	6x	create_anl_constraint_reactive(anl_param, input, param_id = param_id, min_rows = min_rows)
159		}
160
161		# returns a reactive that applies the `x-axis data constraint`
162		# More precisely, all patients are filtered out that do not have the range of
163		# `param_id.constraint_var` in the specified range
164		# constraint var means that `param_id.constraint_var` is constrained to the filtered range (or NA),
165		# e.g. `ALT.BASE2` (i.e. `PARAMCD = ALT & range_filter_on(BASE2)`)
166		create_anl_constraint_reactive <- function(anl_param, input, param_id, min_rows) {
167	6x	iv_r <- reactive({
168	6x	iv <- shinyvalidate::InputValidator$new()
169	6x	iv$condition(~ isTRUE(input$constraint_var != "NONE"))
170	6x	iv$add_rule("constraint_range_min", shinyvalidate::sv_required("A contraint minimum value is required"))
171	6x	iv$add_rule("constraint_range_max", shinyvalidate::sv_required("A contraint maximum value is required"))
172	6x	iv$add_rule(
173	6x	"constraint_range_min",
174	6x	~ if (!is.na(input$constraint_range_max) && (.) > input$constraint_range_max) {
175	!	"constraint min needs to be less than max"
176		}
177		)
178	6x	iv$add_rule(
179	6x	"constraint_range_max",
180	6x	~ if (!is.na(input$constraint_range_min) && (.) < input$constraint_range_min) {
181	!	"constraint min needs to be less than max"
182		}
183		)
184	6x	iv
185		})
186
187
188	6x	return_val <- reactive({
189	13x	private_qenv <- anl_param()$qenv
190
191		# it is assumed that constraint_var is triggering constraint_range which then trigger this clause
192	7x	constraint_var <- isolate(input[["constraint_var"]])
193	7x	constraint_range_min <- input[["constraint_range_min"]]
194	7x	constraint_range_max <- input[["constraint_range_max"]]
195	7x	param <- input[[param_id]]
196	7x	req(param)
197
198		# filter constraint
199	7x	if (constraint_var != "NONE") {
200	!	private_qenv <- teal.code::eval_code(
201	!	object = private_qenv,
202	!	code = bquote({
203		# the below includes patients who have at least one non-NA BASE value
204		# ideally, a patient should either have all NA values or none at all
205		# this could be achieved through preprocessing; otherwise, this is easily overseen
206	!	filtered_usubjids <- ANL %>% # nolint
207	!	dplyr::filter(
208	!	PARAMCD == .(param),
209	!	(.(constraint_range_min) <= .data[[.(constraint_var)]]) &
210	!	(.data[[.(constraint_var)]] <= .(constraint_range_max))
211		) %>%
212	!	dplyr::pull(USUBJID)
213		# include patients with all NA values for constraint_var
214	!	filtered_usubjids <- c(
215	!	filtered_usubjids,
216	!	ANL %>%
217	!	dplyr::filter(PARAMCD == .(param)) %>%
218	!	dplyr::group_by(USUBJID) %>%
219	!	dplyr::summarize(all_na = all(is.na(.data[[.(constraint_var)]]))) %>%
220	!	dplyr::filter(all_na) %>%
221	!	dplyr::pull(USUBJID)
222		)
223	!	ANL <- ANL %>% dplyr::filter(USUBJID %in% filtered_usubjids) # nolint
224		})
225		)
226	!	validate_has_data(private_qenv[["ANL"]], min_rows)
227		}
228	7x	list(ANL = private_qenv[["ANL"]], qenv = private_qenv)
229		})
230
231	6x	reactive(
232	6x	list(
233	6x	value = return_val,
234	6x	iv_r = iv_r
235		)
236		)
237		}
238
239		# for outputting the constraint in the report
240		formatted_data_constraint <- function(constraint_var, constraint_range_min, constraint_range_max) {
241	!	constraint_var_label <- switch(constraint_var,
242	!	"BASE2" = "Screening",
243	!	"BASE" = "Baseline",
244	!	"None"
245		)
246	!	msg <- paste("Data Constraint:", constraint_var_label)
247	!	if (constraint_var_label != "None") {
248	!	msg <- paste(msg, "from", constraint_range_min, "to", constraint_range_max)
249		}
250	!	msg
251		}
252
253		update_min_max <- function(session, args) {
254	7x	do.call("updateNumericInput", c(list(session = session, inputId = "constraint_range_min"), args$min))
255	7x	do.call("updateNumericInput", c(list(session = session, inputId = "constraint_range_max"), args$max))
256		}

1		#' Box Plot
2		#'
3		#' This teal module renders the UI and calls the functions that create a box plot and accompanying
4		#' summary table.
5		#'
6		#' @param label menu item label of the module in the teal app.
7		#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
8		#' laboratory data frame `ALB`.
9		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
10		#' @param param list of biomarkers of interest.
11		#' @param yaxis_var name of variable containing biomarker results displayed on y-axis e.g. `AVAL`. When not provided,
12		#' it defaults to `choices_selected(c("AVAL", "CHG"), "AVAL")`.
13		#' @param xaxis_var variable to categorize the x-axis. When not provided, it defaults to
14		#' `choices_selected("AVISITCD", "AVISITCD")`.
15		#' @param facet_var variable to facet the plots by. When not provided, it defaults to
16		#' `choices_selected(c("ARM", "ACTARM"), "ARM")`.
17		#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected
18		#' option for variable names representing treatment group e.g. `ARM`.
19		#' @param color_manual vector of colors applied to treatment values.
20		#' @param shape_manual vector of symbols applied to `LOQ` values.
21		#' @param facet_ncol numeric value indicating number of facets per row.
22		#' @param loq_legend `loq` legend toggle.
23		#' @param rotate_xlab 45 degree rotation of `x-axis` values.
24		#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
25		#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
26		#' naming the color for the arbitrary horizontal lines.
27		#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
28		#' naming the label for the arbitrary horizontal lines.
29		#' @param hline_vars a character vector to name the columns that will define additional horizontal lines.
30		#' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines.
31		#' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear
32		#' in the legend.
33		#' @param plot_height controls plot height.
34		#' @param plot_width optional, controls plot width.
35		#' @param font_size font size control for title, `x-axis` label, `y-axis` label and legend.
36		#' @param dot_size plot dot size.
37		#' @param alpha numeric vector to define transparency of plotted points.
38		#'
39		#' @inheritParams teal.widgets::standard_layout
40		#' @inheritParams teal::module
41		#'
42		#' @author Jeff Tomlinson (tomlinsj) jeffrey.tomlinson@roche.com
43		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
44		#'
45		#' @return an \code{\link[teal]{module}} object
46		#'
47		#' @export
48		#'
49		#' @examplesIf require("nestcolor")
50		#' # Example using ADaM structure analysis dataset.
51		#' data <- teal_data()
52		#' data <- within(data, {
53		#' library(dplyr)
54		#' library(nestcolor)
55		#' library(stringr)
56		#'
57		#' # use non-exported function from goshawk
58		#' .h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
59		#'
60		#' # original ARM value = dose value
61		#' .arm_mapping <- list(
62		#' "A: Drug X" = "150mg QD",
63		#' "B: Placebo" = "Placebo",
64		#' "C: Combination" = "Combination"
65		#' )
66		#' set.seed(1) # @linksto ADSL ADLB
67		#' ADSL <- rADSL
68		#' ADLB <- rADLB
69		#' .var_labels <- lapply(ADLB, function(x) attributes(x)$label)
70		#' ADLB <- ADLB %>%
71		#' mutate(
72		#' AVISITCD = case_when(
73		#' AVISIT == "SCREENING" ~ "SCR",
74		#' AVISIT == "BASELINE" ~ "BL",
75		#' grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
76		#' TRUE ~ as.character(NA)
77		#' ),
78		#' AVISITCDN = case_when(
79		#' AVISITCD == "SCR" ~ -2,
80		#' AVISITCD == "BL" ~ 0,
81		#' grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
82		#' TRUE ~ as.numeric(NA)
83		#' ),
84		#' AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
85		#' TRTORD = case_when(
86		#' ARMCD == "ARM C" ~ 1,
87		#' ARMCD == "ARM B" ~ 2,
88		#' ARMCD == "ARM A" ~ 3
89		#' ),
90		#' ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
91		#' ARM = factor(ARM) %>% reorder(TRTORD),
92		#' ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
93		#' ACTARM = factor(ACTARM) %>% reorder(TRTORD),
94		#' ANRLO = 50,
95		#' ANRHI = 75
96		#' ) %>%
97		#' rowwise() %>%
98		#' group_by(PARAMCD) %>%
99		#' mutate(LBSTRESC = ifelse(
100		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
101		#' paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
102		#' )) %>%
103		#' mutate(LBSTRESC = ifelse(
104		#' USUBJID %in% sample(USUBJID, 1, replace = TRUE),
105		#' paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
106		#' )) %>%
107		#' ungroup()
108		#'
109		#' attr(ADLB[["ARM"]], "label") <- .var_labels[["ARM"]]
110		#' attr(ADLB[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
111		#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
112		#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
113		#'
114		#' # add LLOQ and ULOQ variables
115		#' ALB_LOQS <- .h_identify_loq_values(ADLB, "LOQFL")
116		#' ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")
117		#' })
118		#'
119		#' join_keys(data) <- default_cdisc_join_keys[names(data)]
120		#'
121		#' app <- init(
122		#' data = data,
123		#' modules = modules(
124		#' tm_g_gh_boxplot(
125		#' label = "Box Plot",
126		#' dataname = "ADLB",
127		#' param_var = "PARAMCD",
128		#' param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
129		#' yaxis_var = choices_selected(c("AVAL", "BASE", "CHG"), "AVAL"),
130		#' xaxis_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "STUDYID"), "ARM"),
131		#' facet_var = choices_selected(c("ACTARM", "ARM", "AVISITCD", "SEX"), "AVISITCD"),
132		#' trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
133		#' loq_legend = TRUE,
134		#' rotate_xlab = FALSE,
135		#' hline_arb = c(60, 55),
136		#' hline_arb_color = c("grey", "red"),
137		#' hline_arb_label = c("default_hori_A", "default_hori_B"),
138		#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
139		#' hline_vars_colors = c("pink", "brown", "purple", "black"),
140		#' )
141		#' )
142		#' )
143		#' if (interactive()) {
144		#' shinyApp(app$ui, app$server)
145		#' }
146		#'
147		tm_g_gh_boxplot <- function(label,
148		dataname,
149		param_var,
150		param,
151		yaxis_var = teal.transform::choices_selected(c("AVAL", "CHG"), "AVAL"),
152		xaxis_var = teal.transform::choices_selected("AVISITCD", "AVISITCD"),
153		facet_var = teal.transform::choices_selected(c("ARM", "ACTARM"), "ARM"),
154		trt_group,
155		color_manual = NULL,
156		shape_manual = NULL,
157		facet_ncol = NULL,
158		loq_legend = TRUE,
159		rotate_xlab = FALSE,
160		hline_arb = numeric(0),
161		hline_arb_color = "red",
162		hline_arb_label = "Horizontal line",
163		hline_vars = character(0),
164		hline_vars_colors = "green",
165		hline_vars_labels = hline_vars,
166		plot_height = c(600, 200, 2000),
167		plot_width = NULL,
168		font_size = c(12, 8, 20),
169		dot_size = c(2, 1, 12),
170		alpha = c(0.8, 0.0, 1.0),
171		pre_output = NULL,
172		post_output = NULL,
173		transformators = list()) {
174	6x	message("Initializing tm_g_gh_boxplot")
175	6x	checkmate::assert_string(label)
176	6x	checkmate::assert_string(dataname)
177	6x	checkmate::assert_string(param_var)
178	6x	checkmate::assert_class(param, "choices_selected")
179	6x	checkmate::assert_class(yaxis_var, "choices_selected")
180	6x	checkmate::assert_class(xaxis_var, "choices_selected")
181	6x	checkmate::assert_class(facet_var, "choices_selected")
182	6x	checkmate::assert_class(trt_group, "choices_selected")
183	6x	checkmate::assert_int(facet_ncol, null.ok = TRUE)
184	6x	checkmate::assert_flag(loq_legend)
185	6x	checkmate::assert_flag(rotate_xlab)
186	6x	checkmate::assert_numeric(font_size, len = 3)
187	6x	checkmate::assert_numeric(dot_size, len = 3)
188	6x	checkmate::assert_numeric(alpha, len = 3)
189	6x	validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
190	6x	validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels)
191	6x	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
192	6x	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
193	6x	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
194	6x	checkmate::assert_numeric(
195	6x	plot_width[1],
196	6x	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
197		)
198
199	6x	args <- as.list(environment())
200
201	6x	module(
202	6x	label = label,
203	6x	datanames = dataname,
204	6x	server = srv_g_boxplot,
205	6x	server_args = list(
206	6x	dataname = dataname,
207	6x	param_var = param_var,
208	6x	color_manual = color_manual,
209	6x	shape_manual = shape_manual,
210	6x	plot_height = plot_height,
211	6x	plot_width = plot_width,
212	6x	hline_vars_colors = hline_vars_colors,
213	6x	hline_vars_labels = hline_vars_labels,
214	6x	module_args = args
215		),
216	6x	ui = ui_g_boxplot,
217	6x	ui_args = args,
218	6x	transformators = transformators
219		)
220		}
221
222		ui_g_boxplot <- function(id, ...) {
223	12x	ns <- NS(id)
224	12x	a <- list(...)
225
226	12x	teal.widgets::standard_layout(
227	12x	output = bslib::page_fluid(
228	12x	tags$div(
229	12x	teal.widgets::plot_with_settings_ui(id = ns("boxplot"))
230		),
231	12x	tags$div(
232	12x	tags$br(), tags$hr(),
233	12x	tags$h4("Selected Data Points"),
234	12x	DT::dataTableOutput(ns("brush_data"))
235		),
236	12x	tags$div(
237	12x	tags$br(), tags$hr(),
238	12x	tags$h4("Descriptive Statistics"),
239	12x	DT::dataTableOutput(ns("table_ui"))
240		)
241		),
242	12x	encoding = tags$div(
243		### Reporter
244	12x	teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
245	12x	tags$br(), tags$br(),
246		###
247	12x	templ_ui_dataname(a$dataname),
248	12x	uiOutput(ns("axis_selections")),
249	12x	templ_ui_constraint(ns, label = "Data Constraint"), # required by constr_anl_q
250	12x	if (length(a$hline_vars) > 0) {
251	12x	teal.widgets::optionalSelectInput(
252	12x	ns("hline_vars"),
253	12x	label = "Add Horizontal Range Line(s):",
254	12x	choices = a$hline_vars,
255	12x	selected = NULL,
256	12x	multiple = TRUE
257		)
258		},
259	12x	ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
260	12x	bslib::accordion(
261	12x	bslib::accordion_panel(
262	12x	title = "Plot Aesthetic Settings",
263	12x	toggle_slider_ui(
264	12x	ns("yrange_scale"),
265	12x	label = "Y-Axis Range Zoom"
266		),
267	12x	numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
268	12x	checkboxInput(ns("loq_legend"), "Display LoQ Legend", a$loq_legend),
269	12x	checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab)
270		),
271	12x	bslib::accordion_panel(
272	12x	title = "Plot settings",
273	12x	teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
274	12x	teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE),
275	12x	teal.widgets::optionalSliderInputValMinMax(ns("alpha"), "Dot Alpha", a$alpha, ticks = FALSE)
276		)
277		)
278		),
279	12x	forms = tagList(
280	12x	teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
281		),
282	12x	pre_output = a$pre_output,
283	12x	post_output = a$post_output
284		)
285		}
286
287
288		srv_g_boxplot <- function(id,
289		data,
290		reporter,
291		filter_panel_api,
292		dataname,
293		param_var,
294		trt_group,
295		color_manual,
296		shape_manual,
297		plot_height,
298		plot_width,
299		hline_vars_colors,
300		hline_vars_labels,
301		module_args) {
302	6x	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
303	6x	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
304	6x	checkmate::assert_class(data, "reactive")
305	6x	checkmate::assert_class(shiny::isolate(data()), "teal_data")
306
307	6x	moduleServer(id, function(input, output, session) {
308	6x	teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
309	6x	output$axis_selections <- renderUI({
310	6x	env <- shiny::isolate(as.list(data()[[".raw_data"]]))
311	6x	resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
312	6x	resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
313	6x	resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
314	6x	resolved_facet_var <- teal.transform::resolve_delayed(module_args$facet_var, env)
315	6x	resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
316
317	6x	templ_ui_params_vars(
318	6x	session$ns,
319	6x	xparam_choices = resolved_param$choices,
320	6x	xparam_selected = resolved_param$selected,
321	6x	xparam_label = module_args$"Select a Biomarker",
322	6x	xchoices = resolved_x$choices,
323	6x	xselected = resolved_x$selected,
324	6x	ychoices = resolved_y$choices,
325	6x	yselected = resolved_y$selected,
326	6x	facet_choices = resolved_facet_var$choices,
327	6x	facet_selected = resolved_facet_var$selected,
328	6x	trt_choices = resolved_trt$choices,
329	6x	trt_selected = resolved_trt$selected
330		)
331		})
332		# reused in all modules
333	6x	anl_q_output <- constr_anl_q(
334	6x	session, input, data, dataname,
335	6x	param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
336		)
337
338	6x	anl_q <- anl_q_output()$value
339
340		# update sliders for axes taking constraints into account
341	6x	data_state <- reactive({
342	13x	get_data_range_states(
343	13x	varname = input$yaxis_var,
344	13x	paramname = input$xaxis_param,
345	13x	ANL = anl_q()$ANL
346		)
347		})
348	6x	yrange_slider_state <- toggle_slider_server("yrange_scale", data_state)
349	6x	keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
350
351	6x	horizontal_line <- srv_arbitrary_lines("hline_arb")
352
353	6x	trt_group <- reactive({
354	6x	input$trt_group
355		})
356
357	6x	iv_r <- reactive({
358	6x	iv <- shinyvalidate::InputValidator$new()
359
360	6x	iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
361	6x	iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
362	6x	iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
363	6x	iv$add_rule("xaxis_var", ~ if ((.) %in% c("ACTARM", "ARM") && isTRUE((.) != trt_group())) {
364	!	sprintf("You can not choose %s as x-axis variable for treatment variable %s.", (.), trt_group())
365		})
366	6x	iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))
367
368	6x	iv$add_rule("facet_var", shinyvalidate::sv_optional())
369	6x	iv$add_rule("facet_var", ~ if ((.) %in% c("ACTARM", "ARM") && isTRUE((.) != trt_group())) {
370	!	sprintf("You can not choose %s as faceting variable for treatment variable %s.", (.), trt_group())
371		})
372
373	6x	iv_facet <- shinyvalidate::InputValidator$new()
374	6x	iv_facet$condition(~ !is.null(input$facet_var))
375	6x	iv_facet$add_rule("facet_ncol", plots_per_row_validate_rules(required = FALSE))
376	6x	iv$add_validator(iv_facet)
377
378	6x	iv$add_validator(horizontal_line()$iv_r())
379	6x	iv$add_validator(anl_q_output()$iv_r())
380	6x	iv$enable()
381	6x	iv
382		})
383
384	6x	create_plot <- debounce(reactive({
385	27x	teal::validate_inputs(iv_r())
386
387	21x	req(anl_q())
388		# nolint start
389	21x	param <- input$xaxis_param
390	21x	yaxis <- input$yaxis_var
391	21x	xaxis <- input$xaxis_var
392	21x	facet_var <- `if`(is.null(input$facet_var), "None", input$facet_var)
393	21x	ylim <- yrange_slider_state$value
394	21x	facet_ncol <- input$facet_ncol
395
396	21x	alpha <- input$alpha
397	21x	font_size <- input$font_size
398	21x	dot_size <- input$dot_size
399	21x	loq_legend <- input$loq_legend
400	21x	rotate_xlab <- input$rotate_xlab
401
402	21x	hline_arb <- horizontal_line()$line_arb
403	21x	hline_arb_label <- horizontal_line()$line_arb_label
404	21x	hline_arb_color <- horizontal_line()$line_arb_color
405
406	21x	hline_vars <- input$hline_vars
407	21x	trt_group <- input$trt_group
408		# nolint end
409
410	21x	validate_has_variable(
411	21x	anl_q()$ANL,
412	21x	yaxis,
413	21x	sprintf("Variable %s is not available in data %s", yaxis, dataname)
414		)
415	21x	validate_has_variable(
416	21x	anl_q()$ANL,
417	21x	xaxis,
418	21x	sprintf("Variable %s is not available in data %s", xaxis, dataname)
419		)
420
421	21x	if (!facet_var == "None") {
422	21x	validate_has_variable(
423	21x	anl_q()$ANL,
424	21x	facet_var,
425	21x	sprintf("Variable %s is not available in data %s", facet_var, dataname)
426		)
427		}
428
429	21x	anl_q()$qenv %>% teal.code::eval_code(
430	21x	code = bquote({
431	21x	p <- goshawk::g_boxplot(
432	21x	data = ANL,
433	21x	biomarker = .(param),
434	21x	xaxis_var = .(xaxis),
435	21x	yaxis_var = .(yaxis),
436	21x	hline_arb = .(hline_arb),
437	21x	hline_arb_label = .(hline_arb_label),
438	21x	hline_arb_color = .(hline_arb_color),
439	21x	hline_vars = .(hline_vars),
440	21x	hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
441	21x	hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)]),
442	21x	facet_ncol = .(facet_ncol),
443	21x	loq_legend = .(loq_legend),
444	21x	rotate_xlab = .(rotate_xlab),
445	21x	trt_group = .(trt_group),
446	21x	ylim = .(ylim),
447	21x	color_manual = .(color_manual),
448	21x	shape_manual = .(shape_manual),
449	21x	facet_var = .(facet_var),
450	21x	alpha = .(alpha),
451	21x	dot_size = .(dot_size),
452	21x	font_size = .(font_size),
453	21x	unit = .("AVALU")
454		)
455	15x	p
456		})
457		)
458	6x	}), 800)
459
460	6x	create_table <- debounce(reactive({
461	13x	req(iv_r()$is_valid())
462	7x	req(anl_q())
463	7x	param <- input$xaxis_param
464	7x	xaxis_var <- input$yaxis_var # nolint
465	7x	font_size <- input$font_size
466	7x	trt_group <- input$trt_group
467	7x	facet_var <- input$facet_var
468
469	7x	anl_q()$qenv %>% teal.code::eval_code(
470	7x	code = bquote({
471	7x	tbl <- goshawk::t_summarytable(
472	7x	data = ANL,
473	7x	trt_group = .(trt_group),
474	7x	param_var = .(param_var),
475	7x	param = .(param),
476	7x	xaxis_var = .(xaxis_var),
477	7x	facet_var = .(facet_var)
478		)
479	7x	tbl
480		})
481		)
482	6x	}), 800)
483
484	6x	plot_r <- reactive({
485	20x	create_plot()[["p"]]
486		})
487
488	6x	boxplot_data <- teal.widgets::plot_with_settings_srv(
489	6x	id = "boxplot",
490	6x	plot_r = plot_r,
491	6x	height = plot_height,
492	6x	width = plot_width,
493	6x	brushing = TRUE
494		)
495
496	6x	output$table_ui <- DT::renderDataTable({
497	13x	req(create_table())
498	!	tbl <- create_table()[["tbl"]]
499
500	!	numeric_cols <- setdiff(names(dplyr::select_if(tbl, is.numeric)), "n")
501
502	!	DT::datatable(tbl,
503	!	rownames = FALSE, options = list(scrollX = TRUE)
504		) %>%
505	!	DT::formatRound(numeric_cols, 4)
506		})
507
508	6x	joined_qenvs <- reactive({
509	!	req(create_plot(), create_table())
510	!	c(create_plot(), create_table())
511		})
512
513	6x	code <- reactive(teal.code::get_code(joined_qenvs()))
514
515		### REPORTER
516	6x	if (with_reporter) {
517	6x	card_fun <- function(comment, label) {
518	!	constraint_description <- paste(
519	!	"\nFacet By:",
520	!	if (length(input$facet_var) != 0) input$facet_var else "None",
521	!	"\nSelect an X-axis Variable:",
522	!	input$xaxis_var
523		)
524	!	card <- report_card_template_goshawk(
525	!	title = "Box Plot",
526	!	label = label,
527	!	with_filter = with_filter,
528	!	filter_panel_api = filter_panel_api,
529	!	constraint_list = list(
530	!	constraint_var = input$constraint_var,
531	!	constraint_range_min = input$constraint_range_min,
532	!	constraint_range_max = input$constraint_range_max
533		),
534	!	constraint_description = constraint_description,
535	!	style = "verbatim"
536		)
537	!	card$append_text("Plot", "header3")
538	!	card$append_plot(plot_r(), dim = boxplot_data$dim())
539	!	if (!comment == "") {
540	!	card$append_text("Comment", "header3")
541	!	card$append_text(comment)
542		}
543	!	card$append_src(code())
544	!	card
545		}
546	6x	teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
547		}
548		###
549
550		# highlight plot area
551	6x	reactive_df <- debounce(reactive({
552	6x	boxplot_brush <- boxplot_data$brush()
553
554	6x	ANL <- isolate(anl_q()$ANL) %>% droplevels() # nolint
555	!	validate_has_data(ANL, 2)
556
557	!	xvar <- isolate(input$xaxis_var)
558	!	yvar <- isolate(input$yaxis_var)
559	!	facetv <- isolate(input$facet_var)
560	!	trt_group <- isolate(input$trt_group)
561
562	!	req(all(c(xvar, yvar, facetv, trt_group) %in% names(ANL)))
563
564	!	teal.widgets::clean_brushedPoints(
565	!	dplyr::select(
566	!	ANL, "USUBJID", dplyr::all_of(c(trt_group, facetv)),
567	!	"AVISITCD", "PARAMCD", dplyr::all_of(c(xvar, yvar)), "LOQFL"
568		),
569	!	boxplot_brush
570		)
571	6x	}), 800)
572
573	6x	output$brush_data <- DT::renderDataTable({
574	6x	numeric_cols <- names(dplyr::select_if(reactive_df(), is.numeric))
575
576	!	DT::datatable(reactive_df(),
577	!	rownames = FALSE, options = list(scrollX = TRUE)
578		) %>%
579	!	DT::formatRound(numeric_cols, 4)
580		})
581
582	6x	teal.widgets::verbatim_popup_srv(
583	6x	id = "rcode",
584	6x	verbatim_content = reactive(code()),
585	6x	title = "Show R Code for Boxplot"
586		)
587		})
588		}

1		#' Spaghetti Plot
2		#'
3		#' This teal module renders the UI and calls the function
4		#' that creates a spaghetti plot.
5		#'
6		#' @param label menu item label of the module in the teal app.
7		#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}.
8		#' E.g. `ADaM` structured laboratory data frame `ADLB`.
9		#' @param param_var name of variable containing biomarker codes e.g. `PARAMCD`.
10		#' @param param biomarker selected.
11		#' @param param_var_label single name of variable in analysis data
12		#' that includes parameter labels.
13		#' @param idvar name of unique subject id variable.
14		#' @param xaxis_var single name of variable in analysis data
15		#' that is used as x-axis in the plot for the respective goshawk function.
16		#' @param xaxis_var_level vector that can be used to define the factor level of `xaxis_var`.
17		#' Only use it when `xaxis_var` is character or factor.
18		#' @param filter_var data constraint variable.
19		#' @param yaxis_var single name of variable in analysis data that is used as
20		#' summary variable in the respective `goshawk` function.
21		#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
22		#' for variable names representing treatment group e.g. `ARM`.
23		#' @param trt_group_level vector that can be used to define factor
24		#' level of `trt_group`.
25		#' @param man_color string vector representing customized colors
26		#' @param color_comb name or hex value for combined treatment color.
27		#' @param xtick numeric vector to define the tick values of `x-axis`
28		#' when x variable is numeric. Default value is `waive()`.
29		#' @param xlabel vector with same length of `xtick` to define the
30		#' label of `x-axis` tick values. Default value is `waive()`.
31		#' @param rotate_xlab `logical(1)` value indicating whether to rotate `x-axis` labels
32		#' @param facet_ncol numeric value indicating number of facets per row.
33		#' @param free_x `logical(1)` should scales be `"fixed"` (`FALSE`) of `"free"` (`TRUE`) for `x-axis` in
34		#' \code{\link[ggplot2]{facet_wrap}} \code{scales} parameter.
35		#' @param plot_height controls plot height.
36		#' @param plot_width optional, controls plot width.
37		#' @param font_size control font size for title, `x-axis`, `y-axis` and legend font.
38		#' @param dot_size plot dot size.
39		#' @param group_stats control group mean or median overlay.
40		#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
41		#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
42		#' naming the color for the arbitrary horizontal lines.
43		#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
44		#' naming the label for the arbitrary horizontal lines.
45		#' @param hline_vars a character vector to name the columns that will define additional horizontal lines.
46		#' @param hline_vars_colors a character vector naming the colors for the additional horizontal lines.
47		#' @param hline_vars_labels a character vector naming the labels for the additional horizontal lines that will appear
48		#' in the legend.
49		#' @inheritParams teal::module
50		#' @inheritParams teal.widgets::standard_layout
51		#'
52		#' @author Wenyi Liu (luiw2) wenyi.liu@roche.com
53		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
54		#'
55		#' @return \code{shiny} object
56		#'
57		#' @export
58		#'
59		#' @examples
60		#' # Example using ADaM structure analysis dataset.
61		#' data <- teal_data()
62		#' data <- within(data, {
63		#' library(dplyr)
64		#' library(stringr)
65		#'
66		#' # use non-exported function from goshawk
67		#' .h_identify_loq_values <- getFromNamespace("h_identify_loq_values", "goshawk")
68		#'
69		#' # original ARM value = dose value
70		#' .arm_mapping <- list(
71		#' "A: Drug X" = "150mg QD",
72		#' "B: Placebo" = "Placebo",
73		#' "C: Combination" = "Combination"
74		#' )
75		#' set.seed(1) # @linksto ADSL ADLB
76		#' ADSL <- rADSL
77		#' ADLB <- rADLB
78		#' .var_labels <- lapply(ADLB, function(x) attributes(x)$label)
79		#' ADLB <- ADLB %>%
80		#' mutate(
81		#' AVISITCD = case_when(
82		#' AVISIT == "SCREENING" ~ "SCR",
83		#' AVISIT == "BASELINE" ~ "BL",
84		#' grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
85		#' TRUE ~ as.character(NA)
86		#' ),
87		#' AVISITCDN = case_when(
88		#' AVISITCD == "SCR" ~ -2,
89		#' AVISITCD == "BL" ~ 0,
90		#' grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
91		#' TRUE ~ as.numeric(NA)
92		#' ),
93		#' AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
94		#' TRTORD = case_when(
95		#' ARMCD == "ARM C" ~ 1,
96		#' ARMCD == "ARM B" ~ 2,
97		#' ARMCD == "ARM A" ~ 3
98		#' ),
99		#' ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
100		#' ARM = factor(ARM) %>% reorder(TRTORD),
101		#' ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
102		#' ACTARM = factor(ACTARM) %>% reorder(TRTORD),
103		#' ANRLO = 30,
104		#' ANRHI = 75
105		#' ) %>%
106		#' rowwise() %>%
107		#' group_by(PARAMCD) %>%
108		#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
109		#' paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
110		#' )) %>%
111		#' mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
112		#' paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
113		#' )) %>%
114		#' ungroup()
115		#' attr(ADLB[["ARM"]], "label") <- .var_labels[["ARM"]]
116		#' attr(ADLB[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
117		#' attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
118		#' attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
119		#'
120		#' # add LLOQ and ULOQ variables
121		#' ALB_LOQS <- .h_identify_loq_values(ADLB, "LOQFL")
122		#' ADLB <- left_join(ADLB, ALB_LOQS, by = "PARAM")
123		#' })
124		#'
125		#' join_keys(data) <- default_cdisc_join_keys[names(data)]
126		#'
127		#' app <- init(
128		#' data = data,
129		#' modules = modules(
130		#' tm_g_gh_spaghettiplot(
131		#' label = "Spaghetti Plot",
132		#' dataname = "ADLB",
133		#' param_var = "PARAMCD",
134		#' param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
135		#' idvar = "USUBJID",
136		#' xaxis_var = choices_selected(c("Analysis Visit Code" = "AVISITCD"), "AVISITCD"),
137		#' yaxis_var = choices_selected(c("AVAL", "CHG", "PCHG"), "AVAL"),
138		#' filter_var = choices_selected(
139		#' c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE"),
140		#' "NONE"
141		#' ),
142		#' trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
143		#' color_comb = "#39ff14",
144		#' man_color = c(
145		#' "Combination" = "#000000",
146		#' "Placebo" = "#fce300",
147		#' "150mg QD" = "#5a2f5f"
148		#' ),
149		#' hline_arb = c(60, 50),
150		#' hline_arb_color = c("grey", "red"),
151		#' hline_arb_label = c("default A", "default B"),
152		#' hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
153		#' hline_vars_colors = c("pink", "brown", "purple", "black"),
154		#' )
155		#' )
156		#' )
157		#' if (interactive()) {
158		#' shinyApp(app$ui, app$server)
159		#' }
160		#'
161		tm_g_gh_spaghettiplot <- function(label,
162		dataname,
163		param_var,
164		param,
165		param_var_label = "PARAM",
166		idvar,
167		xaxis_var,
168		yaxis_var,
169		xaxis_var_level = NULL,
170		filter_var = yaxis_var,
171		trt_group,
172		trt_group_level = NULL,
173		group_stats = "NONE",
174		man_color = NULL,
175		color_comb = NULL,
176		xtick = ggplot2::waiver(),
177		xlabel = xtick,
178		rotate_xlab = FALSE,
179		facet_ncol = 2,
180		free_x = FALSE,
181		plot_height = c(600, 200, 2000),
182		plot_width = NULL,
183		font_size = c(12, 8, 20),
184		dot_size = c(2, 1, 12),
185		hline_arb = numeric(0),
186		hline_arb_color = "red",
187		hline_arb_label = "Horizontal line",
188		hline_vars = character(0),
189		hline_vars_colors = "green",
190		hline_vars_labels = hline_vars,
191		pre_output = NULL,
192		post_output = NULL,
193		transformators = list()) {
194	!	message("Initializing tm_g_gh_spaghettiplot")
195
196		# Validate string inputs
197	!	checkmate::assert_string(label)
198	!	checkmate::assert_string(dataname)
199	!	checkmate::assert_string(param_var)
200	!	checkmate::assert_string(param_var_label)
201	!	checkmate::assert_string(idvar)
202	!	checkmate::assert_string(group_stats)
203
204		# Validate choices_selected class inputs
205	!	checkmate::assert_class(param, "choices_selected")
206	!	checkmate::assert_class(xaxis_var, "choices_selected")
207	!	checkmate::assert_class(yaxis_var, "choices_selected")
208	!	checkmate::assert_class(trt_group, "choices_selected")
209
210		# Validate flag inputs
211	!	checkmate::assert_flag(rotate_xlab)
212	!	checkmate::assert_flag(free_x)
213
214		# Validate numeric vector inputs
215	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
216	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
217	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
218	!	checkmate::assert_numeric(
219	!	plot_width[1],
220	!	lower = plot_width[2], upper = plot_width[3],
221	!	null.ok = TRUE, .var.name = "plot_width"
222		)
223	!	checkmate::assert_numeric(font_size, len = 3, any.missing = FALSE, finite = TRUE)
224	!	checkmate::assert_numeric(dot_size, len = 3, any.missing = FALSE, finite = TRUE)
225
226		# Validate color manual if provided
227	!	checkmate::assert_character(man_color, null.ok = TRUE)
228	!	checkmate::assert_character(color_comb, null.ok = TRUE)
229	!	checkmate::assert_character(hline_arb_color)
230	!	checkmate::assert_character(hline_arb_label)
231
232		# Validate facet columns
233	!	checkmate::assert_int(facet_ncol, lower = 1)
234
235		# Validate line arguments
236	!	validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
237	!	validate_line_vars_arg(hline_vars, hline_vars_colors, hline_vars_labels)
238
239	!	args <- as.list(environment())
240
241	!	module(
242	!	label = label,
243	!	server = srv_g_spaghettiplot,
244	!	server_args = list(
245	!	dataname = dataname,
246	!	idvar = idvar,
247	!	param_var = param_var,
248	!	xaxis_var_level = xaxis_var_level,
249	!	trt_group_level = trt_group_level,
250	!	man_color = man_color,
251	!	color_comb = color_comb,
252	!	param_var_label = param_var_label,
253	!	xtick = xtick,
254	!	xlabel = xlabel,
255	!	plot_height = plot_height,
256	!	plot_width = plot_width,
257	!	hline_vars_colors = hline_vars_colors,
258	!	hline_vars_labels = hline_vars_labels,
259	!	module_args = args
260		),
261	!	ui = g_ui_spaghettiplot,
262	!	ui_args = args,
263	!	transformators = transformators,
264	!	datanames = dataname
265		)
266		}
267
268		g_ui_spaghettiplot <- function(id, ...) {
269	!	ns <- NS(id)
270	!	a <- list(...)
271
272	!	tags$div(
273	!	teal.widgets::standard_layout(
274	!	output = templ_ui_output_datatable(ns),
275	!	encoding = tags$div(
276		### Reporter
277	!	teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
278	!	tags$br(), tags$br(),
279		###
280	!	templ_ui_dataname(a$dataname),
281	!	uiOutput(ns("axis_selections")),
282	!	radioButtons(
283	!	ns("group_stats"),
284	!	"Group Statistics",
285	!	c("None" = "NONE", "Mean" = "MEAN", "Median" = "MEDIAN"),
286	!	inline = TRUE
287		),
288	!	templ_ui_constraint(ns), # required by constr_anl_q
289	!	if (length(a$hline_vars) > 0) {
290	!	teal.widgets::optionalSelectInput(
291	!	ns("hline_vars"),
292	!	label = "Add Horizontal Range Line(s):",
293	!	choices = a$hline_vars,
294	!	selected = NULL,
295	!	multiple = TRUE
296		)
297		},
298	!	ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
299	!	bslib::accordion(
300	!	bslib::accordion_panel(
301	!	title = "Plot Aesthetic Settings",
302	!	tags$div(
303	!	toggle_slider_ui(
304	!	ns("yrange_scale"),
305	!	label = "Y-Axis Range Zoom"
306		),
307	!	tags$div(
308	!	class = "flex flex-wrap items-center",
309	!	tags$div(
310	!	class = "mr-1",
311	!	tags$span(tags$strong("Number of Plots Per Row:"))
312		),
313	!	tags$div(
314	!	class = "w-65px",
315	!	numericInput(ns("facet_ncol"), "", a$facet_ncol, min = 1)
316		)
317		)
318		),
319	!	checkboxInput(ns("free_x"), "Free X-Axis Scales", a$free_x),
320	!	checkboxInput(ns("rotate_xlab"), "Rotate X-Axis Label", a$rotate_xlab),
321	!	teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
322	!	teal.widgets::optionalSliderInputValMinMax(ns("dot_size"), "Dot Size", a$dot_size, ticks = FALSE),
323	!	teal.widgets::optionalSliderInputValMinMax(
324	!	ns("alpha"),
325	!	"Line Alpha",
326	!	a$alpha,
327	!	value_min_max = c(0.8, 0.0, 1.0), step = 0.1, ticks = FALSE
328		)
329		)
330		)
331		),
332	!	forms = tagList(
333	!	teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
334		),
335	!	pre_output = a$pre_output,
336	!	post_output = a$post_output
337		)
338		)
339		}
340
341
342
343		srv_g_spaghettiplot <- function(id,
344		data,
345		reporter,
346		filter_panel_api,
347		dataname,
348		idvar,
349		param_var,
350		trt_group,
351		man_color,
352		color_comb,
353		xaxis_var_level,
354		trt_group_level,
355		param_var_label,
356		xtick,
357		xlabel,
358		plot_height,
359		plot_width,
360		hline_vars_colors,
361		hline_vars_labels,
362		module_args) {
363	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
364	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
365	!	checkmate::assert_class(data, "reactive")
366	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
367
368	!	moduleServer(id, function(input, output, session) {
369	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
370	!	output$axis_selections <- renderUI({
371	!	env <- shiny::isolate(as.list(data()[[".raw_data"]]))
372	!	resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
373	!	resolved_y <- teal.transform::resolve_delayed(module_args$yaxis_var, env)
374	!	resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
375	!	resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
376	!	templ_ui_params_vars(
377	!	session$ns,
378		# xparam and yparam are identical, so we only show the user one
379	!	xparam_choices = resolved_param$choices,
380	!	xparam_selected = resolved_param$selected,
381	!	xparam_label = "Select a Biomarker",
382	!	xchoices = resolved_x$choices,
383	!	xselected = resolved_x$selected,
384	!	ychoices = resolved_y$choices,
385	!	yselected = resolved_y$selected,
386	!	trt_choices = resolved_trt$choices,
387	!	trt_selected = resolved_trt$selected
388		)
389		})
390
391		# reused in all modules
392	!	anl_q_output <- constr_anl_q(
393	!	session, input, data, dataname,
394	!	param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 1
395		)
396
397	!	anl_q <- anl_q_output()$value
398
399		# update sliders for axes taking constraints into account
400	!	data_state <- reactive({
401	!	get_data_range_states(
402	!	varname = input$yaxis_var,
403	!	paramname = input$xaxis_param,
404	!	ANL = anl_q()$ANL
405		)
406		})
407	!	yrange_slider <- toggle_slider_server("yrange_scale", data_state)
408	!	keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
409
410	!	horizontal_line <- srv_arbitrary_lines("hline_arb")
411
412	!	iv_r <- reactive({
413	!	iv <- shinyvalidate::InputValidator$new()
414
415	!	iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
416	!	iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
417	!	iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
418	!	iv$add_rule("yaxis_var", shinyvalidate::sv_required("Please select a Y-Axis variable"))
419	!	iv$add_rule("facet_ncol", plots_per_row_validate_rules())
420
421	!	iv$add_validator(horizontal_line()$iv_r())
422	!	iv$add_validator(anl_q_output()$iv_r())
423	!	iv$enable()
424	!	iv
425		})
426
427
428	!	plot_q <- debounce(reactive({
429	!	teal::validate_inputs(iv_r())
430	!	req(anl_q())
431		# nolint start
432	!	ylim <- yrange_slider$value
433	!	facet_ncol <- input$facet_ncol
434	!	facet_scales <- ifelse(input$free_x, "free_x", "fixed")
435
436	!	rotate_xlab <- input$rotate_xlab
437	!	hline_arb <- horizontal_line()$line_arb
438	!	hline_arb_label <- horizontal_line()$line_arb_label
439	!	hline_arb_color <- horizontal_line()$line_arb_color
440	!	group_stats <- input$group_stats
441	!	font_size <- input$font_size
442	!	dot_size <- input$dot_size
443	!	alpha <- input$alpha
444	!	validate(need(input$trt_group, "Please select a treatment variable"))
445	!	trt_group <- input$trt_group
446
447		# Below inputs should trigger plot via updates of other reactive objects (i.e. anl_q()) and some inputs
448	!	param <- input$xaxis_param
449	!	xaxis_var <- input$xaxis_var
450	!	yaxis_var <- input$yaxis_var
451	!	hline_vars <- input$hline_vars
452		# nolint end
453
454	!	private_qenv <- anl_q()$qenv
455
456		# this code is needed to make sure the waiver attribute
457		# of ggplot2::waiver is correctly passed to goshawk's spaghettiplot
458	!	if (!methods::is(xtick, "waiver")) {
459	!	private_qenv <- teal.code::eval_code(
460	!	object = private_qenv,
461	!	code = bquote(xtick <- .(xtick))
462		)
463		} else {
464	!	private_qenv <- teal.code::eval_code(
465	!	object = private_qenv,
466	!	code = quote(xtick <- ggplot2::waiver())
467		)
468		}
469
470	!	if (!methods::is(xlabel, "waiver")) {
471	!	private_qenv <- teal.code::eval_code(
472	!	object = private_qenv,
473	!	code = bquote(xlabel <- .(xlabel))
474		)
475		} else {
476	!	private_qenv <- teal.code::eval_code(
477	!	object = private_qenv,
478	!	code = quote(xlabel <- ggplot2::waiver())
479		)
480		}
481
482	!	teal.code::eval_code(
483	!	object = private_qenv,
484	!	code = bquote({
485	!	p <- goshawk::g_spaghettiplot(
486	!	data = ANL,
487	!	subj_id = .(idvar),
488	!	biomarker_var = .(param_var),
489	!	biomarker_var_label = .(param_var_label),
490	!	biomarker = .(param),
491	!	value_var = .(yaxis_var),
492	!	trt_group = .(trt_group),
493	!	trt_group_level = .(trt_group_level),
494	!	time = .(xaxis_var),
495	!	time_level = .(xaxis_var_level),
496	!	color_manual = .(man_color),
497	!	color_comb = .(color_comb),
498	!	ylim = .(ylim),
499	!	facet_ncol = .(facet_ncol),
500	!	facet_scales = .(facet_scales),
501	!	hline_arb = .(hline_arb),
502	!	hline_arb_label = .(hline_arb_label),
503	!	hline_arb_color = .(hline_arb_color),
504	!	xtick = xtick,
505	!	xlabel = xlabel,
506	!	rotate_xlab = .(rotate_xlab),
507	!	font_size = .(font_size),
508	!	dot_size = .(dot_size),
509	!	alpha = .(alpha),
510	!	group_stats = .(group_stats),
511	!	hline_vars = .(hline_vars),
512	!	hline_vars_colors = .(hline_vars_colors[seq_along(hline_vars)]),
513	!	hline_vars_labels = .(hline_vars_labels[seq_along(hline_vars)])
514		)
515	!	p
516		})
517		)
518	!	}), 800)
519
520	!	plot_r <- reactive({
521	!	plot_q()[["p"]]
522		})
523
524	!	plot_data <- teal.widgets::plot_with_settings_srv(
525	!	id = "plot",
526	!	plot_r = plot_r,
527	!	height = plot_height,
528	!	width = plot_width,
529	!	brushing = TRUE
530		)
531
532	!	code <- reactive(teal.code::get_code(plot_q()))
533
534		### REPORTER
535	!	if (with_reporter) {
536	!	card_fun <- function(comment, label) {
537	!	card <- report_card_template_goshawk(
538	!	title = "Spaghetti Plot",
539	!	label = label,
540	!	with_filter = with_filter,
541	!	filter_panel_api = filter_panel_api,
542	!	constraint_list = list(
543	!	constraint_var = input$constraint_var,
544	!	constraint_range_min = input$constraint_range_min,
545	!	constraint_range_max = input$constraint_range_max
546		)
547		)
548	!	card$append_text("Spaghetti Plot", "header3")
549	!	card$append_plot(plot_r(), dim = plot_data$dim())
550	!	if (!comment == "") {
551	!	card$append_text("Comment", "header3")
552	!	card$append_text(comment)
553		}
554	!	card$append_src(code())
555	!	card
556		}
557	!	teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
558		}
559		###
560
561	!	reactive_df <- debounce(reactive({
562	!	plot_brush <- plot_data$brush()
563
564	!	ANL <- isolate(anl_q()$ANL) # nolint
565	!	validate_has_data(ANL, 1)
566
567	!	xvar <- isolate(input$xaxis_var)
568	!	yvar <- isolate(input$yaxis_var)
569	!	trt_group <- isolate(input$trt_group)
570
571	!	req(all(c(xvar, yvar) %in% names(ANL)))
572
573	!	df <- teal.widgets::clean_brushedPoints(
574	!	dplyr::select(
575	!	ANL, "USUBJID", dplyr::all_of(trt_group), "PARAMCD",
576	!	dplyr::all_of(c(xvar, yvar)), "LOQFL"
577		),
578	!	plot_brush
579		)
580	!	df[order(df$PARAMCD, df[[trt_group]], df$USUBJID, df[[xvar]]), ]
581	!	}), 800)
582
583	!	output$brush_data <- DT::renderDataTable({
584	!	numeric_cols <- names(dplyr::select_if(reactive_df(), is.numeric))
585
586	!	DT::datatable(reactive_df(),
587	!	rownames = FALSE, options = list(scrollX = TRUE)
588		) %>%
589	!	DT::formatRound(numeric_cols, 4)
590		})
591
592	!	teal.widgets::verbatim_popup_srv(
593	!	id = "rcode",
594	!	verbatim_content = reactive(code()),
595	!	title = "Show R Code for Spaghetti Plot"
596		)
597		})
598		}

1		#' Density Distribution Plot
2		#'
3		#' This teal module renders the UI and calls the functions that create a density distribution plot
4		#' and an accompanying summary table.
5		#'
6		#' @param label menu item label of the module in the teal app.
7		#' @param trt_group \code{\link[teal.transform]{choices_selected}} object with available choices and pre-selected option
8		#' for variable names representing treatment group e.g. `ARM`.
9		#' @param color_manual vector of colors applied to treatment values.
10		#' @param color_comb name or hex value for combined treatment color.
11		#' @param plot_height controls plot height.
12		#' @param plot_width optional, controls plot width.
13		#' @param font_size font size control for title, `x-axis` label, `y-axis` label and legend.
14		#' @param line_size plot line thickness.
15		#' @param hline_arb numeric vector of at most 2 values identifying intercepts for arbitrary horizontal lines.
16		#' @param hline_arb_color a character vector of at most length of \code{hline_arb}.
17		#' naming the color for the arbitrary horizontal lines.
18		#' @param hline_arb_label a character vector of at most length of \code{hline_arb}.
19		#' naming the label for the arbitrary horizontal lines.
20		#' @param facet_ncol numeric value indicating number of facets per row.
21		#' @param comb_line display combined treatment line toggle.
22		#' @param rotate_xlab 45 degree rotation of `x-axis` values.
23		#' @param dataname analysis data passed to the data argument of \code{\link[teal]{init}}. E.g. `ADaM` structured
24		#' @param param_var name of variable containing biomarker codes e.g. \code{PARAMCD}.
25		#' @param param biomarker selected.
26		#' @param xaxis_var name of variable containing biomarker results displayed on `x-axis` e.g. \code{BASE}.
27		#'
28		#' @inheritParams teal.widgets::standard_layout
29		#' @inheritParams teal::module
30		#'
31		#'
32		#' @author Nick Paszty (npaszty) paszty.nicholas@gene.com
33		#' @author Balazs Toth (tothb2) toth.balazs@gene.com
34		#'
35		#' @details None
36		#'
37		#' @export
38		#'
39		#' @examples
40		#' # Example using ADaM structure analysis dataset.
41		#' data <- teal_data()
42		#' data <- within(data, {
43		#' library(dplyr)
44		#' library(stringr)
45		#'
46		#' # original ARM value = dose value
47		#' .arm_mapping <- list(
48		#' "A: Drug X" = "150mg QD",
49		#' "B: Placebo" = "Placebo",
50		#' "C: Combination" = "Combination"
51		#' )
52		#' set.seed(1) # @linksto ADSL ADLB
53		#' ADSL <- rADSL
54		#' ADLB <- rADLB
55		#' .var_labels <- lapply(ADLB, function(x) attributes(x)$label)
56		#' ADLB <- ADLB %>%
57		#' mutate(
58		#' AVISITCD = case_when(
59		#' AVISIT == "SCREENING" ~ "SCR",
60		#' AVISIT == "BASELINE" ~ "BL",
61		#' grepl("WEEK", AVISIT) ~ paste("W", str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
62		#' TRUE ~ as.character(NA)
63		#' ),
64		#' AVISITCDN = case_when(
65		#' AVISITCD == "SCR" ~ -2,
66		#' AVISITCD == "BL" ~ 0,
67		#' grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
68		#' TRUE ~ as.numeric(NA)
69		#' ),
70		#' AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
71		#' TRTORD = case_when(
72		#' ARMCD == "ARM C" ~ 1,
73		#' ARMCD == "ARM B" ~ 2,
74		#' ARMCD == "ARM A" ~ 3
75		#' ),
76		#' ARM = as.character(.arm_mapping[match(ARM, names(.arm_mapping))]),
77		#' ARM = factor(ARM) %>% reorder(TRTORD),
78		#' ACTARM = as.character(.arm_mapping[match(ACTARM, names(.arm_mapping))]),
79		#' ACTARM = factor(ACTARM) %>% reorder(TRTORD)
80		#' )
81		#'
82		#' attr(ADLB[["ARM"]], "label") <- .var_labels[["ARM"]]
83		#' attr(ADLB[["ACTARM"]], "label") <- .var_labels[["ACTARM"]]
84		#' })
85		#'
86		#' join_keys(data) <- default_cdisc_join_keys[names(data)]
87		#'
88		#' app <- init(
89		#' data = data,
90		#' modules = modules(
91		#' tm_g_gh_density_distribution_plot(
92		#' label = "Density Distribution Plot",
93		#' dataname = "ADLB",
94		#' param_var = "PARAMCD",
95		#' param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
96		#' xaxis_var = choices_selected(c("AVAL", "BASE", "CHG", "PCHG"), "AVAL"),
97		#' trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
98		#' color_manual = c(
99		#' "150mg QD" = "#000000",
100		#' "Placebo" = "#3498DB",
101		#' "Combination" = "#E74C3C"
102		#' ),
103		#' color_comb = "#39ff14",
104		#' comb_line = TRUE,
105		#' plot_height = c(500, 200, 2000),
106		#' font_size = c(12, 8, 20),
107		#' line_size = c(1, .25, 3),
108		#' hline_arb = c(.02, .05),
109		#' hline_arb_color = c("red", "black"),
110		#' hline_arb_label = c("Horizontal Line A", "Horizontal Line B")
111		#' )
112		#' )
113		#' )
114		#' if (interactive()) {
115		#' shinyApp(app$ui, app$server)
116		#' }
117		#'
118		tm_g_gh_density_distribution_plot <- function(label, # nolint
119		dataname,
120		param_var,
121		param,
122		xaxis_var,
123		trt_group,
124		color_manual = NULL,
125		color_comb = NULL,
126		plot_height = c(500, 200, 2000),
127		plot_width = NULL,
128		font_size = c(12, 8, 20),
129		line_size = c(1, .25, 3),
130		hline_arb = numeric(0),
131		hline_arb_color = "red",
132		hline_arb_label = "Horizontal line",
133		facet_ncol = 2L,
134		comb_line = TRUE,
135		rotate_xlab = FALSE,
136		pre_output = NULL,
137		post_output = NULL,
138		transformators = list()) {
139	!	message("Initializing tm_g_gh_density_distribution_plot")
140	!	checkmate::assert_string(label)
141	!	checkmate::assert_string(dataname)
142	!	checkmate::assert_string(param_var)
143	!	checkmate::assert_class(param, "choices_selected")
144	!	checkmate::assert_class(xaxis_var, "choices_selected")
145	!	checkmate::assert_class(trt_group, "choices_selected")
146	!	checkmate::assert_numeric(font_size, len = 3)
147	!	checkmate::assert_numeric(line_size, len = 3)
148	!	checkmate::assert_int(facet_ncol)
149	!	checkmate::assert_flag(comb_line)
150	!	checkmate::assert_flag(rotate_xlab)
151	!	validate_line_arb_arg(hline_arb, hline_arb_color, hline_arb_label)
152	!	checkmate::assert_numeric(plot_height, len = 3, any.missing = FALSE, finite = TRUE)
153	!	checkmate::assert_numeric(plot_height[1], lower = plot_height[2], upper = plot_height[3], .var.name = "plot_height")
154	!	checkmate::assert_numeric(plot_width, len = 3, any.missing = FALSE, null.ok = TRUE, finite = TRUE)
155	!	checkmate::assert_numeric(
156	!	plot_width[1],
157	!	lower = plot_width[2], upper = plot_width[3], null.ok = TRUE, .var.name = "plot_width"
158		)
159
160	!	args <- as.list(environment())
161
162	!	module(
163	!	label = label,
164	!	datanames = dataname,
165	!	server = srv_g_density_distribution_plot,
166	!	server_args = list(
167	!	dataname = dataname,
168	!	param_var = param_var,
169	!	param = param,
170	!	color_manual = color_manual,
171	!	color_comb = color_comb,
172	!	plot_height = plot_height,
173	!	plot_width = plot_width,
174	!	module_args = args
175		),
176	!	ui = ui_g_density_distribution_plot,
177	!	ui_args = args,
178	!	transformators = transformators
179		)
180		}
181
182		ui_g_density_distribution_plot <- function(id, ...) {
183	!	ns <- NS(id)
184	!	a <- list(...)
185
186	!	teal.widgets::standard_layout(
187	!	output = bslib::page_fluid(
188	!	tags$div(
189	!	teal.widgets::plot_with_settings_ui(id = ns("plot"))
190		),
191	!	tags$div(
192	!	tags$br(), tags$hr(),
193	!	tags$h4("Descriptive Statistics"),
194	!	DT::dataTableOutput(ns("table_ui"))
195		)
196		),
197	!	encoding = tags$div(
198		### Reporter
199	!	teal.reporter::add_card_button_ui(ns("add_reporter"), label = "Add Report Card"),
200	!	tags$br(), tags$br(),
201		###
202	!	templ_ui_dataname(a$dataname),
203	!	uiOutput(ns("axis_selections")),
204	!	templ_ui_constraint(ns, label = "Data Constraint"),
205	!	ui_arbitrary_lines(id = ns("hline_arb"), a$hline_arb, a$hline_arb_label, a$hline_arb_color),
206	!	bslib::accordion(
207	!	bslib::accordion_panel(
208	!	title = "Plot Aesthetic Settings",
209	!	toggle_slider_ui(
210	!	ns("xrange_scale"),
211	!	label = "X-Axis Range Zoom"
212		),
213	!	toggle_slider_ui(
214	!	ns("yrange_scale"),
215	!	label = "Y-Axis Range Zoom"
216		),
217	!	numericInput(ns("facet_ncol"), "Number of Plots Per Row:", a$facet_ncol, min = 1),
218	!	checkboxInput(ns("comb_line"), "Display Combined line", a$comb_line),
219	!	checkboxInput(ns("rug_plot"), "Include rug plot", value = FALSE),
220	!	checkboxInput(ns("rotate_xlab"), "Rotate X-axis Label", a$rotate_xlab)
221		),
222	!	bslib::accordion_panel(
223	!	title = "Plot settings",
224	!	teal.widgets::optionalSliderInputValMinMax(ns("font_size"), "Font Size", a$font_size, ticks = FALSE),
225	!	teal.widgets::optionalSliderInputValMinMax(
226	!	ns("line_size"),
227	!	"Line Size",
228	!	value_min_max = a$line_size,
229	!	step = .25,
230	!	ticks = FALSE
231		)
232		)
233		)
234		),
235	!	forms = tagList(
236	!	teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
237		),
238	!	pre_output = a$pre_output,
239	!	post_output = a$post_output
240		)
241		}
242
243		srv_g_density_distribution_plot <- function(id, # nolint
244		data,
245		reporter,
246		filter_panel_api,
247		dataname,
248		param_var,
249		param,
250		trt_group,
251		color_manual,
252		color_comb,
253		plot_height,
254		plot_width,
255		module_args) {
256	!	with_reporter <- !missing(reporter) && inherits(reporter, "Reporter")
257	!	with_filter <- !missing(filter_panel_api) && inherits(filter_panel_api, "FilterPanelAPI")
258	!	checkmate::assert_class(data, "reactive")
259	!	checkmate::assert_class(shiny::isolate(data()), "teal_data")
260
261	!	moduleServer(id, function(input, output, session) {
262	!	teal.logger::log_shiny_input_changes(input, namespace = "teal.goshawk")
263	!	output$axis_selections <- renderUI({
264	!	env <- shiny::isolate(as.list(data()[[".raw_data"]]))
265	!	resolved_x <- teal.transform::resolve_delayed(module_args$xaxis_var, env)
266	!	resolved_param <- teal.transform::resolve_delayed(module_args$param, env)
267	!	resolved_trt <- teal.transform::resolve_delayed(module_args$trt_group, env)
268
269	!	templ_ui_params_vars(
270	!	session$ns,
271	!	xparam_choices = resolved_param$choices,
272	!	xparam_selected = resolved_param$selected,
273	!	xparam_label = "Select a Biomarker",
274	!	xchoices = resolved_x$choices,
275	!	xselected = resolved_x$selected,
276	!	trt_choices = resolved_trt$choices,
277	!	trt_selected = resolved_trt$selected
278		)
279		})
280
281	!	anl_q_output <- constr_anl_q(
282	!	session, input, data, dataname,
283	!	param_id = "xaxis_param", param_var = param_var, trt_group = input$trt_group, min_rows = 2
284		)
285
286	!	anl_q <- anl_q_output()$value
287
288		# update sliders for axes taking constraints into account
289	!	data_state_x <- reactive({
290	!	get_data_range_states(
291	!	varname = input$xaxis_var,
292	!	paramname = input$xaxis_param,
293	!	ANL = anl_q()$ANL
294		)
295		})
296	!	xrange_slider <- toggle_slider_server("xrange_scale", data_state_x)
297	!	data_state_y <- reactive({
298	!	get_data_range_states(
299	!	varname = input$xaxis_var,
300	!	paramname = input$xaxis_param,
301	!	ANL = anl_q()$ANL,
302	!	trt_group = "trt_group"
303		)
304		})
305	!	yrange_slider <- toggle_slider_server("yrange_scale", data_state_y)
306
307	!	keep_data_const_opts_updated(session, input, anl_q, "xaxis_param")
308
309	!	horizontal_line <- srv_arbitrary_lines("hline_arb")
310
311	!	iv_r <- reactive({
312	!	iv <- shinyvalidate::InputValidator$new()
313
314	!	iv$add_rule("xaxis_param", shinyvalidate::sv_required("Please select a biomarker"))
315	!	iv$add_rule("trt_group", shinyvalidate::sv_required("Please select a treatment variable"))
316	!	iv$add_rule("xaxis_var", shinyvalidate::sv_required("Please select an X-Axis variable"))
317	!	iv$add_rule("facet_ncol", plots_per_row_validate_rules())
318
319	!	iv$add_validator(horizontal_line()$iv_r())
320	!	iv$add_validator(anl_q_output()$iv_r())
321	!	iv$enable()
322	!	iv
323		})
324
325
326	!	create_plot <- debounce(reactive({
327	!	teal::validate_inputs(iv_r())
328	!	req(anl_q())
329
330		# nolint start
331	!	param <- input$xaxis_param
332	!	xaxis_var <- input$xaxis_var
333	!	xlim <- xrange_slider$value
334	!	ylim <- yrange_slider$value
335	!	font_size <- input$font_size
336	!	line_size <- input$line_size
337	!	hline_arb <- horizontal_line()$line_arb
338	!	hline_arb_label <- horizontal_line()$line_arb_label
339	!	hline_arb_color <- horizontal_line()$line_arb_color
340	!	facet_ncol <- input$facet_ncol
341
342	!	comb_line <- input$comb_line
343	!	rug_plot <- input$rug_plot
344	!	rotate_xlab <- input$rotate_xlab
345	!	trt_group <- input$trt_group
346		# nolint end
347
348
349	!	teal.code::eval_code(
350	!	object = anl_q()$qenv,
351	!	code = bquote({
352	!	p <- goshawk::g_density_distribution_plot(
353	!	data = ANL,
354	!	param_var = .(param_var),
355	!	param = .(param),
356	!	xaxis_var = .(xaxis_var),
357	!	trt_group = .(trt_group),
358	!	xlim = .(xlim),
359	!	ylim = .(ylim),
360	!	color_manual = .(color_manual),
361	!	color_comb = .(color_comb),
362	!	font_size = .(font_size),
363	!	line_size = .(line_size),
364	!	facet_ncol = .(facet_ncol),
365	!	comb_line = .(comb_line),
366	!	hline_arb = .(hline_arb),
367	!	hline_arb_label = .(hline_arb_label),
368	!	hline_arb_color = .(hline_arb_color),
369	!	rug_plot = .(rug_plot)
370		)
371	!	p
372		})
373		)
374	!	}), 800)
375
376	!	create_table <- debounce(reactive({
377	!	req(iv_r()$is_valid())
378	!	req(anl_q())
379	!	param <- input$xaxis_param
380	!	xaxis_var <- input$xaxis_var
381	!	font_size <- input$font_size
382	!	trt_group <- input$trt_group
383
384	!	teal.code::eval_code(
385	!	object = anl_q()$qenv,
386	!	code = bquote({
387	!	tbl <- goshawk::t_summarytable(
388	!	data = ANL,
389	!	trt_group = .(trt_group),
390	!	param_var = .(param_var),
391	!	param = .(param),
392	!	xaxis_var = .(xaxis_var),
393	!	font_size = .(font_size)
394		)
395	!	tbl
396		})
397		)
398	!	}), 800)
399
400	!	plot_r <- reactive({
401	!	create_plot()[["p"]]
402		})
403
404	!	plot_data <- teal.widgets::plot_with_settings_srv(
405	!	id = "plot",
406	!	plot_r = plot_r,
407	!	height = plot_height,
408	!	width = plot_width,
409		)
410
411	!	output$table_ui <- DT::renderDataTable({
412	!	req(create_table())
413	!	tbl <- create_table()[["tbl"]]
414	!	numeric_cols <- names(dplyr::select_if(tbl, is.numeric))
415
416	!	DT::datatable(tbl,
417	!	rownames = FALSE, options = list(scrollX = TRUE)
418		) %>%
419	!	DT::formatRound(numeric_cols, 2)
420		})
421
422	!	joined_qenvs <- reactive({
423	!	req(create_plot(), create_table())
424	!	c(create_plot(), create_table())
425		})
426
427	!	code <- reactive(teal.code::get_code(joined_qenvs()))
428
429	!	teal.widgets::verbatim_popup_srv(
430	!	id = "rcode",
431	!	verbatim_content = reactive(code()),
432	!	title = "Show R Code for Density Distribution Plot"
433		)
434
435		### REPORTER
436	!	if (with_reporter) {
437	!	card_fun <- function(comment, label) {
438	!	card <- report_card_template_goshawk(
439	!	title = "Density Distribution Plot",
440	!	label = label,
441	!	with_filter = with_filter,
442	!	filter_panel_api = filter_panel_api,
443	!	constraint_list = list(
444	!	constraint_var = input$constraint_var,
445	!	constraint_range_min = input$constraint_range_min,
446	!	constraint_range_max = input$constraint_range_max
447		)
448		)
449	!	card$append_text("Plot", "header3")
450	!	card$append_plot(plot_r(), dim = plot_data$dim())
451	!	card$append_text("Descriptive Statistics", "header3")
452	!	card$append_table(
453	!	create_table()[["tbl"]] %>% dplyr::mutate_if(is.numeric, round, 2)
454		)
455	!	if (!comment == "") {
456	!	card$append_text("Comment", "header3")
457	!	card$append_text(comment)
458		}
459	!	card$append_src(code())
460	!	card
461		}
462	!	teal.reporter::add_card_button_srv("add_reporter", reporter = reporter, card_fun = card_fun)
463		}
464		###
465		})
466		}

1		templ_ui_output_datatable <- function(ns) {
2	!	bslib::page_fluid(
3	!	teal.widgets::plot_with_settings_ui(id = ns("plot")),
4	!	tags$br(), tags$hr(),
5	!	tags$h4("Selected Data Points"),
6	!	tags$div(
7	!	DT::dataTableOutput(ns("brush_data"))
8		)
9		)
10		}
11
12		templ_ui_dataname <- function(dataname) {
13	12x	tags$label(dataname, "Data Settings", class = "text-primary")
14		}
15
16		# UI to create params (biomarker, value of PARAMCD) and vars (column, e.g. AVAL column) select fields for x and y
17		templ_ui_params_vars <- function(ns,
18		# x
19		xparam_choices = NULL,
20		xparam_selected = NULL,
21		xparam_label = NULL, # biomarker, e.g. ALT
22		xchoices = NULL,
23		xselected = NULL,
24		xvar_label = NULL, # variable, e.g. AVAL
25		# y
26		yparam_choices = NULL,
27		yparam_selected = NULL,
28		yparam_label = NULL, # biomarker, e.g. ALT
29		ychoices = NULL,
30		yselected = NULL,
31		yvar_label = NULL, # variable, e.g. AVAL
32		# facet_var
33		facet_choices = NULL,
34		facet_selected = NULL,
35		# trt_group
36		trt_choices = NULL,
37		trt_selected = NULL,
38		multiple = FALSE) {
39	6x	if (is.null(xparam_choices) && !is.null(xchoices) && !is.null(yparam_choices)) {
40		# otherwise, xchoices will appear first without any biomarker to select and this looks odd in the UI
41	!	stop(
42	!	"You have to specify xparam choices rather than yparamchoices
43	!	if both xvar and yvar should be values for the same biomarker."
44		)
45		}
46	6x	tagList(
47	6x	if (!is.null(trt_choices)) {
48	6x	teal.widgets::optionalSelectInput(
49	6x	ns("trt_group"),
50	6x	label = "Select Treatment Variable",
51	6x	choices = trt_choices,
52	6x	selected = trt_selected,
53	6x	multiple = FALSE
54		)
55		},
56	6x	if (!is.null(xparam_choices)) {
57	6x	teal.widgets::optionalSelectInput(
58	6x	ns("xaxis_param"),
59	6x	`if`(is.null(xparam_label), "Select an X-Axis Biomarker", xparam_label),
60	6x	xparam_choices,
61	6x	`if`(is.null(xparam_selected), xparam_choices[1], xparam_selected),
62	6x	multiple = FALSE
63		)
64		},
65	6x	if (!is.null(xchoices)) {
66	6x	teal.widgets::optionalSelectInput(
67	6x	ns("xaxis_var"),
68	6x	`if`(is.null(xvar_label), "Select an X-Axis Variable", xvar_label),
69	6x	xchoices, xselected,
70	6x	multiple = multiple
71		)
72		},
73	6x	if (!is.null(yparam_choices)) {
74	!	teal.widgets::optionalSelectInput(
75	!	ns("yaxis_param"),
76	!	`if`(is.null(yparam_label), "Select an Y-Axis Biomarker", yparam_label),
77	!	yparam_choices,
78	!	`if`(is.null(yparam_selected), yparam_choices[1], yparam_selected),
79	!	multiple = FALSE
80		)
81		},
82	6x	if (!is.null(ychoices)) {
83	6x	teal.widgets::optionalSelectInput(
84	6x	ns("yaxis_var"),
85	6x	`if`(is.null(yvar_label), "Select a Y-Axis Variable", yvar_label),
86	6x	ychoices, yselected,
87	6x	multiple = multiple
88		)
89		},
90	6x	if (!is.null(facet_choices)) {
91	6x	teal.widgets::optionalSelectInput(
92	6x	ns("facet_var"),
93	6x	label = "Facet by",
94	6x	choices = facet_choices,
95	6x	selected = facet_selected,
96	6x	multiple = FALSE
97		)
98		}
99		)
100		}

1		#' helper for writing arm mapping and ordering code.
2		#'
3		#' Provides lines of code for left hand side of arm mapping. user must provide right hand side
4		#'
5		#' @details SPA configure study specific pre-processing for deploying `goshawk`. writing the code for `ARM` mapping and
6		#' ordering is tedious. this function helps to get that started by providing the left hand side of the
7		#' mapping and ordering syntax. call the function and then copy and paste the resulting code from the console
8		#' into the app.R file.
9		#'
10		#' @param df_armvar the dataframe and column name containing treatment code. e.g. `ADSL$ARMCD`
11		#' @param code controls whether mapping or ordering code is written to console. Valid values: `"M"` and `"O"`.
12		#'
13		#' @export
14		#'
15		#' @examples
16		#' ADSL <- rADSL
17		#'
18		#' # get treatment mapping code
19		#' maptrt(df_armvar = ADSL$ARMCD, code = "M")
20		#'
21		#' # get treatment ordering code
22		#' maptrt(df_armvar = ADSL$ARMCD, code = "O")
23		maptrt <- function(df_armvar, code = c("M", "O")) {
24	!	code <- match.arg(code)
25
26		# get arm variable
27	!	trtvar <- strsplit(deparse(substitute(df_armvar)), "[$]")[[1]][2]
28
29	!	dftrt <- data.frame(unique(df_armvar)) %>%
30	!	dplyr::mutate(trt_mapping = paste0("\"", unique(df_armvar), "\"", " = \"\",")) %>%
31	!	dplyr::mutate(trt_ordering = paste0(eval(trtvar), " == \"", unique(df_armvar), "\"", " ~ ,"))
32
33	!	if (toupper(code) == "M") {
34	!	print(unname(dftrt["trt_mapping"]), row.names = FALSE)
35	!	} else if (toupper(code) == "O") {
36	!	print(unname(dftrt["trt_ordering"]), row.names = FALSE)
37		}
38		}

1		plots_per_row_validate_rules <- function(required = TRUE) {
2	6x	msg <- "Number of plots per row must be a positive integer"
3	6x	shinyvalidate::compose_rules(
4	6x	if (required) {
5	!	shinyvalidate::sv_required(msg)
6		} else {
7	6x	shinyvalidate::sv_optional()
8		},
9	6x	shinyvalidate::sv_integer(msg),
10	6x	shinyvalidate::sv_gt(0, message_fmt = msg)
11		)
12		}
13
14		#' Template Function for `TealReportCard` Creation and Customization in `teal.goshawk`
15		#'
16		#' This function generates a report card with a title,
17		#' an optional description, and the option to append the filter state list.
18		#' Additionally, it display selected constraint options.
19		#'
20		#' @inheritParams teal::report_card_template
21		#' @param constraint_list (`list`) a list containing constraint variables, including:
22		#' - constraint_var (`character(1)`) the constraint variable name.
23		#' - constraint_range_min (`numeric(1)`) the minimum constraint range value.
24		#' - constraint_range_max (`numeric(1)`) the maximum constraint range value.
25		#' @param constraint_description (`character(1)`) description of the constraints.
26		#' @param style (`character(1)`) style of the constraint text block.
27		#' options: `default`, `verbatim` (default is `default`).
28		#'
29		#' @return (`TealReportCard`) populated with a title, description, and filter state
30		#'
31		#' @keywords internal
32		report_card_template_goshawk <- function(title,
33		label,
34		with_filter,
35		filter_panel_api,
36		constraint_list,
37		constraint_description = NULL,
38		style = "default") {
39	!	checkmate::assert_subset(names(constraint_list), c("constraint_var", "constraint_range_min", "constraint_range_max"))
40	!	checkmate::assert_string(constraint_description, null.ok = TRUE)
41	!	checkmate::assert_choice(style, c("default", "verbatim"))
42
43	!	card <- teal::report_card_template(
44	!	title = title,
45	!	label = label,
46	!	with_filter = with_filter,
47	!	filter_panel_api = filter_panel_api
48		)
49
50	!	card$append_text("Selected Options", "header3")
51	!	card$append_text(
52	!	paste(
53	!	formatted_data_constraint(
54	!	constraint_list$constraint_var,
55	!	constraint_list$constraint_range_min,
56	!	constraint_list$constraint_range_max
57		),
58	!	constraint_description
59		),
60	!	style = style
61		)
62	!	card
63		}
64
65		#' Get Choices
66		#'
67		#' This function returns choices based on the class of the input.
68		#' If the input is of class `delayed_data`, it returns the `subset` of the input.
69		#' If `subset` is NULL and the input contains `var_label` and `var_choices`,
70		#' it throws an error prompting to resolve delayed inputs.
71		#' Otherwise, it returns the input as is.
72		#'
73		#' @param choices An object that contains choices.
74		#' @return A vector of choices.
75		#' @keywords internal
76		get_choices <- function(choices) {
77	!	if (inherits(choices, "delayed_data")) {
78	!	if (is.null(choices$subset)) {
79	!	if (!is.null(choices$var_label) && !is.null(choices$var_choices)) {
80	!	stop(
81	!	"Resolve delayed inputs by evaluating the code within the provided datasets.
82	!	Check ?teal.transform::resolve_delayed for more information."
83		)
84		} else {
85	!	stop("Subset is NULL and necessary fields are missing.")
86		}
87		} else {
88	!	choices$subset
89		}
90		} else {
91	!	choices
92		}
93		}

1		.onLoad <- function(libname, pkgname) { # nolint
2	!	teal.logger::register_logger(namespace = "teal.goshawk")
3	!	teal.logger::register_handlers("teal.goshawk")
4		}

1		#' Scatter Plot Teal Module For Biomarker Analysis
2		#'
3		#' @description
4		#' `r lifecycle::badge("deprecated")`
5		#'
6		#' `tm_g_gh_scatterplot` is deprecated.
7		#' Please use [tm_g_gh_correlationplot] instead.
8		#'
9		#' @param ... function is deprecated.
10		#'
11		#' @export
12		tm_g_gh_scatterplot <- function(...) {
13	!	lifecycle::deprecate_stop(
14	!	when = "0.1.15",
15	!	what = "tm_g_gh_scatterplot()",
16	!	details = "You should use teal.goshawk::tm_g_gh_correlationplot instead of teal.goshawk::tm_g_gh_scatterplot"
17		)
18		}