#' Creates `ggplot2_args` object

#'

#' @description `r lifecycle::badge("experimental")`

#' Constructor of `ggplot2_args` class of objects.

#' The `ggplot2_args` argument should be a part of every module which contains any `ggplot2` graphics.

#' The function arguments are validated to match their `ggplot2` equivalents.

#'

#' For more details see the vignette: `vignette("custom-ggplot2-arguments", package = "teal.widgets")`.

#'

#' @seealso

#' * [resolve_ggplot2_args()] to resolve multiple objects into one using pre-defined priorities.

#' * [parse_ggplot2_args()] to parse resolved list into list of calls.

#'

#' @param labs (named `list`)\cr

#'  where all fields have to match [ggplot2::labs()] arguments.

#' @param theme (named `list`)\cr

#'  where all fields have to match [ggplot2::theme()] arguments.

#'

#' @return (`ggplot2_args`) object.

#' @export

#' @examples

#' ggplot2_args(

#'   labs = list(title = "TITLE"),

#'   theme = list(title = ggplot2::element_text(size = 20))

#' )

ggplot2_args <- function(labs = list(), theme = list()) {

  # utils::getFromNamespace is not recommended nevertheless needed as it is replacing `:::`.

  # usage of static values will be vulnerable to any changes in ggplot2 aesthetics.

  )

}

#' Resolving and reducing multiple `ggplot2_args` objects

#'

#' @description `r lifecycle::badge("experimental")`

#' Resolving and reducing multiple `ggplot2_args` objects.

#' This function is intended to utilize user provided settings, defaults provided by the module creator and

#' also `teal` option. See `Details`, below, to understand the logic.

#'

#' @seealso [parse_ggplot2_args()] to parse resolved list into list of calls.

#'

#' @param user_plot (`ggplot2_args`)\cr

#'  end user setup for theme and labs in the specific plot.

#'  Created with the [ggplot2_args()] function. The `NULL` value is supported.

#' @param user_default (`ggplot2_args`)\cr

#'  end user setup for module default theme and labs.

#'  Created with the [ggplot2_args()] function. The `NULL` value is supported.

#' @param module_plot (`ggplot2_args`)\cr

#'  module creator setup for theme and labs in the specific plot.

#'  Created with the [ggplot2_args()] function. The `NULL` value is supported.

#' @param app_default (`ggplot2_args`)\cr

#'  Application level setting. Can be `NULL`.

#'

#' @return `ggplot2_args` object.

#'

#' @details

#' The function picks the first non `NULL` value for each argument, checking in the following order:

#' 1. `ggplot2_args` argument provided by the end user.

#' Per plot (`user_plot`) and then default (`user_default`) setup.

#' 2. `app_default` global R variable, `teal.ggplot2_args`.

#' 3. `module_plot` which is a module creator setup.

#' @export

#' @examples

#' resolve_ggplot2_args(

#'   user_plot = ggplot2_args(

#'     labs = list(title = "TITLE"),

#'     theme = list(title = ggplot2::element_text(size = 20))

#'   ),

#'   user_default = ggplot2_args(

#'     labs = list(x = "XLAB")

#'   )

#' )

resolve_ggplot2_args <- function(user_plot = ggplot2_args(),

                                 user_default = ggplot2_args(),

                                 module_plot = ggplot2_args(),

                                 app_default = getOption("teal.ggplot2_args", ggplot2_args())) {

  )

}

#' Parse `ggplot2_args` object into the `ggplot2` expression

#'

#' @description `r lifecycle::badge("experimental")`

#' A function to parse expression from the `ggplot2_args` object.

#' @param ggplot2_args (`ggplot2_args`)\cr

#'  This argument could be a result of the [resolve_ggplot2_args()].

#' @param ggtheme (`character(1)`)\cr

#'  name of the `ggplot2` theme to be applied, e.g. `"dark"`.

#'

#' @return (`list`) of up to three elements of class `languange`: `"labs"`, `"ggtheme"` and `"theme"`.

#' @export

#' @examples

#' parse_ggplot2_args(

#'   resolve_ggplot2_args(ggplot2_args(

#'     labs = list(title = "TITLE"),

#'     theme = list(title = ggplot2::element_text(size = 20))

#'   ))

#' )

#'

#' parse_ggplot2_args(

#'   resolve_ggplot2_args(

#'     ggplot2_args(

#'       labs = list(title = "TITLE"),

#'       theme = list(title = ggplot2::element_text(size = 20))

#'     )

#'   ),

#'   ggtheme = "gray"

#' )

parse_ggplot2_args <- function(ggplot2_args = teal.widgets::ggplot2_args(),

                               ggtheme = c(

                                 "default",

                                 "gray",

                                 "bw",

                                 "linedraw",

                                 "light",

                                 "dark",

                                 "minimal",

                                 "classic",

                                 "void",

                                 "test"

                               )) {

  } else {

  }

  } else {

  }

  } else {

  }

  # For empty final_list we want to return empty list, not empty named list

}

#' @keywords internal

#' @noRd

optional_select_input_deps <- function() {

  )

}

#' Wrapper for `pickerInput`

#'

#' @description `r lifecycle::badge("stable")`

#' Wrapper for [shinyWidgets::pickerInput()] with additional features.

#' When `fixed = TRUE` or when the number of `choices` is less or equal to 1 (see `fixed_on_single`),

#' the `pickerInput` widget is hidden and non-interactive widget will be displayed

#' instead. Toggle of `HTML` elements is just the visual effect to avoid displaying

#' `pickerInput` widget when there is only one choice.

#'

#' @inheritParams shinyWidgets::pickerInput

#'

#' @param sep (`character(1)`)\cr

#'  A separator string to split the `choices` or `selected` inputs into the values of the different

#'  columns.

#'

#' @param label_help (`shiny.tag`) optional,\cr

#'  e.g. an object returned by [shiny::helpText()].

#'

#' @param fixed (`logical(1)`) optional,\cr

#'  whether to block user to select choices.

#'

#' @param fixed_on_single (`logical(1)`) optional,\cr

#'  whether to block user to select a choice when there is only one or less choice.

#'  When `FALSE`, user is still able to select or deselect the choice.

#'

#' @param width (`character(1)`)\cr

#'  The width of the input passed to `pickerInput`  e.g. `'auto'`, `'fit'`, `'100px'` or `'75%'`

#'

#' @return (`shiny.tag`) HTML tag with `pickerInput` widget and

#'  non-interactive element listing selected values.

#'

#' @export

#'

#' @examples

#' library(shiny)

#'

#' # Create a minimal example data frame

#' data <- data.frame(

#'   AGE = c(25, 30, 40, 35, 28),

#'   SEX = c("Male", "Female", "Male", "Female", "Male"),

#'   PARAMCD = c("Val1", "Val2", "Val3", "Val4", "Val5"),

#'   PARAM = c("Param1", "Param2", "Param3", "Param4", "Param5"),

#'   AVISIT = c("Visit1", "Visit2", "Visit3", "Visit4", "Visit5"),

#'   stringsAsFactors = TRUE

#' )

#'

#' ui_grid <- function(...) {

#'   fluidPage(

#'     fluidRow(

#'       lapply(list(...), function(x) column(4, wellPanel(x)))

#'     )

#'   )

#' }

#'

#' ui <- ui_grid(

#'   tags$div(

#'     optionalSelectInput(

#'       inputId = "c1",

#'       label = "Fixed choices",

#'       choices = LETTERS[1:5],

#'       selected = c("A", "B"),

#'       fixed = TRUE

#'     ),

#'     verbatimTextOutput(outputId = "c1_out")

#'   ),

#'   tags$div(

#'     optionalSelectInput(

#'       inputId = "c2",

#'       label = "Single choice",

#'       choices = "A",

#'       selected = "A"

#'     ),

#'     verbatimTextOutput(outputId = "c2_out")

#'   ),

#'   tags$div(

#'     optionalSelectInput(

#'       inputId = "c3",

#'       label = "NULL choices",

#'       choices = NULL

#'     ),

#'     verbatimTextOutput(outputId = "c3_out")

#'   ),

#'   tags$div(

#'     optionalSelectInput(

#'       inputId = "c4",

#'       label = "Default",

#'       choices = LETTERS[1:5],

#'       selected = "A"

#'     ),

#'     verbatimTextOutput(outputId = "c4_out")

#'   ),

#'   tags$div(

#'     optionalSelectInput(

#'       inputId = "c5",

#'       label = "Named vector",

#'       choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"),

#'       selected = "A"

#'     ),

#'     verbatimTextOutput(outputId = "c5_out")

#'   ),

#'   tags$div(

#'     selectInput(

#'       inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE

#'     ),

#'     optionalSelectInput(

#'       inputId = "c6",

#'       label = "Updated choices",

#'       choices = NULL,

#'       multiple = TRUE,

#'       fixed_on_single = TRUE

#'     ),

#'     verbatimTextOutput(outputId = "c6_out")

#'   )

#' )

#'

#' server <- function(input, output, session) {

#'   observeEvent(input$c6_choices, ignoreNULL = FALSE, {

#'     updateOptionalSelectInput(

#'       session = session,

#'       inputId = "c6",

#'       choices = input$c6_choices,

#'       selected = input$c6_choices

#'     )

#'   })

#'

#'   output$c1_out <- renderPrint(input$c1)

#'   output$c2_out <- renderPrint(input$c2)

#'   output$c3_out <- renderPrint(input$c3)

#'   output$c4_out <- renderPrint(input$c4)

#'   output$c5_out <- renderPrint(input$c5)

#'   output$c6_out <- renderPrint(input$c6)

#' }

#'

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

optionalSelectInput <- function(inputId, # nolint

                                label = NULL,

                                choices = NULL,

                                selected = NULL,

                                multiple = FALSE,

                                sep = NULL,

                                options = list(),

                                label_help = NULL,

                                fixed = FALSE,

                                fixed_on_single = FALSE,

                                width = NULL) {

  )

  )

  )

  }

  )

  # if called outside the fluidPage then will assume bs 3

  } else {

  }

  }

    # visibility feature marked with display: none/block instead of shinyjs::hide/show

    #  as mechanism to hide/show is handled by javascript code

    )

  )

  }

    # visibility feature marked with display: none/block instead of shinyjs::hide/show

    #  as mechanism to hide/show is handled by javascript code

    # selected values as verbatim text

      } else {

      }

    ),

  )

    # when selected values in ui_picker change

    # then update ui_fixed - specifically, update '{id}_selected_text' element

        "

          })

        })",

      )

    ),

    # if ui_picker has only one or less option or is fixed then hide {id}_input and show {id}_fixed

            } else {

            }

          })

        })",

      )

    },

  )

}

#' @rdname optionalSelectInput

#' @param session (`shiny.session`)\cr

#' @export

updateOptionalSelectInput <- function(session, # nolint

                                      inputId, # nolint

                                      label = NULL,

                                      selected = NULL,

                                      choices = NULL) {

  # update picker input

  )

}

#' Get icons to represent variable types in dataset

#'

#' @param var_type (`character`)\cr

#'  of R internal types (classes).

#'

#' @return (`character`)\cr

#'  vector of HTML icons corresponding to  data type in each column.

#' @keywords internal

#'

variable_type_icons <- function(var_type) {

  )

      } else {

      }

    }

  ))

}

#' Optional content for `optionalSelectInput`

#'

#' Prepares content to be displayed in `optionalSelectInput` with icons and labels

#'

#' @param var_name (`character`)\cr

#'  variable name

#' @param var_label (`character`)\cr

#'  variable alternative name - for example variable label

#' @param var_type (`character`)

#' class of the variable.

#'

#' @return (`character`) HTML contents with all elements combined

#' @keywords internal

#'

picker_options_content <- function(var_name, var_label, var_type) {

  }

  }

  )

      },

    )

  ))

}

#' Create `choicesOpt` for `pickerInput`

#'

#' @param choices (`choices_labeled` or `character`)\cr

#'  choices vector

#'

#' @return (`list`)\cr

#'  to be passed as `choicesOpt` argument.

#' @keywords internal

picker_options <- function(choices) {

        )

      )

    )

      ))

    )

  } else {

  }

}

#' Extract raw values from choices

#'

#' @param choices (`choices_labeled`, `list` or `character`)\cr

#'  object containing choices

#' @param sep (`character(1)`)\cr

#'  A separator string to split the `choices` or `selected` inputs into the values of

#'  the different columns.

#' @return choices simplified

#' @keywords internal

extract_raw_choices <- function(choices, sep) {

  } else {

  }

}

#' if min or max are `NA` then the slider widget will be hidden

#'

#' @description `r lifecycle::badge("stable")`\cr

#' Hidden input widgets are useful to have the `input[[inputId]]` variable

#' on available in the server function but no corresponding visual clutter from

#' input widgets that provide only a single choice.

#'

#' @inheritParams shiny::sliderInput

#' @param label_help (`shiny.tag`) optional\cr

#'  object of class `shiny.tag`, e.g. an object returned by [shiny::helpText()]

#' @param ... optional arguments to `sliderInput`

#'

#' @return (`shiny.tag`) HTML tag with `sliderInput` widget.

#'

#' @export

#'

#' @examples

#' optionalSliderInput("a", "b", 0, 1, 0.2)

optionalSliderInput <- function(inputId, label, min, max, value, label_help = NULL, ...) { # nolint

  } else {

  }

  }

  }

  }

  }

  } else {

  }

}

#' For `teal` modules we parameterize an `optionalSliderInput` with one argument

#' `value_min_max`

#'

#' @description `r lifecycle::badge("stable")`

#' The [optionalSliderInput()] function needs three arguments to determine

#' whether to hide the `sliderInput` widget or not. For `teal` modules we specify an

#' optional slider input with one argument here called `value_min_max`.

#'

#' @inheritParams optionalSliderInput

#'

#' @param value_min_max (`numeric(1)` or `numeric(3)`)\cr

#'  If of length 1 then the value gets set to that number and the `sliderInput` will be hidden.

#'  Otherwise, if it is of length three the three elements will map to `value`, `min` and `max` of

#'  the [optionalSliderInput()] function.

#'

#' @return (`shiny.tag`) HTML tag with range `sliderInput` widget.

#'

#' @export

#'

#' @examples

#'

#' optionalSliderInputValMinMax("a", "b", 1)

#' optionalSliderInputValMinMax("a", "b", c(3, 1, 5))

optionalSliderInputValMinMax <- function(inputId, label, value_min_max, label_help = NULL, ...) { # nolint

    ),

    )

  )

  }

  }

}

#' Extract labels from choices basing on attributes and names

#'

#' @param choices (`list` or `vector`)\cr

#'  select choices

#' @param values optional\cr

#'  choices subset for which labels should be extracted, `NULL` for all choices.

#'

#' @return (`character`) vector with labels

#' @keywords internal

extract_choices_labels <- function(choices, values = NULL) {

  } else {

  }

  }

}

#' @keywords internal

#' @noRd

plot_with_settings_deps <- function() {

  )

}

#' @name plot_with_settings

#' @rdname plot_with_settings

#' @export

plot_with_settings_ui <- function(id) {

        ),

        )

      ),

    )

  )

}

#' Plot-with-settings module

#'

#' @rdname plot_with_settings

#' @description `r lifecycle::badge("stable")`\cr

#' Universal module for plots with settings for height, width, and download.

#'

#' @export

#'

#' @param id (`character(1)`) `shiny` module id.

#'

#' @param plot_r (`reactive` or `function`)\cr

#'  `reactive` expression or a simple `function` to draw a plot.

#'  A simple `function` is needed e.g. for base plots like `plot(1)` as the output can not be caught when downloading.

#'  Take into account that simple functions are less efficient than reactive, as not catching the result.

#' @param height (`numeric`) optional\cr

#'  vector with three elements c(VAL, MIN, MAX), where VAL is the starting value of the slider in

#'  the main and modal plot display. The value in the modal display is taken from the value of the

#'  slider in the main plot display.

#' @param width (`numeric`) optional\cr

#'  vector with three elements `c(VAL, MIN, MAX)`, where VAL is the starting value of the slider in

#'  the main and modal plot display; `NULL` for default display. The value in the modal

#'  display is taken from the value of the slider in the main plot display.

#' @param show_hide_signal optional, (`reactive logical` a mechanism to allow modules which call this

#'     module to show/hide the plot_with_settings UI)

#' @param brushing (`logical`) optional\cr

#'  mechanism to enable / disable brushing on the main plot (in particular: not the one displayed

#'  in modal). All the brushing data is stored as a reactive object in the `"brush"` element of

#'  returned list. See the example for details.

#' @param clicking (`logical`)\cr

#'  a mechanism to enable / disable clicking on data points on the main plot (in particular: not the

#'  one displayed in modal). All the clicking data is stored as a reactive object in the `"click"`

#'  element of returned list. See the example for details.

#' @param dblclicking (`logical`) optional\cr

#'  mechanism to enable / disable double-clicking on data points on the main plot (in particular:

#'  not the one displayed in modal). All the double clicking data is stored as a reactive object in

#'  the `"dblclick"` element of returned list. See the example for details.

#' @param hovering (`logical(1)`) optional\cr

#'  mechanism to enable / disable hovering over data points on the main plot (in particular: not

#'  the one displayed in modal). All the hovering data is stored as a reactive object in the

#' `"hover"` element of returned list. See the example for details.

#' @param graph_align (`character(1)`) optional,\cr

#'  one of `"left"` (default), `"center"`, `"right"` or `"justify"`. The alignment of the graph on

#'  the main page.

#'

#' @details By default the plot is rendered with `72 dpi`. In order to change this, to for example 96 set

#' `options(teal.plot_dpi = 96)`. The minimum allowed `dpi` value is `24` and it must be a whole number.

#' If an invalid value is set then the default value is used and a warning is outputted to the console.

#'

#' @return A `shiny` module.

#'

#' @examples

#' # Example using a reactive as input to plot_r

#' library(shiny)

#' library(ggplot2)

#'

#' ui <- fluidPage(

#'   plot_with_settings_ui(

#'     id = "plot_with_settings"

#'   )

#' )

#'

#' server <- function(input, output, session) {

#'   plot_r <- reactive({

#'     ggplot(faithful, aes(x = .data$waiting, y = .data$eruptions)) +

#'       geom_point()

#'   })

#'

#'   plot_with_settings_srv(

#'     id = "plot_with_settings",

#'     plot_r = plot_r,

#'     height = c(400, 100, 1200),

#'     width = c(500, 250, 750)

#'   )

#' }

#'

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }

#'

#' # Example using a function as input to plot_r

#' library(lattice)

#'

#' ui <- fluidPage(

#'   radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")),

#'   plot_with_settings_ui(

#'     id = "plot_with_settings"

#'   ),

#'   sliderInput("nums", "Value", 1, 10, 1)

#' )

#'

#' server <- function(input, output, session) {

#'   plot_r <- function() {

#'     numbers <- seq_len(input$nums)

#'     if (input$download_option == "ggplot") {

#'       ggplot(data.frame(n = numbers), aes(.data$n)) +

#'         geom_bar()

#'     } else if (input$download_option == "trellis") {

#'       densityplot(numbers)

#'     } else if (input$download_option == "grob") {

#'       tr_plot <- densityplot(numbers)

#'       ggplotGrob(

#'         ggplot(data.frame(n = numbers), aes(.data$n)) +

#'           geom_bar()

#'       )

#'     } else if (input$download_option == "base") {

#'       plot(numbers)

#'     }

#'   }

#'

#'   plot_with_settings_srv(

#'     id = "plot_with_settings",

#'     plot_r = plot_r,

#'     height = c(400, 100, 1200),

#'     width = c(500, 250, 750)

#'   )

#' }

#'

#' if (interactive()) {

#'   shinyApp(ui, server)

#' }