fix(shiny): red-team polish pass — T-356..T-359 (area 7)

inst/Parsimony/server.R

@@ -82,6 +82,18 @@ server <- function(input, output, session) {
       ""))
   })
 
+  # Legend for the "clus" / "space" plot views, shown alongside the
+  # cluster-coloured tree/point plots. Mirrors the static "instabLegend"
+  # markup in mod_consensus.R (T-357: this output was never bound, leaving
+  # the panel permanently empty).
+  output$instabLegend2 <- renderUI({
+    tagList(
+      tags$span(class = "legendLeft", "Stable"),
+      tags$span(class = "infernoScale legendBar", "\ua0"),
+      tags$span(class = "legendRight", "Unstable")
+    )
+  })
+
   # Clustering module
   cl <- clustering_server("clustering",
     r = r,
@@ -189,9 +201,18 @@ server <- function(input, output, session) {
     if (file.exists(cmdLogFile)) {
       unlink(cmdLogFile)
     }
-    # Clean cached input files from tempdir (data, tree, and excel)
-    unlink(list.files(tempdir(), pattern = "^(data|tree|excel)File-",
-                      full.names = TRUE))
+    # Clean cached input files from tempdir (data, tree, and excel).
+    # Filenames are namespaced by session token (T-356), so this only
+    # touches the ending session's own files, not other tabs' in-progress
+    # uploads sharing the same process-wide tempdir().
+    unlink(list.files(
+      tempdir(),
+      pattern = paste0(
+        "^(data|tree|excel)File-",
+        gsub("[^A-Za-z0-9]", "", session$token), "-"
+      ),
+      full.names = TRUE
+    ))
     # T-312: also remove search/profile cancel + progress signal files; the
     # pattern above does not match them, so they otherwise leak on error /
     # interrupt / disconnect paths and accumulate across searches.

inst/Parsimony/server/logging.R

@@ -207,14 +207,19 @@
   TwoWide <- function(n) {
     formatC(n, width = 2, flag = "0")
   }
+  # tempdir() is shared by every tab of a single running app process, but
+  # these counters reset to 0 per-session — so two tabs' first uploads both
+  # produced "treeFile-01.txt" and silently clobbered each other. Namespace
+  # by session token so concurrent tabs never collide (T-356).
+  sessionTag <- gsub("[^A-Za-z0-9]", "", session$token)
   DataFileName <- function(n) if (length(n)) {
-    paste0("dataFile-", TwoWide(n), ".txt")
+    paste0("dataFile-", sessionTag, "-", TwoWide(n), ".txt")
   }
   ExcelFileName <- function(n) if (length(n)) {
-    paste0("excelFile-", TwoWide(n), ".xlsx")
+    paste0("excelFile-", sessionTag, "-", TwoWide(n), ".xlsx")
   }
   TreeFileName <- function(n) if (length(n)) {
-    paste0("treeFile-", TwoWide(n), ".txt")
+    paste0("treeFile-", sessionTag, "-", TwoWide(n), ".txt")
   }
   LastFile <- function(type) {
     switch(pmatch(type, c("data", "excel", "tree")), 

inst/Parsimony/server/mod_clustering.R

@@ -88,23 +88,24 @@ clustering_server <- function(id, r, distMeth, log_fns) {
     # Clusterings
     ############################################################################
 
-    clusterings <- bindCache(reactive({
-      ## CAUTION: Update LogClusterings() to reflect any changes made
-      ## to this function
-      LogMsg("clusterings()")
+    # The multi-method sweep (K-means++, PAM, hierarchical-minimax across
+    # k = 2..15, each with a full cluster::silhouette() pass) is expensive
+    # but does not depend on silThreshold() at all — that value is only
+    # used afterwards to pick a winner among the already-computed silhouette
+    # scores. Keeping it out of this reactive's cache key means dragging the
+    # threshold slider no longer forces a full re-sweep (T-358).
+    clusterSweep <- bindCache(reactive({
+      LogMsg("clusterSweep()")
       maxCluster <- min(15L, length(r$trees) - 1L)
       if (maxCluster > 1L) {
         possibleClusters <- 2:maxCluster
 
-        hSil <- pamSil <- -99
         dists <- distances()
 
         nMethodsChecked <- 3L
         cli::cli_progress_bar("Computing clusterings", "K-means",
                               total = nMethodsChecked)
 
-        nK <- length(possibleClusters)
-
         kClusters <- lapply(possibleClusters,
                             function(k) TreeDist::KMeansPP(dists, k))
         kSils <- vapply(kClusters, function(kCluster) {
@@ -136,6 +137,25 @@ clustering_server <- function(id, r, distMeth, log_fns) {
         hCluster <- hClusters[[bestH]]
         cli::cli_progress_update(1, status = "Done")
 
+        list(kSil = kSil, kCluster = kCluster, bestK = bestK,
+             pamSil = pamSil, pamCluster = pamCluster, bestPam = bestPam,
+             hSil = hSil, hCluster = hCluster, bestH = bestH)
+      } else {
+        NULL
+      }
+    }), r$treeHash, distMeth())
+
+    clusterings <- reactive({
+      ## CAUTION: Update LogClusterings() to reflect any changes made
+      ## to this function
+      LogMsg("clusterings()")
+      sweep <- clusterSweep()
+
+      if (!is.null(sweep)) {
+        kSil    <- sweep$kSil;    kCluster   <- sweep$kCluster;   bestK   <- sweep$bestK
+        pamSil  <- sweep$pamSil;  pamCluster <- sweep$pamCluster; bestPam <- sweep$bestPam
+        hSil    <- sweep$hSil;    hCluster   <- sweep$hCluster;   bestH   <- sweep$bestH
+
         bestCluster <- c("none", "pam", "hmm", "kmn")[
           which.max(c(silThreshold(), pamSil, hSil, kSil))]
       } else {
@@ -159,8 +179,7 @@ clustering_server <- function(id, r, distMeth, log_fns) {
            cluster = switch(bestCluster, pam = pamCluster, hmm = hCluster,
                             kmn = kCluster, 1)
       )
-
-    }), r$treeHash, silThreshold(), distMeth())
+    })
 
     ############################################################################
     # LogClusterings

inst/Parsimony/server/mod_treespace.R

@@ -743,6 +743,13 @@ treespace_server <- function(id, r, clusterings, silThreshold, scores,
       mppng <- mapping()
       mppng <- mapping()[, seq_len(min(dim(mppng)[2], dims()))]
       neighbs <- min(10L, length(r$trees) / 2)
+      # T-359: unlike the search worker (mod_search.R, T-311), this future has
+      # no session-end cancellation and no mid-flight interruption point —
+      # TreeDist::MappingQuality() runs to completion even after the client
+      # disconnects. Left as-is intentionally: it is a single bounded distance
+      # computation (a handful of seconds even for large tree sets), not an
+      # open-ended search that can run for up to an hour, so an orphaned run
+      # is low-cost and not worth a bespoke cancellation mechanism.
       future_promise(
         TreeDist::MappingQuality(dstnc, dist(mppng), neighbs),
         seed = TRUE) %...>% QualityPlot