R/app_plots.R

Defines functions setup_data_plot data_plot_view_ui zoom_controls ratios_popover units_popover plot_options_sidebar

# shared plot framework (shiny UI + server) =====
# the "isofiles plot" view used by the cf/di/scans modules: units + species
# popovers (upper left), x-axis zoom (center), PDF download (upper right), and a
# plot-options sidebar. Each module supplies what differs: the aggregated dataset
# key, the ir_plot_* function, and (scans only) an extra scan-type popover.

# UI ----

# the right-hand "Plot Options" sidebar. `extra_options` is module-specific extra
# UI (e.g. the continuous-flow `short_time_labels` checkbox). The facet/color/
# linetype dropdowns are rendered server-side (their choices include the data's
# metadata columns) via the `aes_options` placeholder.
plot_options_sidebar <- function(ns, extra_top = NULL, extra_options = NULL) {
  bslib::sidebar(
    position = "right",
    width = "190",
    title = "Plot Options",
    extra_top,
    uiOutput(ns("aes_options")),
    selectInput(
      ns("scales"),
      "Scales:",
      choices = c("free", "fixed", "free_x", "free_y"),
      selected = "free"
    ),
    checkboxInput(ns("scientific"), "Scientific notation", value = FALSE),
    checkboxInput(
      ns("drop_unused_levels"),
      "Drop unused levels",
      value = FALSE
    ),
    extra_options,
    # styling options last
    selectInput(
      ns("legend_position"),
      "Legend:",
      choices = c("right", "bottom", "top", "left", "hide"),
      selected = "right"
    ),
    numericInput(ns("font_size"), "Font size:", value = 16, min = 6, step = 1)
  )
}

# the intensity-units popover button (its label shows the current unit)
units_popover <- function(ns) {
  bslib::popover(
    actionButton(
      ns("units-trigger"),
      textOutput(ns("units_label"), inline = TRUE),
      icon = icon("caret-down")
    ),
    title = "Units",
    div(
      style = "width: 5rem;",
      radioButtons(
        ns("units"),
        label = NULL,
        choices = app_units(),
        selected = "mV"
      )
    ),
    options = list(trigger = "focus")
  )
}

# the ratios popover: a "Calculate ratios" toggle that, when on, reveals the
# isoreader2::ir_calculate_ratios() options for the current intensity unit family
# (the num/denom additive offsets, rendered server-side, plus a Normalize toggle).
# Edits are staged: nothing takes effect until "Apply" (green) is clicked; "Cancel"
# (gray) discards them. Sits between the units and species popovers.
#
# It uses bslib's default "click" trigger so it stays open while the form is
# edited and is dismissed by re-clicking the trigger, pressing Escape, or
# Apply/Cancel (which close it server-side). A "focus" trigger -- as the units /
# species popovers use -- would instead close the moment focus leaves the trigger,
# i.e. on the first click inside, which breaks this multi-step form.
ratios_popover <- function(ns) {
  bslib::popover(
    actionButton(
      ns("ratios-trigger"),
      "Ratios",
      icon = icon("caret-down")
    ),
    title = "Ratios",
    id = ns("ratios_popover"),
    div(
      style = "width: 12rem;",
      checkboxInput(ns("ratios_calculate"), "Calculate ratios", value = FALSE),
      # the additive-offset inputs (unit-family dependent) + normalize toggle are
      # only relevant once ratios are being calculated
      conditionalPanel(
        condition = "input.ratios_calculate == true",
        ns = ns,
        uiOutput(ns("ratios_params")),
        checkboxInput(ns("ratios_normalize"), "Normalize", value = FALSE)
      ),
      div(
        class = "d-flex gap-1 mt-2",
        actionButton(
          ns("ratios_apply"),
          "Apply",
          class = "btn-sm btn-success flex-fill"
        ),
        actionButton(
          ns("ratios_cancel"),
          "Cancel",
          class = "btn-sm btn-secondary flex-fill"
        )
      )
    )
  )
}

# the centered x-axis zoom controls (show all / move left / move right / back)
zoom_controls <- function(ns) {
  div(
    class = "d-flex gap-1",
    actionButton(
      ns("zoom_all"),
      "",
      icon = icon("resize-full", lib = "glyphicon")
    ) |>
      add_tooltip("Show all data") |>
      shinyjs::disabled(),
    actionButton(ns("zoom_move_left"), "", icon = icon("arrow-left")) |>
      add_tooltip("Move left") |>
      shinyjs::disabled(),
    actionButton(ns("zoom_move_right"), "", icon = icon("arrow-right")) |>
      add_tooltip("Move right") |>
      shinyjs::disabled(),
    actionButton(
      ns("zoom_back"),
      "",
      icon = icon("rotate-left", verify_fa = FALSE)
    ) |>
      add_tooltip("Revert to previous view") |>
      shinyjs::disabled()
  )
}

# the shared plot view: units (+ optional `extra_left`, e.g. the scans scan-type
# popover) and species popovers on the left, zoom centered, download on the
# right, plot output below, and the plot-options sidebar on the right.
data_plot_view_ui <- function(id, extra_left = NULL, extra_options = NULL) {
  ns <- NS(id)
  # the whole card (controls + options sidebar + plot) can go fullscreen
  bslib::card(
    full_screen = TRUE,
    min_height = 400,
    bslib::layout_sidebar(
      fill = TRUE,
      sidebar = plot_options_sidebar(ns, extra_options = extra_options),
      # controls row (units/species left, zoom centered, download right)
      div(
        class = "d-flex align-items-center gap-2 mb-2",
        # left: units + optional extra + species
        div(
          class = "d-flex flex-wrap align-items-center gap-2",
          style = "flex: 1 1 0;",
          units_popover(ns),
          ratios_popover(ns),
          extra_left,
          uiOutput(ns("species_buttons"))
        ),
        # center: zoom navigation
        zoom_controls(ns),
        # right: download (balances the left zone to keep zoom centered)
        div(
          class = "d-flex justify-content-end",
          style = "flex: 1 1 0;",
          plot_download_link(ns("plot_download"), label = NULL) |>
            shinyjs::disabled()
        )
      ),
      # plot fills the remaining space below the controls
      plotOutput(
        ns("data_plot"),
        dblclick = ns("data_plot_dblclick"),
        brush = brushOpts(
          id = ns("data_plot_brush"),
          delayType = "debounce",
          direction = "x",
          resetOnNew = TRUE
        )
      ) |>
        shinycssloaders::withSpinner() |>
        bslib::as_fill_carrier()
    )
  )
}

# server ----

# wire up the shared "isofiles plot" server. The data and units come from the
# central file server: `get_data` is its selection-filtered aggregated data
# reactive (e.g. file$get_aggregated_scans_data) and `get_units` / `set_units`
# are its shared intensity-units accessors (the popover reads + drives them).
# `dataset_key` selects the aggregated table ("traces"/"cycles"/"scans");
# `plot_fn` is the ir_plot_* function; `no_data_message` is shown when the
# dataset is empty; `download_basename` is the PDF filename stem.
# `setup_extra(get_data, input, output, session)` is optional and returns
# `list(plot_args = <reactive list spliced into plot_fn>, filter_dataset =
# <optional function(dataset) restricting the species/mass options>)`; it may
# also set up extra outputs (e.g. the scans scan-type UI). `zoom_arg` is the name
# of `plot_fn`'s x-window argument (cf "time_window.s", di "cycle_window", scans
# "x_window"); when set, the zoom window is passed there (filters + rescales y).
# When NULL, zoom falls back to a post-hoc `coord_cartesian(xlim=)`, which zooms
# the view but does NOT rescale y (so it keeps the full y-range, incl. 0).
setup_data_plot <- function(
  id,
  get_data,
  get_units,
  set_units,
  dataset_key,
  plot_fn,
  plot_fn_name,
  no_data_message,
  download_basename = "plot",
  setup_extra = NULL,
  zoom_arg = NULL,
  get_selection = NULL,
  get_all_metadata = NULL
) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns

    # species whose masses / ratios the user explicitly hid via "Hide" or by
    # un-checking everything (stays hidden until "Show" is clicked or something is
    # (re)selected). Masses and ratios are tracked independently so e.g. the ratios
    # can stay shown while the raw-intensity masses are hidden.
    hidden <- reactiveValues()
    hidden_ratios <- reactiveValues()

    # intensity units live in the file server (shared across all plots). Show its
    # current value in the popover label, push popover changes back into it, and
    # keep the radio in sync if the units get changed from elsewhere. (Setting a
    # reactiveVal to its current value is a no-op, so this can't loop.)
    output$units_label <- renderText(get_units())
    observeEvent(input$units, set_units(input$units), ignoreInit = TRUE)
    observe(updateRadioButtons(session, "units", selected = get_units()))

    # module-specific extras: `setup_extra` returns
    # list(plot_args = <reactive list spliced into plot_fn>, filter_dataset =
    # <optional function(dataset) restricting the species/mass options, e.g.
    # scans to the selected scan_type>); it may also set up extra outputs.
    extra <- if (!is.null(setup_extra)) {
      setup_extra(get_data, input, output, session)
    } else {
      list()
    }
    get_extra_plot_args <- extra$plot_args %||% reactive(list())
    filter_dataset <- extra$filter_dataset

    # RATIOS popover ----
    # the APPLIED ratio settings (only these drive the plot + code; the popover's
    # live inputs are a staged draft committed on "Apply"). Additive offsets are
    # kept per intensity-unit family so switching units preserves each family's
    # configuration. Defaults match isoreader2::ir_calculate_ratios().
    ratio_settings <- reactiveVal(list(
      calculate = FALSE,
      normalize = FALSE,
      num_add = list(V = 100, nA = 0, cps = 0),
      denom_add = list(V = 100, nA = 0, cps = 0)
    ))

    # the additive-offset inputs for the current intensity unit family (V/nA/cps),
    # pre-filled from the applied settings (isolated; the reset-on-open observer
    # below keeps the draft in sync without rebuilding the inputs)
    output$ratios_params <- renderUI({
      fam <- intensity_unit_family(get_units())
      s <- isolate(ratio_settings())
      defaults <- ratio_add_defaults(fam)
      # the offsets are specified in the family's reference unit (V / nA / cps),
      # shown in brackets, regardless of the actual selected intensity unit
      tagList(
        numericInput(
          ns("ratios_num_add"),
          sprintf("add to numerator [%s]", fam),
          value = s$num_add[[fam]] %||% defaults[["num"]],
          step = 1
        ),
        numericInput(
          ns("ratios_denom_add"),
          sprintf("add to denominator [%s]", fam),
          value = s$denom_add[[fam]] %||% defaults[["denom"]],
          step = 1
        )
      )
    })

    # reset the popover's draft inputs back to the applied settings (run when the
    # popover (re)opens and on "Cancel", so un-applied edits never linger)
    reset_ratio_inputs <- function() {
      s <- ratio_settings()
      fam <- intensity_unit_family(get_units())
      updateCheckboxInput(
        session,
        "ratios_calculate",
        value = isTRUE(s$calculate)
      )
      updateCheckboxInput(
        session,
        "ratios_normalize",
        value = isTRUE(s$normalize)
      )
      updateNumericInput(session, "ratios_num_add", value = s$num_add[[fam]])
      updateNumericInput(
        session,
        "ratios_denom_add",
        value = s$denom_add[[fam]]
      )
    }
    # the "click"-trigger popover opens/closes itself on the trigger button; reset
    # the draft to the applied settings whenever the trigger is clicked (i.e. on
    # open), and close it on Apply/Cancel (those buttons are inside the popover, so
    # they don't dismiss it themselves)
    observeEvent(input[["ratios-trigger"]], reset_ratio_inputs())
    observeEvent(input$ratios_cancel, {
      reset_ratio_inputs()
      bslib::toggle_popover("ratios_popover", show = FALSE)
    })
    # Apply: commit the draft inputs into the applied settings (only the current
    # unit family's offsets are touched; the others keep their values)
    observeEvent(input$ratios_apply, {
      s <- ratio_settings()
      fam <- intensity_unit_family(get_units())
      s$calculate <- isTRUE(input$ratios_calculate)
      s$normalize <- isTRUE(input$ratios_normalize)
      if (!is.null(input$ratios_num_add) && !is.na(input$ratios_num_add)) {
        s$num_add[[fam]] <- input$ratios_num_add
      }
      if (!is.null(input$ratios_denom_add) && !is.na(input$ratios_denom_add)) {
        s$denom_add[[fam]] <- input$ratios_denom_add
      }
      ratio_settings(s)
      bslib::toggle_popover("ratios_popover", show = FALSE)
    })

    # the ir_calculate_ratios() arguments for the applied settings + current units
    # (NULL when ratios are off); used to compute ratios for the plot and to drive
    # the generated aggregate step
    get_ratio_calc <- reactive(ratio_calc_params(ratio_settings(), get_units()))

    # the aggregated data the plot works on: the file server's data plus, when the
    # Ratios popover requests it, the ir_calculate_ratios() `ratio_name`/`ratio`
    # columns (computed with the applied offsets/normalization for the current units)
    get_ratio_data <- reactive({
      agg <- get_data()
      if (is.null(agg)) {
        return(NULL)
      }
      params <- get_ratio_calc()
      if (is.null(params)) {
        return(agg)
      }
      if (isTRUE(params$normalize_ratios)) {
        params$normalize_ratios <- stats::median
      }
      # call as a normal isoreader2:: call (not do.call on the function value, which
      # makes isoreader2's progress message deparse the whole function definition);
      # sit at 50% so the user sees the (potentially slow) calculation is running
      out <- withProgress(
        message = "Calculating ratios",
        detail = "This may take a moment...",
        value = 0.5,
        rlang::inject(isoreader2::ir_calculate_ratios(agg, !!!params))
      ) |>
        try_catch_cnds()
      out |> log_cnds(ns = ns)
      out$result %||% agg
    })

    # facet / color / linetype aesthetic dropdowns. Choices are species/mass/trace
    # plus the data's metadata columns; rendered server-side (data-dependent) and
    # only once data is loaded so the function defaults (facet=file_name,
    # color=trace, linetype=none) are valid choices. Numeric and date/time metadata
    # columns are factor()-wrapped when used as a discrete aesthetic (see
    # aes_factor_cols + the plot/code below).
    # the selected data's metadata, restricted to columns that actually carry a
    # value for the current selection: the app's selection filter keeps every
    # column (NA where it doesn't apply), so we drop the all-NA ones here -- the
    # same columns ir_filter_metadata() keeps -- so the aes dropdowns only offer
    # metadata present in the selected files/analyses.
    aes_metadata <- reactive({
      md <- get_data()$metadata
      if (is.null(md)) {
        return(NULL)
      }
      md[, vapply(md, function(x) !all(is.na(x)), logical(1)), drop = FALSE]
    })
    aes_factor_cols <- reactive({
      md <- aes_metadata()
      if (is.null(md)) {
        return(character(0))
      }
      names(md)[vapply(
        md,
        function(x) is.numeric(x) || inherits(x, c("POSIXt", "Date")),
        logical(1)
      )]
    })
    # "data_type" (intensity vs. ratios, added by the plot function) is offered
    # alongside species/mass/trace; faceting defaults to file_name (the plot
    # functions split intensities/ratios into rows automatically via their
    # data_type_as_facet = auto() option, regardless of the facet column).
    # "Color by" additionally offers "(default)" -- the initial choice -- which
    # leaves the colour aesthetic to isoreader2 entirely: it groups an intensity
    # trace and its ratios into one colour and one legend entry. Picking any
    # column here (incl. "trace", one colour per trace) overrides that.
    output$aes_options <- renderUI({
      md <- aes_metadata()
      req(md)
      ch <- c(
        "species",
        "mass",
        "trace",
        "data_type",
        setdiff(names(md), "file_path")
      )
      tagList(
        selectInput(
          ns("facet"),
          "Facet by:",
          choices = c("(none)", ch),
          selected = isolate(input$facet) %||% "file_name"
        ),
        selectInput(
          ns("color"),
          "Color by:",
          choices = c("(default)", "(none)", ch),
          selected = isolate(input$color) %||% "(default)"
        ),
        selectInput(
          ns("linetype"),
          "Linetype by:",
          choices = c("(none)", ch),
          selected = isolate(input$linetype) %||% "(none)"
        )
      )
    })

    # species -> available masses, de-duplicated so a units change (which
    # re-aggregates but keeps the same species/masses) doesn't rebuild the
    # popovers (a rebuild briefly leaves duplicate bound inputs). `filter_dataset`
    # (if provided) restricts the options, e.g. scans to the selected scan_type.
    species_masses_raw <- reactive({
      dataset <- get_ratio_data()[[dataset_key]]
      if (!is.null(filter_dataset)) {
        dataset <- filter_dataset(dataset)
      }
      if (is.null(dataset) || nrow(dataset) == 0) {
        return(NULL)
      }
      out <- species_mass_groups(dataset) |> try_catch_cnds()
      out |> log_cnds(ns = ns)
      out$result
    })
    species_masses_val <- reactiveVal(NULL)
    observe({
      new_value <- species_masses_raw()
      if (!identical(new_value, isolate(species_masses_val()))) {
        species_masses_val(new_value)
      }
    })
    species_masses <- reactive(species_masses_val())

    # register Hide / Show / deflag handlers once per species (keyed by species)
    handlers_for <- reactiveVal(character(0))
    observe({
      g <- species_masses()
      req(g)
      done <- isolate(handlers_for())
      for (new_species in setdiff(g$species, done)) {
        local({
          species <- new_species
          ratios_input <- paste0(species, "-ratios")
          # Hide: clear both the mass and ratio checkbox groups
          observeEvent(
            input[[paste0(species, "-hide")]],
            {
              updateCheckboxGroupInput(
                session,
                species,
                selected = character(0)
              )
              updateCheckboxGroupInput(
                session,
                ratios_input,
                selected = character(0)
              )
              hidden[[species]] <- TRUE
              hidden_ratios[[species]] <- TRUE
            },
            ignoreInit = TRUE
          )
          # Show: re-select every mass and every ratio for the species
          observeEvent(
            input[[paste0(species, "-show")]],
            {
              g_now <- species_masses()
              i <- which(g_now$species == species)
              updateCheckboxGroupInput(
                session,
                species,
                selected = g_now$masses[[i]]
              )
              updateCheckboxGroupInput(
                session,
                ratios_input,
                selected = g_now$ratios[[i]]
              )
              hidden[[species]] <- NULL
              hidden_ratios[[species]] <- NULL
            },
            ignoreInit = TRUE
          )
          # track explicit emptying of the mass / ratio groups (NULL = nothing
          # checked) so a rebuild remembers it; the two are independent
          observeEvent(
            input[[species]],
            {
              if (is.null(input[[species]])) {
                hidden[[species]] <- TRUE
              } else {
                hidden[[species]] <- NULL
              }
            },
            ignoreNULL = FALSE,
            ignoreInit = TRUE
          )
          observeEvent(
            input[[ratios_input]],
            {
              if (is.null(input[[ratios_input]])) {
                hidden_ratios[[species]] <- TRUE
              } else {
                hidden_ratios[[species]] <- NULL
              }
            },
            ignoreNULL = FALSE,
            ignoreInit = TRUE
          )
        })
      }
      handlers_for(union(done, g$species))
    })

    # one popover button per species (Show/Hide + a mass checkbox group, plus a
    # ratio checkbox group when ratios are available, named by the species so
    # input[[species]] / hidden[[species]] -- and the "-ratios" variants -- align)
    output$species_buttons <- renderUI({
      g <- species_masses()
      validate(need(!is.null(g) && nrow(g) > 0, no_data_message))
      buttons <- lapply(seq_len(nrow(g)), function(i) {
        species <- g$species[i]
        species_masses_i <- g$masses[[i]]
        species_ratios_i <- g$ratios[[i]]
        has_ratios <- length(species_ratios_i) > 0
        mass_group <- tagList(
          if (has_ratios) {
            tags$small(class = "text-muted d-block", "Masses")
          },
          checkboxGroupInput(
            ns(species),
            label = NULL,
            choices = species_masses_i,
            selected = if (isTRUE(isolate(hidden[[species]]))) {
              character(0)
            } else {
              species_masses_i
            }
          )
        )
        ratio_group <- if (has_ratios) {
          tagList(
            tags$small(class = "text-muted d-block", "Ratios"),
            checkboxGroupInput(
              ns(paste0(species, "-ratios")),
              label = NULL,
              choices = species_ratios_i,
              selected = if (isTRUE(isolate(hidden_ratios[[species]]))) {
                character(0)
              } else {
                species_ratios_i
              }
            )
          )
        }
        bslib::popover(
          actionButton(
            ns(paste0(species, "-trigger")),
            species,
            icon = icon("caret-down")
          ),
          title = species,
          div(
            style = "width: 8rem;",
            div(
              class = "d-flex gap-1 mb-2",
              actionButton(
                ns(paste0(species, "-show")),
                "Show",
                class = "btn-sm btn-outline-success flex-fill"
              ),
              actionButton(
                ns(paste0(species, "-hide")),
                "Hide",
                class = "btn-sm btn-outline-danger flex-fill"
              )
            ),
            mass_group,
            ratio_group
          ),
          options = list(trigger = "focus")
        )
      })
      tagList(buttons)
    })

    # selected (species, mass) pairs. A hidden species contributes nothing;
    # otherwise an unreported group (popover never opened) counts as all-selected
    # so the plot shows everything at startup.
    get_selected_masses <- reactive({
      g <- species_masses()
      if (is.null(g) || nrow(g) == 0) {
        # no data (e.g. no scan files) -> nothing selected, yields an empty plot
        return(tibble::tibble(species = character(0), mass = character(0)))
      }
      rows <- list()
      for (i in seq_len(nrow(g))) {
        species <- g$species[i]
        chosen <- if (isTRUE(hidden[[species]])) {
          character(0)
        } else {
          input[[species]] %||% g$masses[[i]]
        }
        for (mass in chosen) {
          rows[[length(rows) + 1L]] <- tibble::tibble(
            species = species,
            mass = mass
          )
        }
      }
      dplyr::bind_rows(rows)
    })

    # the selected ratio names (across species), same logic as the masses: a
    # hidden ratio group contributes nothing, an untouched one counts as all of
    # its ratios. Species without ratios are skipped.
    get_selected_ratios <- reactive({
      g <- species_masses()
      if (is.null(g) || nrow(g) == 0) {
        return(character(0))
      }
      out <- character(0)
      for (i in seq_len(nrow(g))) {
        ratios_i <- g$ratios[[i]]
        if (length(ratios_i) == 0) {
          next
        }
        species <- g$species[i]
        chosen <- if (isTRUE(hidden_ratios[[species]])) {
          character(0)
        } else {
          input[[paste0(species, "-ratios")]] %||% ratios_i
        }
        out <- c(out, chosen)
      }
      unique(out)
    })

    # the species / mass / ratio selection as the plot function's own arguments.
    # This is the single place the checkbox state turns into `species=`/`mass=`/
    # `ratio=`; both the plot and the generated code use it, so they can never
    # disagree about what is showing. isoreader2 does the actual sub-selecting.
    get_selection_args <- reactive({
      selection_to_plot_args(
        get_selected_masses(),
        species_masses(),
        get_selected_ratios()
      )
    })

    # ZOOM (x-axis) ----
    zoom_move <- 0.5
    values <- reactiveValues(
      valid_plot = FALSE,
      zoom_stack = list(list(x_min = NULL, x_max = NULL))
    )
    get_last_zoom <- function() values$zoom_stack[[length(values$zoom_stack)]]
    add_to_zoom_stack <- function(x_min, x_max) {
      new_zoom <- list(x_min = x_min, x_max = x_max)
      if (!identical(get_last_zoom(), new_zoom)) {
        values$zoom_stack <- c(values$zoom_stack, list(new_zoom))
      }
    }
    load_last_zoom <- function() {
      n <- length(values$zoom_stack)
      if (n > 1L) values$zoom_stack[[n]] <- NULL
    }
    observeEvent(input$zoom_back, load_last_zoom())
    observeEvent(input$data_plot_dblclick, load_last_zoom())
    observeEvent(input$zoom_all, add_to_zoom_stack(x_min = NULL, x_max = NULL))
    observeEvent(input$data_plot_brush, {
      brush <- input$data_plot_brush
      if (!is.null(brush$xmin) && !is.null(brush$xmax)) {
        add_to_zoom_stack(brush$xmin, brush$xmax)
      }
    })
    move_zoom <- function(direction) {
      z <- get_last_zoom()
      if (!is.null(z$x_min) && !is.null(z$x_max)) {
        span <- (z$x_max - z$x_min) * zoom_move
        add_to_zoom_stack(
          z$x_min + direction * span,
          z$x_max + direction * span
        )
      }
    }
    observeEvent(input$zoom_move_left, move_zoom(-1))
    observeEvent(input$zoom_move_right, move_zoom(+1))
    # reset zoom when the plotted data changes (units or file selection) or the
    # extra args change (e.g. the scans scan_type, whose x-axis range differs
    # entirely between scan types)
    observe({
      get_data()
      get_extra_plot_args()
      isolate(values$zoom_stack <- list(list(x_min = NULL, x_max = NULL)))
    })
    # enable the zoom + download buttons only when there is a valid plot
    observe({
      shinyjs::toggleState("zoom_all", condition = values$valid_plot)
      shinyjs::toggleState("zoom_move_left", condition = values$valid_plot)
      shinyjs::toggleState("zoom_move_right", condition = values$valid_plot)
      shinyjs::toggleState("zoom_back", condition = values$valid_plot)
      shinyjs::toggleState(
        "plot_download-download_dialog",
        condition = values$valid_plot
      )
    })

    # PLOT ----
    # plain reactive: renders at startup and re-renders on any change to the data
    # (units), the mass selection, the plot options, the extras, or the zoom
    generate_plot <- reactive({
      z <- get_last_zoom()
      window <- if (!is.null(z$x_min)) c(z$x_min, z$x_max) else NULL
      # extra plot args (e.g. scans scan_type) plus the zoom window for plot
      # functions that take one (cf `time_window.s`, di `cycle_window`, scans
      # `x_window`); these filter the data and rescale y.
      extra <- get_extra_plot_args()
      if (!is.null(zoom_arg) && !is.null(window)) {
        extra[[zoom_arg]] <- window
      }
      # plot-function passthrough option (forwarded to plot_fn via build_data_plot)
      if (isTRUE(input$drop_unused_levels)) {
        extra$drop_unused_levels <- TRUE
      }
      # scales / short_time_labels are plain-value args (pass via extra/...)
      extra$scales <- input$scales %||% "free"
      if (isTRUE(input$short_time_labels)) {
        extra$short_time_labels <- TRUE
      }
      # facet / color / linetype are tidy-eval aesthetics -> build them as quosures
      # (symbols, factor()-wrapped for numeric columns) so build_data_plot can
      # inject them and the columns are evaluated as variables, not strings
      fcols <- aes_factor_cols()
      aes_quo <- function(sel, default) {
        v <- sel %||% default
        if (is.null(v) || identical(v, "(none)")) {
          return(NULL)
        }
        s <- rlang::sym(v)
        if (v %in% fcols) rlang::quo(factor(!!s)) else rlang::quo(!!s)
      }
      aes_args <- list(facet = aes_quo(input$facet, "file_name"))
      # "(default)" leaves `color` out entirely so isoreader2 applies its own
      # colour grouping (a trace and its ratios share one colour + legend entry)
      color <- input$color %||% "(default)"
      if (!identical(color, "(default)")) {
        aes_args["color"] <- list(aes_quo(color, NULL))
      }
      linetype_quo <- aes_quo(input$linetype, NULL)
      if (!is.null(linetype_quo)) {
        aes_args$linetype <- linetype_quo
      }
      out <- do.call(
        build_data_plot,
        c(
          list(
            get_ratio_data(),
            dataset_key = dataset_key,
            plot_fn = plot_fn,
            selection_args = get_selection_args(),
            font_size = input$font_size %||% 16,
            scientific = input$scientific,
            legend_position = input$legend_position %||% "right",
            aes_args = aes_args
          ),
          extra
        )
      ) |>
        try_catch_cnds()
      out |> log_cnds(ns = ns)

      p <- out$result
      values$valid_plot <- !is.null(p)
      if (is.null(zoom_arg) && !is.null(p) && !is.null(window)) {
        # no plot-function window arg: zoom the view post-hoc (does not rescale y)
        p <- p + ggplot2::coord_cartesian(xlim = window)
      }
      p %||% make_empty_plot(input$font_size)
    })
    output$data_plot <- renderPlot(generate_plot(), res = 96)

    # PDF download of the current plot
    plot_download_server(
      "plot_download",
      plot_func = generate_plot,
      filename_func = reactive({
        paste0(
          format(Sys.time(), "%Y-%m-%d_%H-%M-%S"),
          "_",
          download_basename,
          ".pdf"
        )
      })
    )

    # CODE GENERATION =====
    # the plot step for the code server: subset the (already-aggregated) input
    # variable to the selected files/analyses with ir_filter_metadata(), then plot,
    # reflecting the current controls -- scan_type and other extras, the zoom
    # window, a strict mass subset, scientific notation, and the font size / legend
    # position (folded into the plot's `theme` argument, the way build_data_plot()
    # applies them). A terminal node (output = NULL).
    get_code <- function(input_var = NULL) {
      data_var <- input_var %||% "data"

      # file/analysis selection -> ir_filter_metadata() (dropped when all selected)
      filter_part <- NULL
      if (!is.null(get_selection) && !is.null(get_all_metadata)) {
        expr <- code_metadata_filter(get_selection(), get_all_metadata())
        if (!is.null(expr)) {
          filter_part <- code_call("ir_filter_metadata", list(code_raw(expr)))
        }
      }

      plot_args <- list()
      # module extras (e.g. scans scan_type); the zoom window is added separately
      extra <- get_extra_plot_args()
      for (nm in names(extra)) {
        if (!identical(nm, zoom_arg) && !is.null(extra[[nm]])) {
          plot_args[[nm]] <- extra[[nm]]
        }
      }
      # zoom window -> the plot function's window argument (cf/scans)
      z <- get_last_zoom()
      if (!is.null(zoom_arg) && !is.null(z$x_min) && !is.null(z$x_max)) {
        plot_args[[zoom_arg]] <- round(c(z$x_min, z$x_max), 1)
      }
      # species / mass / ratio selection -- exactly the arguments the plot itself
      # is drawn with (see get_selection_args), with an explicit "none" written as
      # `c()`. Anything left at "all" is simply omitted (the plot functions default
      # to `everything()`).
      plot_args <- c(
        plot_args,
        selection_args_for_code(get_selection_args())
      )
      # facet / color / linetype aesthetics; numeric metadata columns are
      # factor()-wrapped. The plot functions default to facet = NULL (they split
      # intensities/ratios automatically), so facet is emitted for every choice
      # except "(none)", which matches that NULL default. color is emitted only
      # when it overrides isoreader2's own colour grouping ("(default)");
      # "(none)" -> `= NULL`. linetype (default none) emits only when set.
      fcols <- aes_factor_cols()
      facet <- input$facet %||% "file_name"
      if (!identical(facet, "(none)")) {
        plot_args$facet <- code_raw(code_aes_value(facet, fcols))
      }
      color <- input$color %||% "(default)"
      if (identical(color, "(none)")) {
        plot_args$color <- code_raw("NULL")
      } else if (!identical(color, "(default)")) {
        plot_args$color <- code_raw(code_aes_value(color, fcols))
      }
      linetype <- input$linetype %||% "(none)"
      if (!identical(linetype, "(none)")) {
        plot_args$linetype <- code_raw(code_aes_value(linetype, fcols))
      }
      # facet scales (default "free")
      scales <- input$scales %||% "free"
      if (!identical(scales, "free")) {
        plot_args$scales <- scales
      }
      # scientific notation (default off)
      if (isTRUE(input$scientific)) {
        plot_args$scientific <- TRUE
      }
      # drop unused factor levels (default off)
      if (isTRUE(input$drop_unused_levels)) {
        plot_args$drop_unused_levels <- TRUE
      }
      # short_time_labels: continuous flow only (dataset_key == "traces")
      if (identical(dataset_key, "traces") && isTRUE(input$short_time_labels)) {
        plot_args$short_time_labels <- TRUE
      }
      plot_code <- code_pipe(
        data_var,
        filter_part,
        code_call(plot_fn_name, plot_args)
      )

      # font size + legend position as a proper ggplot `+ theme(...)` addition
      # (NOT the plot function's theme= arg); one line per option when several
      theme_args <- list()
      fs <- input$font_size %||% 16
      lp <- input$legend_position %||% "right"
      if (!identical(as.numeric(fs), 16)) {
        theme_args$text <- code_raw(paste0("element_text(size = ", fs, ")"))
      }
      if (!identical(lp, "right")) {
        theme_args[["legend.position"]] <- if (identical(lp, "hide")) {
          "none"
        } else {
          lp
        }
        # a bottom/top legend is laid out vertically (matches build_data_plot)
        if (lp %in% c("bottom", "top")) {
          theme_args[["legend.direction"]] <- "vertical"
        }
      }
      if (length(theme_args) > 0) {
        parts <- vapply(
          names(theme_args),
          function(nm) code_arg(nm, theme_args[[nm]]),
          character(1)
        )
        theme_call <- if (length(parts) == 1L) {
          paste0("theme(", parts, ")")
        } else {
          paste0("theme(\n  ", paste(parts, collapse = ",\n  "), "\n)")
        }
        plot_code <- paste0(
          plot_code,
          " +\n  ",
          gsub("\n", "\n  ", theme_call, fixed = TRUE)
        )
      }

      list(code = plot_code, output = NULL)
    }

    # `get_ratio_calc` lets the (separately registered) aggregate code step emit a
    # matching ir_calculate_ratios() call (NULL when ratios are off)
    list(get_code = get_code, get_ratio_calc = get_ratio_calc)
  })
}

Try the isoexplorer package in your browser

Any scripts or data that you put into this service are public.

isoexplorer documentation built on Sept. 8, 2026, 1:07 a.m.