Enhancement: SimplifyTLG Order Details Table, Internalize PCSPC Filtering

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: aNCA
 Title: (Pre-)Clinical NCA in a Dynamic Shiny App
-Version: 0.1.0.9186
+Version: 0.1.0.9187
 Authors@R: c(
     person("Ercan", "Suekuer", email = "ercan.suekuer@roche.com", role = "aut",
            comment = c(ORCID = "0009-0001-1626-1526")),

NEWS.md

@@ -31,6 +31,14 @@
 * Summary tables can filter which stratification values appear: a "Parameters to show" filter on the `pkpt03/07/08` tables and a "Timepoints to show" filter on the `pkct01` tables restrict the rows to the chosen `PARAM`/timepoint values (#1356)
 * Summary tables now warn (instead of silently degrading) when a chosen stratification variable is not present in the data — e.g. the "by Dose" concentration tables when a dose-amount column is not carried in the concentration data — so it is clear why a table grouped by fewer variables (#1356)
 
+### TLG Order & Selection
+* Simplify the TLG Order Details table: the internal `Condition` column is hidden (it stays in `tlg.yaml` as metadata that still auto-selects urine outputs) and the table is trimmed to Type, Dataset, Output, Footnote, Stratification, and Comment (#1335)
+* Urine TLG functions filter to urine specimens internally; when `PCSPEC`/`PPSPEC` is missing, the resulting warning is surfaced as an in-app notification instead of failing silently (#1335)
+* Redesign the "Add TLGs to order" picker as a catalog checklist with dataset tabs (PK Concentrations / PK Parameters), search, CSV/XLSX export, per-column select-all, and a live selection count (#1335)
+* In the "Add TLGs to order" picker, searching now respects the active dataset tab: matches in another dataset surface as a count on that tab's badge instead of appearing under the current tab, so switching tabs reveals them (#1335)
+* In the "Add TLGs to order" picker, the toolbar **Select all** and **Clear all** now act consistently on the whole order — every output across both dataset tabs (limited to the current search when one is active) — while each column's **Select all** stays scoped to that column (#1335)
+* Notify the user when a PK-parameter (ADPP) output is requested before NCA has been run, instead of only showing an empty placeholder (#1335)
+
 ### Settings & Configuration
 * Settings upload auto-restores the full session: mapping, filters, data processing, tab navigation, and auto-runs NCA if previously run. Incompatible settings degrade gracefully with notifications (#1225)
 * Settings version control: YAML file stores multiple versions with metadata. Save button in header, version selection on upload, version delete support (#1103)

inst/WORDLIST

@@ -154,6 +154,7 @@ VSSMDP
 WTBL
 WTBLU
 Walkthrough
+XLSX
 XPT
 YAML
 aNCA's

inst/shiny/app.R

@@ -79,6 +79,7 @@ ui <- function() {
 
     includeCSS(file.path(assets, "main.css")),
     includeScript(file.path(assets, "index.js")),
+    includeScript(file.path(assets, "tlg_add_picker.js")),
 
     sidebar = navset_pill_list(
       id = "page",

inst/shiny/functions/tlg_add_picker.R

@@ -0,0 +1,169 @@
+#' Helpers for the "Add TLGs to order" modal (issue #1335).
+#'
+#' The picker was originally a grouped reactable whose Type/Dataset columns were
+#' blank on every selectable row.  It is rebuilt as a catalog-style checklist:
+#' dataset tabs (PK Concentrations / PK Parameters) over one column per output
+#' Type (Tables / Listings / Graphs), with a search + download + select-all
+#' toolbar, per-column select-all, and a live count on the confirm button.
+#'
+#' Client-side behaviour lives in `inst/shiny/www/tlg_add_picker.js`
+#' (`window.tlgAdd`); styling lives in
+#' `inst/shiny/www/styles/partials/_tlg_add_modal.scss`.  These helpers only
+#' build the server-side UI and translate the checked rows back to `tlg_order()`
+#' ids, keeping `tab_tlg_server()` small enough to stay under the cyclomatic
+#' complexity limit.
+
+# Fixed left-to-right order + icon for the Type columns, and dataset tab order.
+.TLG_TYPE_ORDER <- c("Table", "Listing", "Graph")
+.TLG_TYPE_ICON  <- c(Table = "table", Listing = "list-ul", Graph = "chart-line")
+.TLG_DATASET_ORDER <- c("PK Concentrations", "PK Parameters")
+
+#' Escape a string for safe embedding inside a single-quoted JS literal.
+#' @param x Character vector.
+#' @returns Character vector wrapped in single quotes with `'` and `\` escaped.
+#' @noRd
+tlg_js_str <- function(x) paste0("'", gsub("(['\\\\])", "\\\\\\1", x), "'")
+
+#' Build the "Add TLGs" catalog checklist UI.
+#'
+#' @param avail Tibble of not-yet-selected TLGs (rows of `tlg_order()` with
+#'   `Selection == FALSE`); must contain `Type`, `Dataset`, `Description`,
+#'   `Link`, and `id`.
+#' @param ns Namespace function for the calling module (`session$ns`).
+#' @returns A list with `ui` (the modal body tag) and `group_ids` (the
+#'   `checkboxGroupInput` ids created, read back on confirm).
+#' @noRd
+build_add_checklist <- function(avail, ns) {
+  present_types <- intersect(.TLG_TYPE_ORDER, unique(avail$Type))
+  datasets <- c(intersect(.TLG_DATASET_ORDER, unique(avail$Dataset)),
+                setdiff(unique(avail$Dataset), .TLG_DATASET_ORDER))
+
+  pairs <- dplyr::distinct(avail, Type, Dataset)
+  pairs <- pairs[order(match(pairs$Type, .TLG_TYPE_ORDER), pairs$Dataset), ]
+  pairs$input_id <- paste0("modal_check_", seq_len(nrow(pairs)))
+
+  spec_icon_html <- as.character(icon("circle-info"))
+
+  # One dataset block for a Type column: tagged with data-dataset so the tab bar
+  # can show/hide it.  The active tab is applied client-side.
+  build_group_ui <- function(type, dataset, input_id) {
+    rows <- dplyr::filter(avail, Type == !!type, Dataset == !!dataset)
+    choice_names <- purrr::map2(rows$Description, rows$Link, function(desc, link) {
+      spec_link <- if (is.na(link)) "" else paste0(
+        "<a href='", link, "' target='_blank' onclick='event.stopPropagation()' ",
+        "class='tlg-spec' title='View spec'>", spec_icon_html, "</a>"
+      )
+      HTML(paste0("<span class='tlg-desc'>", htmltools::htmlEscape(desc), "</span>", spec_link))
+    })
+    div(
+      class = "tlg-ds", `data-dataset` = dataset,
+      checkboxGroupInput(
+        inputId = ns(input_id),
+        label = NULL,
+        choiceNames = choice_names,
+        choiceValues = as.character(rows$id)
+      )
+    )
+  }
+
+  # One flex column per Type (plain flex, not the bootstrap grid, whose negative
+  # row margins would misalign the columns against the toolbar).
+  type_columns <- purrr::map(present_types, function(tp) {
+    tp_pairs <- dplyr::rename(pairs[pairs$Type == tp, ], type = Type, dataset = Dataset)
+    div(
+      class = "tlg-col",
+      div(
+        class = "tlg-col-head",
+        tags$span(
+          class = "tlg-col-title",
+          icon(.TLG_TYPE_ICON[[tp]]), paste0(" ", tp, "s"),
+          tags$span(sum(avail$Type == tp), class = "tlg-col-count")
+        ),
+        tags$button(
+          type = "button", class = "tlg-col-selall",
+          onclick = "window.tlgAdd.colSelect(this)", "Select all"
+        )
+      ),
+      div(
+        class = "tlg-col-body",
+        purrr::pmap(tp_pairs, build_group_ui),
+        div(class = "tlg-col-empty", "None in this view", style = "display: none;")
+      )
+    )
+  })
+
+  # Dataset tab bar; first dataset active by default.  data-total feeds the count
+  # badge (restored when the search box is cleared).
+  tab_bar <- div(
+    class = "tlg-tabs",
+    purrr::imap(datasets, function(ds, i) {
+      ds_total <- sum(avail$Dataset == ds)
+      tags$button(
+        type = "button",
+        class = paste("tlg-tab", if (i == 1) "active" else ""),
+        `data-dataset` = ds, `data-total` = ds_total,
+        onclick = paste0("window.tlgAdd.setTab(", tlg_js_str(ds), ", this)"),
+        ds, tags$span(ds_total, class = "tlg-tab-count")
+      )
+    })
+  )
+
+  # Per-open initialisation: pick the first dataset tab and render.  Kept inline
+  # (not in tlg_add_picker.js) because it depends on the datasets present now.
+  init_js <- paste0(
+    "window.tlgAdd.tab = ", tlg_js_str(datasets[1]), "; ",
+    "window.tlgAdd.q = ''; window.tlgAdd.render();"
+  )
+
+  # Shared left inset so toolbar, tabs, column headers and checkbox rows all line
+  # up on the same left edge (see --tlg-inset in _tlg_add_modal.scss).
+  ui <- div(
+    class = "tlg-add-modal",
+    div(
+      class = "tlg-toolbar",
+      tags$input(
+        type = "text", class = "form-control tlg-search-input",
+        placeholder = "Search outputs…",
+        oninput = "window.tlgAdd.setQuery(this.value)"
+      ),
+      tags$button(type = "button", class = "btn btn-sm btn-default",
+                  title = "Select every output in both tabs (matching the search)",
+                  onclick = "window.tlgAdd.selectAll()", "Select all"),
+      tags$button(type = "button", class = "btn btn-sm btn-default",
+                  title = "Clear every output in both tabs (matching the search)",
+                  onclick = "window.tlgAdd.clearAll()", "Clear all"),
+      div(class = "tlg-toolbar-sep"),
+      downloadButton(ns("modal_dl_csv"), "CSV", class = "btn-sm btn-default"),
+      downloadButton(ns("modal_dl_xlsx"), "XLSX", class = "btn-sm btn-default")
+    ),
+    tab_bar,
+    div(class = "tlg-add-checklist tlg-cols", type_columns),
+    div(class = "tlg-no-matches", "No outputs match your search.", style = "display: none;"),
+    tags$script(HTML(init_js))
+  )
+
+  list(ui = ui, group_ids = pairs$input_id)
+}
+
+#' Ids of the rows checked in the add-picker modal, mapped back to `tlg_order()`.
+#'
+#' @param input The module `input` object.
+#' @param group_ids Character vector of `checkboxGroupInput` ids in the modal.
+#' @returns Integer vector of checked `tlg_order()` ids (empty if none).
+#' @noRd
+checked_tlg_ids <- function(input, group_ids) {
+  as.integer(unlist(lapply(group_ids, function(gid) input[[gid]])))
+}
+
+#' Available-TLG catalog for the modal's CSV / XLSX download.
+#'
+#' @param df The available-TLG tibble (`modal_avail()`), or `NULL`.
+#' @returns A data frame with `Type`, `Dataset`, `PKid`, `Description`.
+#' @noRd
+tlg_modal_dl_data <- function(df) {
+  if (is.null(df) || nrow(df) == 0) {
+    return(data.frame(Type = character(), Dataset = character(),
+                      PKid = character(), Description = character()))
+  }
+  dplyr::select(df, Type, Dataset, PKid, Description)
+}

inst/shiny/modules/tab_tlg.R

@@ -91,6 +91,7 @@ tab_tlg_server <- function(id, data, adpp = reactive(NULL)) {
         ),
         PKid = .x$pkid,
         Output = paste0("<a href='", .x$link, "' target='_blank'>", .x$description, "</a>"),
+        Link = if (is.null(.x$link)) NA_character_ else .x$link,
         Label = .x$label,
         Description = .x$description,
         Condition = .x$condition,
@@ -122,9 +123,13 @@ tab_tlg_server <- function(id, data, adpp = reactive(NULL)) {
       tlg_order(new_tlg_order)
     })
 
+    # Columns shown to the user in the Order Details table. Internal columns
+    # (PKid, Label, Description, Condition) are kept in tlg_order() but hidden:
+    # Condition drives urine auto-preselect above, Label titles the nav panels,
+    # and Description feeds the submit log — none need to be user-facing.
     displayed_order <- reactive({
       dplyr::filter(tlg_order(), Selection) %>%
-        dplyr::select(-id, -Selection)
+        dplyr::select(Type, Dataset, Output, Footnote, Stratification, Comment)
     }) %>%
       bindEvent(data(), input$confirm_add_tlg, input$remove_tlg)
 
@@ -136,7 +141,7 @@ tab_tlg_server <- function(id, data, adpp = reactive(NULL)) {
       defaultExpanded = TRUE,
       wrap = TRUE,
       selection = "multiple",
-      editable = c("Footnote", "Stratification", "Condition", "Comment"),
+      editable = c("Footnote", "Stratification", "Comment"),
       columns = function(df) {
         define_cols(df, overrides = list(Output = colDef(html = TRUE)))
       }
@@ -145,51 +150,83 @@ tab_tlg_server <- function(id, data, adpp = reactive(NULL)) {
     observeEvent(selected_tlg_state()$edit(), {
       info <- selected_tlg_state()$edit()
 
+      # info$column is the display-frame column (reactable.extras reports the
+      # column name; older versions report a positional index). Resolve to a name
+      # and only ever write to an editable column, so a stray edit event can never
+      # overwrite an internal column (id/PKid/Condition/...) of the full frame.
+      editable_cols <- c("Footnote", "Stratification", "Comment")
+      col <- if (is.numeric(info$column)) names(displayed_order())[info$column] else info$column
+      req(col %in% editable_cols)
+
       new_tlg_order <- tlg_order()
-      new_tlg_order[new_tlg_order$Selection, ][info$row, info$column] <- info$value
+      new_tlg_order[new_tlg_order$Selection, ][info$row, col] <- info$value
       tlg_order(new_tlg_order)
     })
 
+    # Issue #1335: the "Add TLGs" picker is a catalog-style checklist -- dataset
+    # tabs (PK Concentrations / PK Parameters) over one column per Type (Tables /
+    # Listings / Graphs), with a search + download + select-all toolbar.  The UI
+    # builder and helpers live in inst/shiny/functions/tlg_add_picker.R;
+    # client-side behaviour in inst/shiny/www/tlg_add_picker.js (window.tlgAdd);
+    # styling in inst/shiny/www/styles/partials/_tlg_add_modal.scss.
+    # modal_group_ids -- checkboxGroupInput ids in the current modal (read on confirm)
+    # modal_avail     -- the available-TLG tibble backing the CSV/XLSX downloads
+    modal_group_ids <- reactiveVal(character(0))
+    modal_avail <- reactiveVal(NULL)
+
     # Show modal when the add_tlg button is pressed
     observeEvent(input$add_tlg, {
+      avail <- dplyr::arrange(dplyr::filter(tlg_order(), !Selection), Type, Dataset)
+      modal_avail(avail)
+
+      body <- if (nrow(avail) == 0) {
+        modal_group_ids(character(0))
+        tags$p("All available TLGs are already in the order.")
+      } else {
+        checklist <- build_add_checklist(avail, session$ns)
+        modal_group_ids(checklist$group_ids)
+        checklist$ui
+      }
+
       showModal(modalDialog(
         title = div(
-          "Add TLGs to Order",
+          "Add TLGs to order",
           js_close_button,
           style = "position: relative;"
         ),
-        reactable_ui(session$ns("modal_tlg_table")),
+        body,
         footer = tagList(
           modalButton("Close"),
-          actionButton(session$ns("confirm_add_tlg"), "Add TLGs to Order")
+          uiOutput(session$ns("modal_confirm_ui"), inline = TRUE)
         ),
         size = "l"
       ))
     })
 
-    modal_tlg_state <- reactable_server(
-      "modal_tlg_table",
-      reactive({
-        dplyr::filter(tlg_order(), !Selection) %>%
-          dplyr::select(-id, -Selection, -Footnote, -Stratification, -Condition, -Comment)
-      }),
-      download_buttons = c("csv", "xlsx"),
-      groupBy = c("Type", "Dataset"),
-      wrap = TRUE,
-      selection = "multiple",
-      defaultExpanded = TRUE,
-      width = "775px", # fit to the modal width
-      columns = function(df) {
-        define_cols(df, overrides = list(Output = colDef(html = TRUE)))
-      }
+    # Download the available-TLG catalog shown in the modal.
+    output$modal_dl_csv <- downloadHandler(
+      filename = function() "available_tlgs.csv",
+      content = function(file) write.csv(tlg_modal_dl_data(modal_avail()), file, row.names = FALSE)
+    )
+    output$modal_dl_xlsx <- downloadHandler(
+      filename = function() "available_tlgs.xlsx",
+      content = function(file) writexl::write_xlsx(tlg_modal_dl_data(modal_avail()), file)
     )
 
+    # Confirm button with a live count of checked outputs; disabled at zero.
+    output$modal_confirm_ui <- renderUI({
+      n <- length(checked_tlg_ids(input, modal_group_ids()))
+      label <- if (n == 0) "Add to order" else paste0("Add ", n, " to order")
+      btn <- actionButton(session$ns("confirm_add_tlg"), label, class = "btn-primary")
+      if (n == 0) shinyjs::disabled(btn) else btn
+    })
+
     # Update the Selection column when the confirm_add_tlg button is pressed
     observeEvent(input$confirm_add_tlg, {
-      selected_rows <- modal_tlg_state()$selected
-      if (length(selected_rows) > 0) {
+      checked_ids <- checked_tlg_ids(input, modal_group_ids())
+      if (length(checked_ids) > 0) {
         tlg_order_data <- tlg_order()
-        tlg_order_data$Selection[!tlg_order_data$Selection][selected_rows] <- TRUE
+        tlg_order_data$Selection[tlg_order_data$id %in% checked_ids] <- TRUE
         tlg_order(tlg_order_data)
       }
       removeModal()
@@ -252,6 +289,18 @@ tab_tlg_server <- function(id, data, adpp = reactive(NULL)) {
       apply_labels(data()$conc$data, type = "ADNCA")
     })
     adpp_data_all <- reactive({
+      # A PK-parameter (ADPP) output was requested but NCA has not been run, so
+      # ADPP is unavailable. Surface it as a toast (Gero, #1335) in addition to
+      # the inline placeholder, since the empty panel alone reads as a silent
+      # failure.
+      if (is.null(adpp())) {
+        # Fixed id so multiple ADPP panels collapse into one toast rather than
+        # stacking an identical message per output.
+        showNotification(
+          "ADPP data is not available. Run NCA first to view PK parameter outputs.",
+          type = "warning", duration = 10, id = session$ns("adpp_missing")
+        )
+      }
       validate(need(
         !is.null(adpp()),
         "ADPP data is not available. Run NCA first to view PK parameter outputs."

inst/shiny/modules/tab_tlg/tlg_module.R

@@ -299,7 +299,19 @@ tlg_module_server <- function(id, data, type, render_list, options = NULL, # nol
         # the PKNCA/dplyr pipeline strips column `label` attributes, which breaks
         # the `!COLUMN` label-reference syntax in title/subtitle/footnote/axis
         # inputs (resolved via parse_annotation).
-        do.call(render_list, purrr::list_modify(list(data = data()), !!!list_options))
+        #
+        # Surface warnings from the render function (e.g. urine TLGs warning that
+        # PCSPEC/PPSPEC is absent so no specimen filtering was applied) as app
+        # notifications, then muffle so rendering continues with the result.
+        withCallingHandlers(
+          do.call(render_list, purrr::list_modify(list(data = data()), !!!list_options)),
+          warning = function(w) {
+            showNotification(
+              paste0("Notice: ", conditionMessage(w)), type = "warning", duration = 10
+            )
+            invokeRestart("muffleWarning")
+          }
+        )
       },
       error = function(e) {
         log_error("Error in list rendering:")