FreesearchR/R/data_plots.R

# source(here::here("functions.R"))

#' Data correlations evaluation module
#'
#' @param id Module id. (Use 'ns("id")')
#'
#' @name data-plots
#' @returns Shiny ui module
#' @export
#'
data_visuals_ui <- function(id, tab_title = "Plots", ...) {
  ns <- shiny::NS(id)

  list(
    bslib::layout_sidebar(
      sidebar = bslib::sidebar(
        shiny::actionButton(
          inputId = ns("act_plot"),
          label = i18n$t("Plot"),
          width = "100%",
          icon = phosphoricons::ph("paint-brush", weight = "bold"),
          # icon = shiny::icon("palette"),
          disabled = FALSE
        ),
        shiny::helpText(
          i18n$t('Adjust plot input and settings below, then press "Plot".')
        ),
        bslib::accordion(
          id = "acc_plot",
          multiple = FALSE,
          bslib::accordion_panel(
            value = "acc_pan_plot",
            title = i18n$t("Define plot"),
            icon = phosphoricons::ph("chart-line"),
            # icon = bsicons::bs_icon("graph-up"),
            shiny::uiOutput(outputId = ns("primary")),
            shiny::helpText(
              i18n$t(
                'Only non-text variables are available for plotting. Go the "Data" to reclass data to plot.'
              )
            ),
            shiny::tags$br(),
            shiny::uiOutput(outputId = ns("type")),
            shiny::uiOutput(outputId = ns("secondary")),
            shiny::uiOutput(outputId = ns("tertiary"))
          ),
          bslib::accordion_panel(
            value = "acc_pan_params",
            title = i18n$t("Settings"),
            icon = phosphoricons::ph("gear"),
            shiny::uiOutput(outputId = ns("color_palette")),
            shiny::uiOutput(outputId = ns("basic_parameters")),
          ),
          bslib::accordion_panel(
            value = "acc_pan_download",
            title = "Download",
            icon = phosphoricons::ph("download-simple"),
            # icon = bsicons::bs_icon("download"),
            shinyWidgets::noUiSliderInput(
              inputId = ns("height_slide"),
              label = i18n$t("Plot height (mm)"),
              min = 50,
              max = 300,
              value = 100,
              step = 1,
              format = shinyWidgets::wNumbFormat(decimals = 0),
              color = datamods:::get_primary_color(),
              inline = TRUE
            ),
            # shiny::numericInput(
            #   inputId = ns("height_numeric"),
            #   label = "Plot height (mm)",
            #   min = 50,
            #   max = 300,
            #   value = 100
            # ),
            shinyWidgets::noUiSliderInput(
              inputId = ns("width"),
              label = i18n$t("Plot width (mm)"),
              min = 50,
              max = 300,
              value = 100,
              step = 1,
              format = shinyWidgets::wNumbFormat(decimals = 0),
              color = datamods:::get_primary_color()
            ),
            shiny::selectInput(
              inputId = ns("plot_type"),
              label = i18n$t("File format"),
              choices = list("png", "tiff", "eps", "pdf", "jpeg", "svg")
            ),
            shiny::br(),
            # Button
            shiny::downloadButton(
              outputId = ns("download_plot"),
              label = i18n$t("Download plot"),
              icon = phosphoricons::ph("arrow-fat-down")
              # icon = shiny::icon("download")
            )
          )
        ),
        shiny::p(
          "We have collected a few notes on visualising data and details on the options included in FreesearchR:",
          shiny::tags$a(
            href = "https://agdamsbo.github.io/FreesearchR/articles/visuals.html",
            "View notes in new tab",
            target = "_blank",
            rel = "noopener noreferrer"
          )
        )
      ),
      shiny::plotOutput(ns("plot"), height = "70vh"),
      shiny::tags$br(),
      shiny::tags$br(),
      shiny::htmlOutput(outputId = ns("code_plot"))
    )
  )
  # )
}


#'
#' @param data data
#' @param ... ignored
#'
#' @name data-plots
#' @returns shiny server module
#' @export
data_visuals_server <- function(id, data, palettes = color_choices(), ...) {
  shiny::moduleServer(
    id = id,
    module = function(input, output, session) {
      ns <- session$ns

      rv <- shiny::reactiveValues(plot.params = NULL,
                                  plot = NULL,
                                  code = NULL)

      shiny::observe({
        bslib::accordion_panel_update(
          id = "acc_plot",
          target = "acc_pan_plot",
          title = i18n$t("Create plot")
        )
        bslib::accordion_panel_update(id = "acc_plot",
                                      target = "acc_pan_download",
                                      title = i18n$t("Download"))
      })

      output$primary <- shiny::renderUI({
        shiny::req(data())
        columnSelectInput(
          inputId = ns("primary"),
          col_subset = names(data())[sapply(data(), data_type) != "text"],
          data = data,
          placeholder = i18n$t("Select variable"),
          label = i18n$t("Response variable"),
          multiple = FALSE
        )
      })

      # shiny::observeEvent(data, {
      #   if (is.null(data()) | NROW(data()) == 0) {
      #     shiny::updateActionButton(inputId = "act_plot", disabled = TRUE)
      #   } else {
      #     shiny::updateActionButton(inputId = "act_plot", disabled = FALSE)
      #   }
      # })

      output$type <- shiny::renderUI({
        shiny::req(input$primary)
        shiny::req(data())
        # browser()

        if (!input$primary %in% names(data())) {
          plot_data <- data()[1]
        } else {
          plot_data <- data()[input$primary]
        }

        plots <- possible_plots(data = plot_data, source_list = available_plots())

        plots_named <- get_input_params(plots) |>
          lapply(\(.x) {
            stats::setNames(.x$descr, .x$note)
          })

        # plots_named <- get_plot_options(plots) |>
        #   lapply(\(.x) {
        #     stats::setNames(.x$descr, .x$note)
        #   })

        vectorSelectInput(
          inputId = ns("type"),
          selected = NULL,
          label = shiny::h4(i18n$t("Plot type")),
          choices = Reduce(c, plots_named),
          multiple = FALSE
        )
      })

      rv$plot.params <- shiny::reactive({
        get_input_params(input$type) |> purrr::pluck(1)
        # get_plot_options(input$type) |> purrr::pluck(1)
      })


      ### Include two additional variable inputs
      output$secondary <- shiny::renderUI({
        shiny::req(input$type)

        # Get the plot function name
        base_params <- rv$plot.params()[["base"]]

        filtered_params <- base_params[sapply(base_params, function(params) {
          params$id %in% "secondary"
        })][[1]]

        filtered_params$exclude <- input$primary

        create_input_element(
          input_id = "secondary",
          ns = ns,
          params = append_list(data(), filtered_params, "data")
        )

      })

      output$tertiary <- shiny::renderUI({
        shiny::req(input$type)
        # Get the plot function name
        base_params <- rv$plot.params()[["base"]]

        filtered_params <- base_params[sapply(base_params, function(params) {
          params$id %in% "tertiary"
        })][[1]]

        filtered_params$exclude <- c(input$primary, input$secondary)

        create_input_element(
          input_id = "tertiary",
          ns = ns,
          params = append_list(data(), filtered_params, "data")
        )
      })


      ### Generating additional parameter inputs if any specified
      output$basic_parameters <- renderUI({
        req(input$type, rv$plot.params)

        # Get the plot function name
        base_params <- rv$plot.params()[["base"]]

        filtered_params <- base_params[sapply(base_params, function(params) {
          !params$id %in% c("secondary", "tertiary")
        })]


        # Create UI elements for base parameters
        base_inputs <- lapply(filtered_params, function(params) {
          input_id <- paste0("base_", params$id)
          params$id <- NULL
          if (params$type %in% "select_variables") {
            params$data <- data()
          }

          create_input_element(params, ns, input_id)
        })
        tagList(base_inputs)

      })

      ### Color option
      output$color_palette <- shiny::renderUI({
        # shiny::req(input$type)
        colorSelectInput(
          inputId = ns("color_palette"),
          label = i18n$t("Choose color palette"),
          choices = palettes,
          previews = 5
        )
      })

      shiny::observeEvent(input$act_plot, {
        if (NROW(data()) > 0) {
          tryCatch({
            # Get all input values with prefixes
            base_inputs <- reactiveValuesToList(input)[grep("^base_", names(reactiveValuesToList(input)))]
            # advanced_inputs <- reactiveValuesToList(input)[grep("^advanced_", names(reactiveValuesToList(input)))]

            # Remove the prefix from names
            names(base_inputs) <- gsub("^base_", "", names(base_inputs))
            # names(advanced_inputs) <- gsub("^advanced_", "", names(advanced_inputs))

            base_inputs <- c(base_inputs,
                             list(color.palette = input$color_palette))

            # If any of the specified parameters are NULL/missing, the settings
            # accordion/panel was never opened, and they can be ignored, as
            # default settings will the be used.
            if (any(sapply(base_inputs, is.null))) {
              dynamic_params <- list()
            } else {
              dynamic_params <- base_inputs
            }

            # Build parameters for plotting function
            parameters <- list(
              type = rv$plot.params()[["fun"]],
              pri = input$primary,
              sec = input$secondary,
              ter = input$tertiary
            )

            parameters <- modifyList(parameters, dynamic_params)

            ## If the dictionary holds additional arguments to pass to the
            ## plotting function, these are included
            if (!is.null(rv$plot.params()[["fun.args"]])) {
              default_params <- rv$plot.params()[["fun.args"]]

              ## Ensure not to overwrite user defined parameters are overwritten
              ## This allows to define default parameters.
              ##
              ## This will create a strange edge case, where the plot looks in
              ## one way, when plotted initially, but may change, when the settings
              ## accordion is opened. Problem for future me. Really mostly an edge case.
              parameters <- modifyList(parameters, default_params[!names(default_params) %in% names(parameters)])
            }

            shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."),
                                {
                                  rv$plot <- rlang::exec(create_plot,
                                                         !!!append_list(data(), parameters, "data"))
                                })

            rv$code <- glue::glue("FreesearchR::create_plot(df,{list2str(parameters)})")
          }, # warning = function(warn) {
          #   showNotification(paste0(warn), type = "warning")
          # },
          error = function(err) {
            showNotification(paste0(err), type = "error")
          })
        }
      }, ignoreInit = TRUE)

      output$code_plot <- shiny::renderUI({
        shiny::req(rv$code)
        prismCodeBlock(paste0(i18n$t("#Plotting\n"), rv$code))
      })

      shiny::observeEvent(list(data()), {
        shiny::req(data())

        rv$plot <- NULL
      })

      output$plot <- shiny::renderPlot({
        # shiny::req(rv$plot)
        # rv$plot
        if (!is.null(rv$plot)) {
          rv$plot
        } else {
          return(NULL)
        }
      })

      # shiny::observeEvent(input$height_numeric, {
      #   shinyWidgets::updateNoUiSliderInput(session, ns("height_slide"), value = input$height_numeric)
      # }, ignoreInit = TRUE)
      # shiny::observeEvent(input$height_slide, {
      #   shiny::updateNumericInput(session, ns("height_numeric"), value = input$height_slide)
      # }, ignoreInit = TRUE)


      output$download_plot <- shiny::downloadHandler(
        filename = shiny::reactive({
          paste0("plot.", input$plot_type)
        }),
        content = function(file) {
          if (inherits(rv$plot, "patchwork")) {
            plot <- rv$plot
          } else if (inherits(rv$plot, "ggplot")) {
            plot <- rv$plot
          } else {
            plot <- rv$plot[[1]]
          }
          # browser()
          shiny::withProgress(message = i18n$t("Drawing the plot. Hold tight for a moment.."), {
            ggplot2::ggsave(
              filename = file,
              plot = plot,
              width = input$width,
              height = input$height_slide,
              dpi = 300,
              units = "mm",
              scale = 2
            )
          })
        }
      )


      shiny::observe(return(rv$plot))
    }
  )
}