diff --git a/inst/Parsimony/server.R b/inst/Parsimony/server.R index 879023da9..30f96af6c 100644 --- a/inst/Parsimony/server.R +++ b/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. diff --git a/inst/Parsimony/server/logging.R b/inst/Parsimony/server/logging.R index 42b49bd3b..cdc682923 100644 --- a/inst/Parsimony/server/logging.R +++ b/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")), diff --git a/inst/Parsimony/server/mod_clustering.R b/inst/Parsimony/server/mod_clustering.R index 9d8c405b4..cecd03d35 100644 --- a/inst/Parsimony/server/mod_clustering.R +++ b/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 diff --git a/inst/Parsimony/server/mod_treespace.R b/inst/Parsimony/server/mod_treespace.R index 6507e1f65..99893d258 100644 --- a/inst/Parsimony/server/mod_treespace.R +++ b/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