diff --git a/.github/workflows/docs-screenshots.yml b/.github/workflows/docs-screenshots.yml new file mode 100644 index 0000000..c15c929 --- /dev/null +++ b/.github/workflows/docs-screenshots.yml @@ -0,0 +1,106 @@ +name: Capture real MAniR documentation screenshots + +on: + push: + branches: + - upgrade/scalable-analysis + paths: + - scripts/capture-docs-screenshots.js + - .github/workflows/docs-screenshots.yml + - app.R + - ui.R + - server.R + - R/** + - www/** + - examples/** + workflow_dispatch: + +concurrency: + group: manir-real-screenshots-${{ github.ref }} + cancel-in-progress: true + +permissions: + contents: write + +jobs: + capture-screens: + name: Real Shiny screenshot capture + if: github.ref == 'refs/heads/upgrade/scalable-analysis' + runs-on: ubuntu-latest + timeout-minutes: 25 + steps: + - uses: actions/checkout@v4 + with: + persist-credentials: true + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + cache-version: 1 + + - uses: actions/setup-node@v4 + with: + node-version: '22' + + - name: Install browser driver + run: | + npm install --no-save --no-package-lock playwright@1.55.1 + if command -v google-chrome >/dev/null 2>&1; then + echo "CHROME_BIN=$(command -v google-chrome)" >> "$GITHUB_ENV" + elif command -v chromium >/dev/null 2>&1; then + echo "CHROME_BIN=$(command -v chromium)" >> "$GITHUB_ENV" + else + npx playwright install --with-deps chromium + fi + + - name: Start real MAniR Shiny app + run: | + nohup Rscript -e "shiny::runApp('.', host='127.0.0.1', port=3838, launch.browser=FALSE)" \ + > "$RUNNER_TEMP/manir-shiny.log" 2>&1 & + echo $! > "$RUNNER_TEMP/manir-shiny.pid" + for attempt in $(seq 1 90); do + if curl --silent --fail --output /dev/null http://127.0.0.1:3838; then + echo "MAniR is running"; break + fi + sleep 2 + done + curl --silent --fail http://127.0.0.1:3838 >/dev/null || { + cat "$RUNNER_TEMP/manir-shiny.log" + exit 1 + } + + - name: Capture actual example-data screens + run: node scripts/capture-docs-screenshots.js + env: + MANIR_SCREENSHOT_URL: http://127.0.0.1:3838 + + - name: Upload screenshots for review + if: always() + uses: actions/upload-artifact@v4 + with: + name: actual-manir-screenshots + path: docs/images/*.png + if-no-files-found: warn + + - name: Store actual screenshots on development branch + if: success() + run: | + git config user.name "github-actions[bot]" + git config user.email "41898282+github-actions[bot]@users.noreply.github.com" + git add docs/images/*.png + if git diff --cached --quiet; then + echo "Documentation screenshots unchanged" + else + git commit -m "docs: update real Shiny screenshots from synthetic example" + # The docs may have changed while this browser job was running. + git fetch origin upgrade/scalable-analysis + git rebase origin/upgrade/scalable-analysis + git push origin HEAD:upgrade/scalable-analysis + fi + + - name: Show Shiny server logs on failure + if: failure() + run: cat "$RUNNER_TEMP/manir-shiny.log" || true diff --git a/.github/workflows/r-tests.yml b/.github/workflows/r-tests.yml new file mode 100644 index 0000000..e89abc7 --- /dev/null +++ b/.github/workflows/r-tests.yml @@ -0,0 +1,53 @@ +name: MAniR tests and benchmark smoke + +on: + push: + branches: + - main + - upgrade/** + pull_request: + +jobs: + r-tests: + name: R regression suite + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + cache-version: 1 + extra-packages: | + any::data.table + any::fastcluster + - name: Test numerical correctness, files and plot export + run: Rscript tests/run_tests.R + - name: Parse and load the Shiny application + run: Rscript -e "stopifnot(inherits(getElement(source('app.R'), 'value'), 'shiny.appobj'))" + - name: Shiny upload smoke test + run: Rscript tests/test_shiny.R + - name: Benchmark smoke + run: Rscript benchmarks/benchmark.R --smoke + - name: Upload benchmark smoke results + uses: actions/upload-artifact@v4 + with: + name: MAniR-benchmark-smoke + path: benchmarks/results/*-smoke.csv + + windows-tests: + name: Windows regression suite + runs-on: windows-latest + steps: + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-r@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + cache-version: 1 + - name: Regression tests + run: Rscript tests/run_tests.R + - name: Parse and load application + run: Rscript -e "stopifnot(inherits(getElement(source('app.R'), 'value'), 'shiny.appobj'))" + - name: Shiny upload smoke test + run: Rscript tests/test_shiny.R diff --git a/.gitignore b/.gitignore index 6ce1d85..f60b9b9 100644 --- a/.gitignore +++ b/.gitignore @@ -41,3 +41,6 @@ vignettes/*.pdf # Shinyapps.io information rsconnect/ .lintr + +# Generated benchmark measurements +benchmarks/results/ diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..153d24e --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,22 @@ +Package: MAniR +Type: Project +Title: Interactive Pairwise Matrix Comparison for MALDI-TOF and Genomic Analysis +Version: 3.0.0 +Authors@R: person("BiKC", role = "aut") +Description: Shiny application to compare similarity, correlation and distance + matrices using scalable visualization, isolate-level metadata and + pairwise analytical summaries. The application is run directly from app.R. +License: GPL-3 +Encoding: UTF-8 +Depends: + R (>= 4.2.0) +Imports: + shiny, + plotly, + htmltools, + htmlwidgets, + openxlsx, + RColorBrewer +Suggests: + data.table, + fastcluster diff --git a/R/example_data.R b/R/example_data.R new file mode 100644 index 0000000..2be4d13 --- /dev/null +++ b/R/example_data.R @@ -0,0 +1,55 @@ +# Built-in teaching example. All values are synthetic, not measured isolates. +manir_example_files <- function(root = ".") { + c(ANI = file.path(root, "examples", "ani.csv"), + MALDI = file.path(root, "examples", "maldi.csv"), + metadata = file.path(root, "examples", "metadata.csv")) +} + +manir_load_example <- function(root = ".") { + paths <- manir_example_files(root) + missing <- paths[!file.exists(paths)] + if (length(missing)) { + stop("Built-in example files are missing: ", + paste(basename(missing), collapse = ", ")) + } + ani <- read_matrix_input(paths[["ANI"]], kind = "similarity") + maldi <- read_matrix_input(paths[["MALDI"]], kind = "similarity") + matched <- match_matrices(ani, maldi) + metadata <- read_metadata_input(paths[["metadata"]]) + if (!setequal(rownames(metadata), matched$ids)) { + stop("Built-in example metadata does not match the matrix identifiers.") + } + list(first = ani, second = maldi, + metadata = align_metadata(metadata, matched$ids)) +} + +manir_write_example_workbook <- function(destination, root = ".") { + example <- manir_load_example(root) + wb <- openxlsx::createWorkbook() + for (name in c("ANI", "MALDI")) { + m <- if (name == "ANI") example$first else example$second + openxlsx::addWorksheet(wb, name) + openxlsx::writeData(wb, name, + data.frame(sample_id = rownames(m), m, check.names = FALSE)) + openxlsx::freezePane(wb, name, firstRow = TRUE, firstCol = TRUE) + } + openxlsx::addWorksheet(wb, "metadata") + openxlsx::writeData(wb, "metadata", + data.frame(sample_id = rownames(example$metadata), + example$metadata, check.names = FALSE)) + openxlsx::freezePane(wb, "metadata", firstRow = TRUE, firstCol = TRUE) + openxlsx::addWorksheet(wb, "README") + openxlsx::writeData(wb, "README", data.frame( + Notes = c( + "MAniR built-in example. All data are SYNTHETIC and intended for demonstration only.", + "ANI: fictional percentage-like genomic similarity, diagonal = 100.", + "MALDI: fictional spectral similarity on a 0-to-1 scale, diagonal = 1.", + "The two matrices use different scales. Do not enable comparable-units metrics.", + "Metadata includes three fictional groups, specimen source and measurement batch.", + "Two pairs deliberately have discordant MALDI/ANI relationships for exploration.", + "Select ANI as matrix 1, MALDI as matrix 2, and metadata as the annotation sheet." + ), check.names = FALSE)) + openxlsx::setColWidths(wb, "README", cols = 1, widths = 100) + openxlsx::saveWorkbook(wb, destination, overwrite = TRUE) + invisible(destination) +} diff --git a/R/matrix_analysis.R b/R/matrix_analysis.R new file mode 100644 index 0000000..351c8e4 --- /dev/null +++ b/R/matrix_analysis.R @@ -0,0 +1,227 @@ +# Reusable matrix calculations; no Shiny dependencies. + +matrix_order <- function(m, kind = c("auto", "similarity", "correlation", "distance"), + cluster = TRUE, max_cluster = 2000L, linkage = "complete") { + kind <- match.arg(kind) + ids <- colnames(m) + if (!cluster || nrow(m) > max_cluster) + return(list(ids = ids, tree = NULL, skipped = nrow(m) > max_cluster)) + x <- m + if (kind == "distance") { + if (any(x < 0, na.rm = TRUE)) stop("Negative dissimilarities are invalid.") + } else if (kind == "correlation") { + x <- 1 - x + } else { + # Includes auto: larger entries mean more similar, regardless of scale. + x <- max(x, na.rm = TRUE) - x + } + if (anyNA(x)) { + replacement <- max(x, na.rm = TRUE) + x[is.na(x)] <- replacement + } + diag(x) <- 0 + d <- stats::as.dist(x) + tree <- if (requireNamespace("fastcluster", quietly = TRUE)) + fastcluster::hclust(d, method = linkage) + else stats::hclust(d, method = linkage) + list(ids = ids[tree$order], tree = tree, skipped = FALSE) +} + +# Return indices of the strictly upper triangle without creating an n*n mask +# for sampled large matrices. Each pair is returned exactly once. +upper_pair_indices <- function(n, max_pairs = 100000L, seed = 1L) { + n <- as.integer(n) + total <- as.double(n) * (n - 1) / 2 + if (n < 2L) stop("At least two isolates are required.") + max_pairs <- max(1L, as.integer(max_pairs)) + if (total <= max_pairs) { + j <- rep.int(seq.int(2L, n), seq.int(1L, n - 1L)) + i <- sequence(seq.int(1L, n - 1L)) + return(list(i = i, j = j, total = total, sampled = FALSE)) + } + # Local RNG restoration prevents an analysis from modifying the session RNG. + had_seed <- exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE) + if (had_seed) old_seed <- get(".Random.seed", envir = .GlobalEnv) + on.exit({ + if (had_seed) assign(".Random.seed", old_seed, envir = .GlobalEnv) + else if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) + rm(".Random.seed", envir = .GlobalEnv) + }, add = TRUE) + set.seed(seed) + k <- sort(sample.int(total, max_pairs)) + j <- ceiling((1 + sqrt(1 + 8 * k)) / 2) + i <- k - (j - 1) * (j - 2) / 2 + list(i = as.integer(i), j = as.integer(j), total = total, sampled = TRUE) +} + +paired_values <- function(a, b, max_pairs = 100000L, seed = 1L) { + if (!identical(dim(a), dim(b)) || + !identical(rownames(a), rownames(b)) || + !identical(colnames(a), colnames(b))) + stop("The matrices must have the same sample order.") + ix <- upper_pair_indices(nrow(a), max_pairs = max_pairs, seed = seed) + x <- a[cbind(ix$i, ix$j)] + y <- b[cbind(ix$i, ix$j)] + good <- is.finite(x) & is.finite(y) + list(data = data.frame(sample_1 = rownames(a)[ix$i[good]], + sample_2 = colnames(a)[ix$j[good]], + first = x[good], second = y[good], + difference = x[good] - y[good]), + total_pairs = ix$total, evaluated_pairs = length(x), + valid_pairs = sum(good), sampled = ix$sampled, seed = seed) +} + +matrix_agreement <- function(pairs) { + d <- pairs$data + if (nrow(d) < 3L) return(list(pearson = NA_real_, spearman = NA_real_, + mae = NA_real_, rmse = NA_real_, n = nrow(d))) + list( + pearson = if (stats::sd(d$first) > 0 && stats::sd(d$second) > 0) + stats::cor(d$first, d$second) else NA_real_, + spearman = if (length(unique(d$first)) > 1L && length(unique(d$second)) > 1L) + suppressWarnings(stats::cor(d$first, d$second, method = "spearman")) + else NA_real_, + # Differences are meaningful only for matrices on comparable scales. + mae = mean(abs(d$difference)), rmse = sqrt(mean(d$difference^2)), + n = nrow(d) + ) +} + +# A Mantel-style label permutation; not an ordinary p-value from treating +# all pairwise edges as independent. Intended for moderate complete matrices. +matrix_mantel <- function(a, b, permutations = 999L, seed = 1L, + method = c("pearson", "spearman"), max_n = 400L) { + method <- match.arg(method) + if (nrow(a) != nrow(b) || + !identical(rownames(a), rownames(b)) || + !identical(colnames(a), colnames(b))) + stop("Match matrices before calculating the Mantel test.") + n <- nrow(a) + if (n > max_n) stop("Mantel permutation exceeds the configured isolate limit.") + if (anyNA(a) || anyNA(b)) stop("Mantel permutation needs complete matrices.") + idx <- upper.tri(a) + x <- a[idx] + y <- b[idx] + if (stats::sd(x) == 0 || stats::sd(y) == 0) + stop("A constant matrix cannot be tested.") + obs <- suppressWarnings(stats::cor(x, y, method = method)) + permutations <- as.integer(permutations) + if (permutations < 1L) stop("Request at least one permutation.") + had_seed <- exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE) + if (had_seed) old_seed <- get(".Random.seed", envir = .GlobalEnv) + on.exit({ + if (had_seed) assign(".Random.seed", old_seed, envir = .GlobalEnv) + else if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) + rm(".Random.seed", envir = .GlobalEnv) + }, add = TRUE) + set.seed(seed) + null <- replicate(permutations, { + perm <- sample.int(n) + suppressWarnings(stats::cor(x, b[perm, perm, drop = FALSE][idx], + method = method)) + }) + list(observed = obs, p_two_sided = (1 + sum(abs(null) >= abs(obs))) / + (permutations + 1), permutations = permutations, seed = seed, + method = method) +} + +adjusted_rand <- function(labels_a, labels_b) { + if (length(labels_a) != length(labels_b) || length(labels_a) < 2L) + stop("Both cluster assignments must include the same isolates.") + tab <- table(labels_a, labels_b) + choose2 <- function(z) sum(z * (z - 1) / 2) + nij <- choose2(tab) + ai <- choose2(rowSums(tab)) + bj <- choose2(colSums(tab)) + all_pairs <- choose(length(labels_a), 2) + expected <- ai * bj / all_pairs + maximum <- (ai + bj) / 2 + if (maximum == expected) return(if (nij == maximum) 1 else NA_real_) + (nij - expected) / (maximum - expected) +} + + +adjusted_wallace <- function(labels_a, labels_b) { + if (length(labels_a) != length(labels_b) || length(labels_a) < 2L) + stop("Cluster assignments must refer to the same isolates.") + tab <- table(labels_a, labels_b) + pairs <- function(x) sum(x * (x - 1) / 2) + same_in_both <- pairs(tab) + same_in_first <- pairs(rowSums(tab)) + expected_b <- pairs(colSums(tab)) / choose(length(labels_a), 2) + if (same_in_first == 0 || expected_b >= 1) return(NA_real_) + (same_in_both / same_in_first - expected_b) / (1 - expected_b) +} + +cluster_concordance <- function(a, b, kind_a = "similarity", + kind_b = "similarity", k = 3L, + max_n = 2000L, linkage = "complete") { + if (!identical(rownames(a), rownames(b))) stop("Align matrices first.") + if (k < 2L || k >= nrow(a)) stop("Choose between 2 and n-1 clusters.") + ca <- matrix_order(a, kind = kind_a, max_cluster = max_n, + linkage = linkage) + cb <- matrix_order(b, kind = kind_b, max_cluster = max_n, + linkage = linkage) + if (is.null(ca$tree) || is.null(cb$tree)) + stop("Cluster concordance exceeds the configured clustering limit.") + first <- stats::cutree(ca$tree, k = k) + second <- stats::cutree(cb$tree, k = k) + list(ari = adjusted_rand(first, second), + adjusted_wallace_1_to_2 = adjusted_wallace(first, second), + adjusted_wallace_2_to_1 = adjusted_wallace(second, first), + assignments = data.frame(sample_id = rownames(a), + first = unname(first[rownames(a)]), + second = unname(second[rownames(a)])), + contingency = table(first, second)) +} + +replicate_summary <- function(m, metadata, group_column, max_pairs = 100000L) { + if (is.null(metadata) || !group_column %in% names(metadata)) + stop("Select a valid metadata column identifying replicates or groups.") + ids <- rownames(m) + meta <- align_metadata(metadata, ids) + groups <- as.character(meta[[group_column]]) + pp <- upper_pair_indices(nrow(m), max_pairs = max_pairs) + valid <- is.finite(m[cbind(pp$i, pp$j)]) & + !is.na(groups[pp$i]) & !is.na(groups[pp$j]) + values <- m[cbind(pp$i[valid], pp$j[valid])] + within <- groups[pp$i[valid]] == groups[pp$j[valid]] + data.frame(type = c("Within group", "Between groups"), + pairs = c(sum(within), sum(!within)), + mean = c(if (any(within)) mean(values[within]) else NA_real_, + if (any(!within)) mean(values[!within]) else NA_real_), + median = c(if (any(within)) stats::median(values[within]) else NA_real_, + if (any(!within)) stats::median(values[!within]) else NA_real_), + sampled = pp$sampled) +} + +# Exploratory comparison of the order of isolate pairs when measurements have +# different units. A gap is the difference between empirical percentile ranks, +# after making smaller distances mean greater similarity. It is not a p-value +# or a biological cutoff, and it is based on the sampled pairs when sampling. +pair_rank_gaps <- function(pairs, kind1 = "similarity", + kind2 = "similarity", top = 10L) { + d <- pairs$data + if (nrow(d) < 3L) return(data.frame()) + if (!kind1 %in% c("auto", "similarity", "correlation", "distance") || + !kind2 %in% c("auto", "similarity", "correlation", "distance")) + stop("Unrecognized matrix type.") + score1 <- if (kind1 == "distance") -d$first else d$first + score2 <- if (kind2 == "distance") -d$second else d$second + n <- nrow(d) + d$rank_gap <- abs((rank(score1, ties.method = "average") - + rank(score2, ties.method = "average")) / n) + d <- d[order(d$rank_gap, decreasing = TRUE), , drop = FALSE] + rownames(d) <- NULL + utils::head(d[c("sample_1", "sample_2", "first", "second", "rank_gap")], + as.integer(top)) +} + +# Keep the exported table honest when the source measurements use different +# units. The internal pairwise values still include the difference for +# calculations that are explicitly enabled only for compatible measurements. +pair_export_data <- function(pairs, comparable = FALSE) { + result <- pairs$data + if (!isTRUE(comparable)) result$difference <- NULL + result +} diff --git a/R/matrix_io.R b/R/matrix_io.R new file mode 100644 index 0000000..447b633 --- /dev/null +++ b/R/matrix_io.R @@ -0,0 +1,169 @@ +# Input and validation shared by the Shiny application and command-line tools. + +matrix_sheet_names <- function(path, format = path) { + ext <- tolower(tools::file_ext(format)) + if (ext %in% c("xlsx", "xlsm")) return(openxlsx::getSheetNames(path)) + character() +} + +read_matrix_input <- function(path, sheet = NULL, workbook = NULL, format = path, + kind = "auto") { + ext <- tolower(tools::file_ext(format)) + if (ext %in% c("xlsx", "xlsm")) { + if (is.null(sheet) || identical(sheet, "")) stop("Select a matrix worksheet.") + if (is.null(workbook)) workbook <- openxlsx::loadWorkbook(path) + x <- openxlsx::readWorkbook(workbook, sheet = sheet, colNames = TRUE, + rowNames = TRUE) + } else if (ext == "rds") { + x <- readRDS(path) + } else if (ext %in% c("csv", "tsv", "txt", "gz")) { + sep <- if (ext == "tsv" || grepl("\\.tsv\\.gz$", format, ignore.case = TRUE)) "\t" else "," + if (ext != "gz" && requireNamespace("data.table", quietly = TRUE)) { + x <- data.table::fread(path, sep = sep, data.table = FALSE, + check.names = FALSE, showProgress = FALSE, + colClasses = list(character = 1L)) + if (ncol(x) < 2L) stop("The file needs an ID column and matrix columns.") + ids <- x[[1L]] + x <- x[-1L] + rownames(x) <- as.character(ids) + } else { + # Detect header width without parsing all of the large matrix as text. + # Explicitly read the first ID column as character to retain "0012". + header_con <- if (ext == "gz") gzfile(path, "rt") else file(path, "rt") + columns <- tryCatch( + scan(header_con, what = character(), sep = sep, quote = '"', + nlines = 1L, quiet = TRUE), + finally = close(header_con)) + classes <- c("character", rep(NA_character_, max(0L, length(columns) - 1L))) + x <- utils::read.table(path, sep = sep, header = TRUE, row.names = 1L, + check.names = FALSE, comment.char = "", + stringsAsFactors = FALSE, colClasses = classes) + } + } else { + stop("Unsupported matrix format. Use XLSX, CSV, TSV, CSV.GZ, TSV.GZ or RDS.") + } + validate_matrix(x, kind = kind) +} + +validate_matrix <- function(x, kind = c("auto", "similarity", "correlation", "distance"), + symmetry_tolerance = 1e-8, allow_missing = TRUE) { + kind <- match.arg(kind) + if (!is.matrix(x) && !is.data.frame(x)) stop("Input must be a matrix or table.") + if (nrow(x) != ncol(x) || nrow(x) < 2L) + stop("The matrix must be square and contain at least two isolates.") + row_ids <- rownames(x) + col_ids <- colnames(x) + if (is.null(row_ids) || is.null(col_ids)) + stop("Both row and column sample IDs are required.") + row_ids <- trimws(row_ids) + col_ids <- trimws(col_ids) + if (anyNA(row_ids) || anyNA(col_ids) || any(!nzchar(row_ids)) || + any(!nzchar(col_ids))) stop("Sample IDs must not be empty.") + if (anyDuplicated(row_ids) || anyDuplicated(col_ids)) + stop("Duplicate sample IDs were found after trimming whitespace.") + if (!setequal(row_ids, col_ids)) { + only_rows <- setdiff(row_ids, col_ids) + only_cols <- setdiff(col_ids, row_ids) + stop(sprintf("Row and column IDs differ. Only in rows: %s. Only in columns: %s.", + paste(head(only_rows, 10L), collapse = ", "), + paste(head(only_cols, 10L), collapse = ", "))) + } + if ((is.matrix(x) && is.numeric(x)) || + (is.data.frame(x) && all(vapply(x, is.numeric, logical(1L))))) { + # Fast path: common fread/openxlsx inputs contain numeric columns. + # Materialize a single numeric matrix rather than three dense copies. + m <- if (is.matrix(x)) x else as.matrix(x) + dimnames(m) <- list(row_ids, col_ids) + } else { + original <- as.matrix(x) + converted <- suppressWarnings(as.numeric(original)) + empty <- is.na(original) | trimws(as.character(original)) == "" + if (any(is.na(converted) & !empty)) + stop("The matrix has nonnumeric values. Check the data worksheets.") + m <- matrix(converted, nrow = nrow(x), ncol = ncol(x), + dimnames = list(row_ids, col_ids)) + } + # Reorder only when necessary; with 10k isolates, one copy costs 800 MB. + if (!identical(row_ids, col_ids)) + m <- m[col_ids, col_ids, drop = FALSE] + if (any(is.infinite(m))) stop("Infinite matrix values are not supported.") + if (!allow_missing && anyNA(m)) stop("Missing matrix values are not allowed.") + if (anyNA(diag(m))) stop("Every diagonal entry must be present.") + # Verify exact symmetry in blocks to avoid allocating N*N transposed, + # missingness and difference matrices simultaneously. + n <- nrow(m) + block_size <- 256L + for (start in seq.int(1L, n, by = block_size)) { + ix <- seq.int(start, min(n, start + block_size - 1L)) + left <- m[ix, , drop = FALSE] + right <- t(m[, ix, drop = FALSE]) + if (!identical(is.na(left), is.na(right))) + stop("Missing values must occur in mirrored pairs for a symmetric matrix.") + if (any(abs(left - right) > symmetry_tolerance, na.rm = TRUE)) + stop("The matrix must be symmetric; mirrored cells disagree.") + } + if (kind == "correlation" && + (min(m, na.rm = TRUE) < -1 - symmetry_tolerance || + max(m, na.rm = TRUE) > 1 + symmetry_tolerance)) + stop("Correlation values must lie between -1 and 1.") + if (kind %in% c("similarity", "distance") && + min(m, na.rm = TRUE) < -symmetry_tolerance) + stop("Similarity and distance matrices cannot contain negative values.") + attr(m, "matrix_kind") <- kind + m +} + +read_metadata_input <- function(path, sheet = NULL, workbook = NULL, format = path) { + ext <- tolower(tools::file_ext(format)) + if (ext %in% c("xlsx", "xlsm")) { + if (is.null(sheet) || sheet == "None") return(NULL) + if (is.null(workbook)) workbook <- openxlsx::loadWorkbook(path) + x <- openxlsx::readWorkbook(workbook, sheet = sheet, + colNames = TRUE, rowNames = TRUE) + } else if (ext == "rds") { + x <- readRDS(path) + } else { + sep <- if (ext == "tsv" || grepl("\\.tsv\\.gz$", format, ignore.case = TRUE)) "\t" else "," + x <- utils::read.table(path, sep = sep, header = TRUE, row.names = 1L, + check.names = FALSE, stringsAsFactors = FALSE) + } + if (!is.data.frame(x)) x <- as.data.frame(x, stringsAsFactors = FALSE) + ids <- trimws(rownames(x)) + if (any(!nzchar(ids)) || anyDuplicated(ids)) + stop("Metadata must have unique, nonempty sample IDs.") + rownames(x) <- ids + x +} + +align_metadata <- function(metadata, ids) { + if (is.null(metadata)) return(NULL) + if (!all(ids %in% rownames(metadata))) + warning(sprintf("%d isolates have no metadata; their annotations are missing.", + sum(!ids %in% rownames(metadata)))) + metadata[match(ids, rownames(metadata)), , drop = FALSE] +} + +match_matrices <- function(first, second, mode = c("strict", "intersection")) { + mode <- match.arg(mode) + ids1 <- colnames(first) + ids2 <- colnames(second) + if (mode == "strict" && !setequal(ids1, ids2)) + stop(sprintf("The matrices differ: %d IDs only in matrix 1 and %d only in matrix 2. Select 'Shared isolates' to compare the intersection.", + length(setdiff(ids1, ids2)), length(setdiff(ids2, ids1)))) + ids <- if (mode == "strict") ids1 else intersect(ids1, ids2) + if (length(ids) < 2L) stop("At least two shared sample IDs are required.") + list(first = if (identical(ids, rownames(first)) && + identical(ids, colnames(first))) first + else first[ids, ids, drop = FALSE], + second = if (identical(ids, rownames(second)) && + identical(ids, colnames(second))) second + else second[ids, ids, drop = FALSE], + ids = ids, + only_first = setdiff(ids1, ids2), + only_second = setdiff(ids2, ids1)) +} + +write_matrix_csv <- function(m, file) { + utils::write.csv(data.frame(sample_id = rownames(m), m, check.names = FALSE), + file = file, row.names = FALSE, na = "") +} diff --git a/R/matrix_plot.R b/R/matrix_plot.R new file mode 100644 index 0000000..51ffee4 --- /dev/null +++ b/R/matrix_plot.R @@ -0,0 +1,275 @@ +# Rendering for standard and large matrices. No matrix analysis is performed here. + +ma_colors <- function(palette = "RdBu", n = 256L, reverse = FALSE) { + palettes <- c("RdBu", "BrBG", "PiYG", "PRGn", "PuOr", "RdYlBu", + "YlOrRd", "Viridis", "Blues", "Greens", "Greys") + if (!palette %in% palettes) palette <- "RdBu" + if (palette == "Viridis") return(grDevices::hcl.colors(n, "Viridis")) + if (requireNamespace("RColorBrewer", quietly = TRUE)) { + max_colors <- min(11L, RColorBrewer::brewer.pal.info[palette, "maxcolors"]) + base <- RColorBrewer::brewer.pal(max_colors, palette) + } else { + base <- grDevices::hcl.colors(11L, "Blue-Red 3") + } + if (reverse) base <- rev(base) + grDevices::colorRampPalette(base)(n) +} + +ma_scale <- function(x, log_scale = FALSE, center_zero = FALSE) { + original <- x + valid <- is.finite(x) + if (!any(valid)) stop("There are no finite values to display.") + if (log_scale) { + if (any(x[valid] < 0)) stop("Log scaling requires nonnegative values.") + x[valid] <- log1p(x[valid]) + } + if (center_zero) { + if (log_scale) stop("Zero-centered scaling cannot use logarithms.") + radius <- max(abs(x[valid])) + x[valid] <- if (radius == 0) 0.5 else 0.5 + 0.5 * x[valid] / radius + } else { + rng <- range(x[valid]) + if (diff(rng) == 0) { + x[valid] <- 0.5 + } else { + x[valid] <- (x[valid] - rng[1L]) / diff(rng) + } + } + x[!valid] <- NA_real_ + attr(x, "original_range") <- range(original[valid]) + x +} + +ma_combined <- function(first, second, log_scale = FALSE) { + if (!identical(dimnames(first), dimnames(second))) + stop("Both matrices must have the same sample ordering.") + a <- ma_scale(first, log_scale) + b <- ma_scale(second, log_scale) + combined <- a + combined[lower.tri(combined)] <- b[lower.tri(b)] + diag(combined) <- 0.5 + actual <- first + actual[lower.tri(actual)] <- second[lower.tri(second)] + list(values = combined, original = actual, + first_range = attr(a, "original_range"), + second_range = attr(b, "original_range")) +} + +# Deterministic categorical colors so a group retains its color when a +# different matrix ordering is selected. Large category lists are omitted +# from the compact track; the full values remain in the metadata table. +ma_metadata_palette <- function(metadata, group_column, max_categories = 12L) { + if (is.null(metadata) || is.null(group_column) || + length(group_column) != 1L || is.na(group_column) || + !nzchar(group_column) || !group_column %in% names(metadata)) + return(NULL) + values <- as.character(metadata[[group_column]]) + categories <- sort(unique(values[!is.na(values) & nzchar(values)])) + if (length(categories) == 0L || length(categories) > max_categories) + return(NULL) + stats::setNames( + grDevices::hcl.colors(length(categories), "Set 2"), categories) +} + +# Plotly is intentionally limited to manageable interactive views; the +# large-matrix renderer does not transmit hundreds of thousands of cell labels. +ma_interactive <- function(m, name = "Matrix", palette = "RdBu", + show_numbers = FALSE, combined = FALSE, + first_name = "Matrix 1", second_name = "Matrix 2", + log_scale = FALSE, center_zero = FALSE, + metadata = NULL, group_column = NULL) { + if (!requireNamespace("plotly", quietly = TRUE)) + stop("Install the plotly package for interactive plots.") + n <- if (combined) nrow(m$first) else nrow(m) + if (n > 300L) stop("Use the raster renderer for matrices above 300 isolates.") + if (combined) { + norm <- ma_combined(m$first, m$second, log_scale) + z <- norm$values + original <- norm$original + } else { + original <- m + z <- ma_scale(m, log_scale, center_zero) + } + ids <- rownames(original) + ids_safe <- htmltools::htmlEscape(ids) + hover <- matrix("", nrow = n, ncol = n) + for (j in seq_len(n)) { + dataset <- if (combined) ifelse(seq_len(n) < j, first_name, + ifelse(seq_len(n) > j, second_name, "Diagonal")) else name + hover[, j] <- paste0("Row: ", ids_safe, "
Column: ", ids_safe[j], + "
", dataset, ": ", format(original[, j], + digits = 8L, trim = TRUE)) + } + shapes <- NULL + palette_key <- ma_metadata_palette(metadata, group_column) + if (!is.null(metadata) && !is.null(group_column) && + length(group_column) == 1L && !is.na(group_column) && + nzchar(group_column) && group_column %in% names(metadata)) { + groups <- as.character(metadata[match(ids, rownames(metadata)), group_column]) + group_text <- htmltools::htmlEscape(ifelse(is.na(groups), "Missing", groups)) + for (j in seq_len(n)) + hover[, j] <- paste0(hover[, j], "
", + htmltools::htmlEscape(group_column), ": ", + group_text) + if (!is.null(palette_key)) { + selected <- unname(palette_key[groups]) + selected[is.na(selected)] <- "#E5E5E5" + # Draw the metadata strip ABOVE the heatmap rather than on its left. + # That keeps the y-axis isolate IDs unobstructed. + shapes <- lapply(seq_len(n), function(i) { + list(type = "rect", xref = "x", yref = "paper", + x0 = i - 1.45, x1 = i - 0.55, + y0 = 1.015, y1 = 1.045, + fillcolor = selected[i], line = list(width = 0)) + }) + } + } + note <- NULL + if (show_numbers && n <= 70L) { + note <- matrix(format(round(original, 2L), trim = TRUE), + nrow = n, ncol = n) + } + p <- plotly::plot_ly( + x = ids, y = rev(ids), z = z[n:1L, , drop = FALSE], + text = hover[n:1L, , drop = FALSE], + type = "heatmap", colors = ma_colors(palette), + zmin = 0, zmax = 1, hoverinfo = "text", + showscale = TRUE, + colorbar = list(title = "Relative display color (0-1)") + ) + if (!is.null(note)) { + # Text labels only for small matrices; large labels overload the browser. + for (i in seq_len(n)) { + p <- plotly::add_annotations(p, x = ids, y = ids[i], + text = note[i, ], xref = "x", yref = "y", showarrow = FALSE, + font = list(size = if (n > 35L) 7L else 10L)) + } + } + plotly::layout(p, title = name, + xaxis = list(title = "", side = "bottom", tickangle = -65, + automargin = TRUE), + yaxis = list(title = "", automargin = TRUE), + shapes = shapes, + margin = list(l = 95, b = 130, r = 30, t = 95)) +} + +# Representative-pixel preview: never use the reduced view for numerical +# inference. The original matrix remains available for exact cell inspection. +ma_preview <- function(m, max_side = 512L) { + n <- nrow(m) + ix <- unique(as.integer(round(seq.int(1L, n, length.out = min(n, max_side))))) + list(matrix = m[ix, ix, drop = FALSE], indices = ix, full_n = n, + sampled = length(ix) < n) +} + +ma_raster <- function(m, palette = "RdBu", title = "", + max_side = 512L, log_scale = FALSE, + metadata = NULL, group_column = NULL, + normalized = FALSE, center_zero = FALSE) { + preview <- ma_preview(m, max_side) + x <- preview$matrix + z <- if (normalized) x else ma_scale(x, log_scale, center_zero) + cols <- ma_colors(palette) + values <- as.integer(1 + round(z * (length(cols) - 1L))) + color_matrix <- matrix(NA_character_, nrow(z), ncol(z)) + finite <- is.finite(z) + color_matrix[finite] <- cols[values[finite]] + color_matrix[!finite] <- "#E5E5E5" + # Rows of a raster are drawn top to bottom. + pix <- grDevices::as.raster(color_matrix) + n <- nrow(x) + show_at <- unique(as.integer(round(seq(1, n, length.out = min(n, 16L))))) + plot(NA, xlim = c(0, n + 0.5), ylim = c(0.5, n + 0.5), + xaxs = "i", yaxs = "i", asp = 1, axes = FALSE, + xlab = "", ylab = "", main = title) + graphics::rasterImage(pix, 0.5, 0.5, n + 0.5, n + 0.5, + interpolate = FALSE) + axis(1, at = show_at, labels = colnames(x)[show_at], + las = 2, cex.axis = 0.55) + axis(2, at = n + 1L - show_at, labels = rownames(x)[show_at], + las = 2, cex.axis = 0.55) + box() + if (!is.null(metadata) && !is.null(group_column) && nzchar(group_column) && + group_column %in% colnames(metadata)) { + groups <- as.character(metadata[match(rownames(x), rownames(metadata)), + group_column]) + key <- ma_metadata_palette(metadata, group_column) + if (!is.null(key)) { + fill <- unname(key[groups]) + fill[is.na(fill)] <- "#E5E5E5" + # The annotation strip sits in the narrow gap outside the heatmap. + # Its legend is displayed in a separate panel above the Shiny plot. + graphics::rect(0.06, n - seq_len(n) + 0.5, 0.40, + n - seq_len(n) + 1.5, col = fill, border = NA) + } + } + if (preview$sampled) + mtext(sprintf("Representative view: %d of %d isolates. Inspect original values in the table.", + n, preview$full_n), side = 3, line = 0, cex = 0.75) + invisible(preview) +} + +ma_save_png <- function(m, file, palette = "RdBu", title = "", + max_side = 1200L, normalized = FALSE, + log_scale = FALSE) { + grDevices::png(file, width = 1700L, height = 1600L, res = 160L) + on.exit(grDevices::dev.off(), add = TRUE) + graphics::par(mar = c(9, 9, 5, 2)) + ma_raster(m, palette = palette, title = title, max_side = max_side, + normalized = normalized, log_scale = log_scale) + invisible(file) +} + + +# Vector cells are useful for journal figures at modest dimensions. Rendering +# millions of individual rectangles into PDF/SVG would be excessive, so larger +# figures embed the same documented representative raster overview instead. +ma_publication_plot <- function(m, palette = "RdBu", title = "", + normalized = FALSE, vector_limit = 150L, + log_scale = FALSE) { + n <- nrow(m) + if (n > vector_limit) { + ma_raster(m, palette = palette, title = title, max_side = 1200L, + normalized = normalized, log_scale = log_scale) + return(invisible(FALSE)) + } + z <- if (normalized) m else ma_scale(m, log_scale = log_scale) + cols <- ma_colors(palette) + scaled <- as.integer(1 + round(z * (length(cols) - 1L))) + fill <- matrix("#E5E5E5", nrow(z), ncol(z)) + good <- is.finite(z) + fill[good] <- cols[scaled[good]] + i <- rep.int(seq_len(n), times = n) + j <- rep(seq_len(n), each = n) + graphics::plot(NA_real_, xlim = c(0.5, n + 0.5), + ylim = c(0.5, n + 0.5), xaxs = "i", yaxs = "i", + asp = 1, axes = FALSE, xlab = "", ylab = "", main = title) + # One vector rectangle per cell, with original numeric values retained + # separately in CSV/RDS rather than embedded into rendered colors. + graphics::rect(j - 0.5, n - i + 0.5, j + 0.5, n - i + 1.5, + col = fill[cbind(i, j)], border = NA) + at <- unique(as.integer(round(seq.int(1L, n, length.out = min(20L, n))))) + graphics::axis(1, at = at, labels = colnames(m)[at], las = 2, cex.axis = 0.6) + graphics::axis(2, at = n + 1L - at, labels = rownames(m)[at], + las = 2, cex.axis = 0.6) + graphics::box() + invisible(TRUE) +} + +ma_save_pdf <- function(m, file, palette = "RdBu", title = "", + normalized = FALSE, log_scale = FALSE) { + grDevices::pdf(file, width = 11, height = 11, useDingbats = FALSE) + on.exit(grDevices::dev.off(), add = TRUE) + graphics::par(mar = c(10, 10, 5, 2)) + ma_publication_plot(m, palette, title, normalized, log_scale = log_scale) + invisible(file) +} + +ma_save_svg <- function(m, file, palette = "RdBu", title = "", + normalized = FALSE, log_scale = FALSE) { + grDevices::svg(file, width = 11, height = 11) + on.exit(grDevices::dev.off(), add = TRUE) + graphics::par(mar = c(10, 10, 5, 2)) + ma_publication_plot(m, palette, title, normalized, log_scale = log_scale) + invisible(file) +} diff --git a/R/research_ui.R b/R/research_ui.R new file mode 100644 index 0000000..f7eab38 --- /dev/null +++ b/R/research_ui.R @@ -0,0 +1,67 @@ +# Task-oriented start screen. The analysis remains in the original Shiny tabs, +# so researchers can switch between the guided route and all available tools. + +manir_question_card <- function(title, purpose, action_id, action_label, + requirement, next_step) { + shiny::div(class = "question-card", + shiny::div(class = "question-top", + shiny::h4(title), + shiny::span(class = "question-requirement", requirement)), + shiny::p(purpose), + shiny::p(class = "question-next", next_step), + shiny::actionButton(action_id, action_label, class = "btn-primary") + ) +} + +manir_research_start <- function() { + shiny::tagList( + shiny::div(class = "start-hero", + shiny::div(class = "start-kicker", "YOUR ANALYSIS"), + shiny::h3("What do you want to find out?"), + shiny::p("Choose a research question. MAniR opens the relevant analysis with a short explanation of what to look for.") + ), + shiny::uiOutput("research_status"), + shiny::div(class = "question-grid", + manir_question_card( + "Do two methods give similar results?", + "Examine whether pairs with high similarity in one matrix also have high similarity in another.", + "start_agreement", "Compare the methods", + "2 matrices", + "See the association statistics, then inspect the pairwise scatterplot." + ), + manir_question_card( + "Which isolate pairs deserve a closer look?", + "Find pairs that occupy very different positions in two methods and inspect their exact values.", + "start_pairs", "Find unusual pairs", + "2 matrices", + "Select an isolate pair, check both results and review its metadata." + ), + manir_question_card( + "Do both methods make the same groups?", + "Compare independently calculated clusters and identify isolates whose assignments differ.", + "start_cluster", "Compare clusters", + "2 matrices", + "Choose the number of clusters, then read the overlap table." + ), + manir_question_card( + "Are known groups or batches reflected in the data?", + "Compare within-group and between-group pairwise measurements using sample metadata.", + "start_groups", "Explore my groups", + "1 matrix + metadata", + "Select a group or batch field and examine both matrices separately." + ), + manir_question_card( + "I want to inspect my matrix.", + "Open the heatmaps, explore a region and check the exact value for a pair of isolates.", + "start_heatmap", "Explore heatmaps", + "1 matrix", + "Start with the first matrix; switch to the combined view if both are loaded." + ) + ), + shiny::div(class = "start-footer", + shiny::strong("Keep a record of your analysis"), + shiny::p("When you have explored the results, use Export to save an editable research summary, the original data and your figures."), + shiny::actionButton("start_export", "Open exports", class = "btn-default") + ) + ) +} diff --git a/R/research_workflows.R b/R/research_workflows.R new file mode 100644 index 0000000..cb6fad4 --- /dev/null +++ b/R/research_workflows.R @@ -0,0 +1,187 @@ +# Researcher-facing summaries. These functions do not depend on Shiny or Plotly. +# They use the original numerical values, never heatmap-normalized colors. + +manir_pair_inspection <- function(first, second = NULL, isolate_1, isolate_2, + metadata = NULL, field = NULL, + comparable = FALSE) { + ids <- colnames(first) + if (length(isolate_1) != 1L || length(isolate_2) != 1L || + is.na(isolate_1) || is.na(isolate_2) || + !isolate_1 %in% ids || !isolate_2 %in% ids || + identical(isolate_1, isolate_2)) + stop("Choose two different isolates present in the first matrix.") + if (!is.null(second) && + (!isolate_1 %in% colnames(second) || !isolate_2 %in% colnames(second))) + stop("Both isolates must be present in the second matrix to compare them.") + value1 <- unname(first[isolate_1, isolate_2]) + value2 <- if (is.null(second)) NA_real_ else + unname(second[isolate_1, isolate_2]) + label1 <- label2 <- NA_character_ + if (!is.null(metadata) && !is.null(field) && length(field) == 1L && + !is.na(field) && nzchar(field) && field %in% names(metadata)) { + label1 <- if (isolate_1 %in% rownames(metadata)) + as.character(metadata[isolate_1, field]) else NA_character_ + label2 <- if (isolate_2 %in% rownames(metadata)) + as.character(metadata[isolate_2, field]) else NA_character_ + } + list(isolate_1 = isolate_1, isolate_2 = isolate_2, + first = value1, second = value2, + difference = if (isTRUE(comparable) && !is.null(second)) + value1 - value2 else NULL, + metadata_field = if (is.null(field)) "" else field, + group_1 = label1, group_2 = label2) +} + +# A descriptive within/between-category summary, computed independently for +# each original matrix. Treat the pairs as non-independent observations. +manir_group_overview <- function(first, second = NULL, metadata, field, + max_pairs = 100000L) { + if (is.null(metadata) || !is.data.frame(metadata) || + length(field) != 1L || is.na(field) || !nzchar(field) || + !field %in% names(metadata)) + stop("Select a metadata column containing sample groups or batches.") + one <- replicate_summary(first, metadata, field, max_pairs = max_pairs) + names(one)[names(one) == "type"] <- "comparison" + one <- data.frame(matrix = "Matrix 1", one, check.names = FALSE) + if (!is.null(second)) { + two <- replicate_summary(second, metadata, field, max_pairs = max_pairs) + names(two)[names(two) == "type"] <- "comparison" + one <- rbind(one, data.frame(matrix = "Matrix 2", two, + check.names = FALSE)) + } + rownames(one) <- NULL + one +} + +manir_directional_association <- function(pairs, kind1 = "similarity", + kind2 = "similarity") { + d <- pairs$data + if (nrow(d) < 3L) + return(list(pearson = NA_real_, spearman = NA_real_, n = nrow(d))) + x <- if (identical(kind1, "distance")) -d$first else d$first + y <- if (identical(kind2, "distance")) -d$second else d$second + valid <- is.finite(x) & is.finite(y) + x <- x[valid]; y <- y[valid] + list(pearson = if (length(x) >= 3L && stats::sd(x) > 0 && + stats::sd(y) > 0) stats::cor(x, y) else NA_real_, + spearman = if (length(unique(x)) > 1L && length(unique(y)) > 1L) + suppressWarnings(stats::cor(x, y, method = "spearman")) + else NA_real_, n = length(x)) +} + +manir_fmt <- function(value) { + if (length(value) != 1L || !is.finite(value)) return("not estimable") + format(signif(value, 4L), trim = TRUE) +} + +# Markdown text export for an editable lab notebook. Only optional, +# already-computed results are included. Expensive clustering/permutation +# analyses are never started by the report download itself. +manir_research_report <- function(dataset, pairs = NULL, group_table = NULL, + group_field = "", cluster = NULL, + comparable = FALSE, + question = "", notes = "", + max_pairs = 100000L) { + example <- identical(dataset$source, "synthetic example") + one <- if (!is.null(dataset$label1)) dataset$label1 else "Matrix 1" + two <- if (!is.null(dataset$label2)) dataset$label2 else "Matrix 2" + lines <- c("# MAniR analysis notes", "", + if (nzchar(trimws(question))) paste("**Research question:**", + trimws(question)) else NULL, + if (example) "**SYNTHETIC teaching example: not measured biological evidence.**" else NULL, + "## Dataset", "", + paste("- Source:", dataset$source), + sprintf("- %s: %d isolates (%s)", one, nrow(dataset$first), + dataset$kind1), + if (!is.null(dataset$second)) + sprintf("- %s: %d isolates (%s)", two, nrow(dataset$second), + dataset$kind2), + sprintf("- Sample matching: %s; clustering linkage: %s", + dataset$matching, dataset$linkage), + if (!is.null(dataset$metadata)) + paste("- Metadata fields:", paste(names(dataset$metadata), + collapse = ", ")), + "") + if (!is.null(pairs)) { + stats <- manir_directional_association(pairs, dataset$kind1, + dataset$kind2) + lines <- c(lines, "## Pairwise relationship", "", + sprintf("- %s of %s unordered pairs evaluated; %s had values in both matrices.", + pairs$evaluated_pairs, + format(pairs$total_pairs, scientific = FALSE), + pairs$valid_pairs), + sprintf("- Direction-adjusted Pearson r: %s", manir_fmt(stats$pearson)), + sprintf("- Direction-adjusted Spearman rho: %s", manir_fmt(stats$spearman)), + if (isTRUE(pairs$sampled)) + sprintf("- Reproducible sample: %s pairs (seed %s; requested limit %s).", + pairs$evaluated_pairs, pairs$seed, max_pairs), + if (isTRUE(comparable)) { + raw <- matrix_agreement(pairs) + c(sprintf("- Mean absolute difference (original units): %s", + manir_fmt(raw$mae)), + sprintf("- Root mean squared difference (original units): %s", + manir_fmt(raw$rmse))) + } else "- Raw differences omitted: measurement equivalence was not confirmed.", + "", + "These are descriptive measurements. Repeated isolate pairs are not independent observations.", + "") + } + if (!is.null(cluster)) { + lines <- c(lines, "## Cluster comparison", "", + sprintf("- Adjusted Rand index: %s", manir_fmt(cluster$ari)), + sprintf("- Adjusted Wallace, matrix 1 to 2: %s", + manir_fmt(cluster$adjusted_wallace_1_to_2)), + sprintf("- Adjusted Wallace, matrix 2 to 1: %s", + manir_fmt(cluster$adjusted_wallace_2_to_1)), + "Cluster labels are arbitrary; agreement is not a measure of typing accuracy.", + "") + } + if (!is.null(group_table) && nrow(group_table)) { + lines <- c(lines, "## Metadata groups", "", + paste("Selected field:", group_field), "", + "| Matrix | Pair category | Pairs | Median | Sampled |", + "| --- | --- | ---: | ---: | --- |", + vapply(seq_len(nrow(group_table)), function(i) { + x <- group_table[i, ] + sprintf("| %s | %s | %s | %s | %s |", + x$matrix, x$comparison, x$pairs, + manir_fmt(x$median), if (isTRUE(x$sampled)) "yes" else "no") + }, character(1L)), + "", + "Group summaries are descriptive. Pairwise values reuse isolates, and batch effects may be confounded.", + "") + } + lines <- c(lines, "## Researcher notes", "", + if (nzchar(trimws(notes))) notes else + "Record what the figures suggest, the limitations, and what you plan to check next.", + "", "## Reproducibility", "", + "- Export the original matrix CSV or RDS files alongside these notes.", + "- Record the selected metadata field, pair limit and version of MAniR.", + "- Figures may use independently normalized colors or raster previews; use original values for inference.") + lines +} + + +# Values for a descriptive group-distribution plot. Never feed these into a +# standard two-independent-samples test: pairs within groups share isolates. +manir_group_pairs <- function(matrix, metadata, field, + max_pairs = 20000L) { + if (is.null(metadata) || !is.data.frame(metadata) || + length(field) != 1L || is.na(field) || !nzchar(field) || + !field %in% names(metadata)) + stop("Choose a valid metadata group or batch field.") + groups <- as.character(metadata[match(rownames(matrix), + rownames(metadata)), field]) + ix <- upper_pair_indices(nrow(matrix), max_pairs = max_pairs) + value <- matrix[cbind(ix$i, ix$j)] + left <- groups[ix$i] + right <- groups[ix$j] + valid <- is.finite(value) & !is.na(left) & !is.na(right) & + nzchar(left) & nzchar(right) + list(data = data.frame( + group = ifelse(left[valid] == right[valid], "Within", "Between"), + value = value[valid]), + sampled = ix$sampled, + evaluated_pairs = length(value), + total_pairs = ix$total) +} diff --git a/README.md b/README.md index 5d13545..cb15468 100644 --- a/README.md +++ b/README.md @@ -1,73 +1,172 @@ # MAniR -Originally this app was develloped for comparison of ANI and MALDI analysis. The app is now generalized to visualize the results from correlation analysis. +**Interactive comparison of pairwise similarity matrices for MALDI-TOF and genomics.** -MAniR is an R shiny app that visualizes the results from correlation analysis. The app can be used to visualize the results from the analysis of a single sample or multiple samples by way of correlation plots. Initially the app was developed to visualize the results from the ANI and MALDI analysis. These are methods to determine the relatedness of bacterial strains. The app can now be used to visualize the results from any correlation analysis. +MAniR is an R Shiny application for investigating pairwise relationships between bacterial isolates, or other samples for which symmetric pairwise matrices are available. It began as an ANI-versus-MALDI comparison application. The upgrade adds numerical matrix comparison, cluster concordance, a large-dataset raster viewer, metadata annotations, and reusable analysis functions. -## Original background information +This development branch is **MAniR 3.0 prerelease**. The historical application remains available in the repository's Git history and on `main` until the upgrade is reviewed. Do not cite an unverified performance improvement: the benchmark scripts need to be run on specified hardware. -ANI analysis is a method to determine the relatedness of bacterial strains. The method is based on the analysis of the genome of the bacteria. The genome is divided into fragments and the similarity of the fragments is determined. +**Start with your research question.** After loading data, the first screen +offers five practical routes: compare methods, inspect unusual isolate pairs, +compare clusters, explore known groups/batches, or inspect a matrix. You do +not need to pick a statistic before you know what you are looking for. See the +[step-by-step research walkthrough](docs/RESEARCH_WORKFLOWS.md) for an +example and suggested next steps. -MALDI analysis is a method to determine the presence of bacteria in a sample. The method is based on the analysis of the proteins of the bacteria. The proteins are separated by mass and the mass of the proteins is determined. These can also be compared between each other to determine the relatedness of the bacteria. +For help understanding the plots, correlations, directional cluster agreement, +rank gaps, metadata tracks and the restrictions on difference maps, see +[Reading MAniR results](docs/INTERPRETING_RESULTS.md). The application also +displays a short explanation directly on each analysis tab. -MAniR is a tool to visualize the results from both the ANI and MALDI analysis. The tool is based on the R shiny framework. -### Example of the MAniR app, single matrix output -![Matrix1](images/matrix1.png) +## See the actual interface -### Example of comparisson of matrices output -![Matrix1vs2](images/matrix1vs2.png) +These screenshots are captured from a running copy of MAniR with the bundled +**synthetic example**. They show the real Shiny controls and output, rather +than design illustrations. The [research walkthrough](docs/RESEARCH_WORKFLOWS.md) +has a screenshot for each step. + +![MAniR start page showing available research questions after loading the example](docs/images/start-here.png) + +*The Start here page: load data, then choose the question you want to answer.* + +| Explore sample relationships | Investigate discordant isolate pairs | +| --- | --- | +| ![Actual MAniR similarity heatmap](docs/images/heatmap.png) | ![Actual MAniR pairwise comparison](docs/images/pairwise-comparison.png) | + +| Compare cluster assignments | Explore groups and batches | +| --- | --- | +| ![Actual MAniR cluster comparison](docs/images/cluster-comparison.png) | ![Actual MAniR metadata group analysis](docs/images/metadata-groups.png) | + +*Screens are recorded at 1680 × 1000 using the synthetic example. Layout and +colors may differ at other window sizes or after you adjust settings.* ## Installation -MAniR can be installed by cloning this repository and running the following command in the root directory of the repository: + +Install R 4.2 or later. The upload limit defaults to 1,024 MB and can be configured with the `MANIR_MAX_UPLOAD_MB` environment variable. Plan available RAM for at least the uploaded matrices plus working data, especially for two 10,000-isolate matrices. For those larger projects, RDS or CSV is preferable to Excel. In the repository directory, run: ```r -R -e "shiny::runApp()" +install.packages(c("shiny", "plotly", "htmltools", "htmlwidgets", + "openxlsx", "RColorBrewer")) +# Optional accelerators (recommended for large datasets): +install.packages(c("data.table", "fastcluster")) +shiny::runApp(".") +``` + +For scripted validation, run `Rscript tests/run_tests.R`. For repeatable performance measurements, run `Rscript benchmarks/benchmark.R` and retain the generated CSV. To compare representative original and new plotting pipelines, install the optional `corrplot` and `heatmaply` packages and run `Rscript benchmarks/compare_original.R`. The optional `--smoke` flag runs a short check; `--large` includes 10,000-isolate data and requires substantial RAM. + +## Built-in example + +Click **Load example** in the application sidebar to explore MAniR +without uploading anything. The example contains 12 **fictional** isolates in +three groups, with two precomputed symmetric similarity matrices: + +- **ANI:** synthetic percentage-like genomic similarity (100 on the diagonal). +- **MALDI:** synthetic spectral similarity on a 0–1 scale (1 on the diagonal). +- **Metadata:** fictional group, specimen source and measurement batch. + +Two isolate pairs have intentionally discordant MALDI and ANI relationships, +making the example useful for exploring split-triangle views, clustering, +pairwise scatterplots, discrepancies and metadata tracks. The measurement +scales are different, so leave "Both matrices use comparable numerical units" +unchecked. All entries are illustrative and must not be used for biological +inference or cited as measured data. + +Open **About the example / download** and click **Example workbook (.xlsx)** to obtain a workbook with `ANI`, `MALDI`, +`metadata` and `README` sheets. The equivalent editable CSV files are in +`examples/`. To upload the workbook yourself, select ANI as the first sheet, +MALDI as the second and metadata as the annotation sheet. + +## Workspace layout + +On a desktop window, MAniR keeps the analysis results and control sidebar in +**separately scrollable panes**. The lower-left **Load and analyze uploaded +files** button stays visible when you scroll through the upload options. +The right-hand toolbar remains visible when you scroll through a result. + +After you load data, MAniR opens **Start here**, where you choose a research question. Choosing **Explore heatmaps** opens **Heatmaps → Matrix 1**. +The primary navigation groups all five heatmap views under **Heatmaps**, with +a compact secondary menu for Matrix 1, Matrix 2, both combined orderings +and Difference. Other tabs are Overview, Pairwise comparison, Cluster +comparison, Metadata and Export. + +Use the right-hand **Colors**, **Annotation**, and **Show cell values** controls +for instant plot changes without re-importing the dataset. The palette and +cell-value options appear only in Heatmaps. **Display options** contains log +color scaling and region zoom for large matrices. The **Clusters (k)** control +appears in Cluster comparison, the **Max pairs** control appears in Pairwise +comparison, and **Run Mantel test** appears in Overview. Matrix type, clustering linkage and sample matching are +load-time analysis settings and remain under the left-hand **Analysis settings** +section. Changes to those settings take effect after clicking **Load and +analyze uploaded files**. Help text is collapsed to one line above plots so the +visualization is visible immediately; expand it for more detailed +interpretation. + +On small screens or short windows, MAniR switches to a normal scrolling page +rather than forcing two narrow, separately scrolling panes. + +## Input formats + +- **XLSX / XLSM:** one matrix per worksheet, with sample IDs in the first row and first column. Optional second matrix and metadata sheets may be selected from the same workbook. A second workbook is also supported. +- **CSV / TSV / gzip-compressed CSV or TSV:** sample IDs in the first column, sample names in the header, and numeric pairwise measurements in the remaining cells. A second matrix and metadata may be uploaded separately. +- **RDS:** an R numeric matrix or data frame with row and column sample IDs. +- **Metadata:** a separate Excel worksheet, CSV, TSV or RDS table with sample IDs as row names (or the first column for a text file). Categorical metadata can be displayed as a color strip for large raster views and used for descriptive within-group versus between-group comparisons. +- **Precomputed sample order:** optional plain-text file listing one isolate ID per line. Any remaining isolates are appended in their original order. This avoids recomputing clustering for larger projects. + +Every matrix must be square, numeric and symmetric; row and column IDs must be identical as sets. The importer trims outer whitespace and automatically aligns rows to column order. Duplicate identifiers, infinite values, invalid matrix ranges, asymmetric entries and asymmetric missingness are reported. Missing matrix pairs may be imported for visualization, but cannot be used in the Mantel permutation test. + +Select what each matrix means: similarity (nonnegative; larger is more similar), correlation (range -1 to 1) or distance (nonnegative; smaller is more similar). "Unspecified" permits a general numeric symmetric matrix and interprets larger entries as more similar when clustering. + +For two matrices, choose whether the isolate lists must match exactly or whether to compare their shared intersection. Unmatched isolates remain available in the individual matrix tabs and are reported in the overview. + +## Visualization and large-matrix handling + +Smaller matrices (300 isolates or fewer) are displayed as interactive Plotly heatmaps with exact hover values. Number overlays are available for at most 70 isolates. For larger matrices, the default raster viewer displays up to 512 representative rows and columns rather than creating a browser annotation for every cell. This is a **representative overview**, not an aggregated matrix or a numerical substitute for the source data. Click a displayed cell to inspect the exact underlying matrix entry. + +Open **Display options** in the Heatmaps toolbar, enable **Zoom into large matrices**, and enter the first isolate index and the region size to inspect adjacent samples. When a region exceeds 512 isolates, it is itself reduced to a representative 512-by-512 display; choose a smaller region to inspect every cell. + +The combined views use the first matrix above the diagonal and the second below the diagonal. One view uses the sample ordering from matrix 1; the other uses the ordering from matrix 2. Because ANI percentages and MALDI similarities can have different units, **each triangle is display-scaled independently**. Hover and click inspections, pairwise exports and RDS downloads retain the original numeric values. Log display scaling uses log(1+x) on nonnegative values (including a zero diagonal); negative correlations cannot be logarithmically displayed. + +Clustering defaults to complete-linkage hierarchical clustering, matching the original corrplot linkage default. Large matrices above 2,000 isolates skip clustering by default to avoid excessive computation and memory use. Supply a precomputed ordering if desired. The original numerical matrices are not altered by clustering. + +## Research features + +The pairwise comparison tab plots values from corresponding unordered isolate pairs, excluding the diagonal. It reports Pearson and Spearman correlation coefficients. If the matrices truly use comparable units and the corresponding checkbox is enabled, it also reports mean absolute and root mean squared differences, a one-to-one reference line and the isolate pairs with the largest absolute differences. Treat these statistics as descriptive; isolate-pair observations are not statistically independent. + +To bound memory use, the pairwise tool examines up to 100,000 distinct pairs by default. When the full dataset exceeds this limit, it selects a reproducible random subset (fixed seed 1), discloses the number of evaluated pairs and marks the analysis as sampled. Downloaded pairwise values follow the same selection. Change **Max pairs** in the Pairwise comparison toolbar for a larger subset. + +The Mantel test permutes isolate labels jointly in one matrix. It reports a two-sided permutation p-value using `(extreme + 1) / (permutations + 1)`. The current implementation requires complete matched matrices with at most 400 isolates. The Mantel statistic measures matrix association; it does not establish that two typing methods produce equivalent classifications. + +Cluster comparison creates the selected-linkage group assignments on shared isolates and reports the adjusted Rand index and the directional adjusted Wallace coefficients. The number of clusters is user-selectable and both matrices must have at most 2,000 shared isolates. Pairwise similarities and clustering distances are kept conceptually distinct. The metadata group summary describes within-group versus between-group pairwise values, which may be helpful for MALDI repeatability or batch studies. That descriptive group comparison is not a formal batch-effect test. + +MAniR accepts **precomputed** MALDI-TOF, ANI, dDDH and other pairwise results. Raw peak detection, spectral calibration and alignment remain the responsibility of specialized preprocessing software. Feeding differently normalized matrices into MAniR does not make the underlying measurement scales interchangeable. + +## Export and reproducibility + +The Export tab also provides an editable Markdown research summary with optional researcher notes, group summaries and explicitly requested cluster statistics. It does not run expensive permutation tests automatically. The export tab provides exact input matrices as CSV, an RDS bundle containing both matrices, optional metadata and sample order, static PNG, PDF and SVG files, a standalone interactive HTML preview and a text manifest of analysis settings and R session information. Pairwise comparison and cluster assignments have their own CSV exports. PDF and SVG contain individual vector cells for matrices with at most 150 isolates and a representative raster for larger inputs. Interactive HTML previews include at most 300 isolates and require Pandoc for self-contained HTML. Large-image exports use representative raster views with up to 1,200 rows and columns, not an exact full-resolution image of a 10,000-isolate matrix. Exact difference matrices can be exported as CSV when both datasets have comparable numerical units. + +To use MAniR reproducibly, archive the source matrices, the metadata, the settings manifest, the installed R package versions, the generated plots and the resulting tables. Never infer a biological cutoff from the normalized heatmap colors; inspect the original numeric values and justify cutoffs from the relevant study. + +## Project structure + +```text +app.R Shiny entry point +ui.R Shiny controls, linked views and downloads +server.R Session-specific upload, analysis and lazy render logic +R/matrix_io.R Format readers, sample ID validation and alignment +R/matrix_analysis.R Pairwise summaries, clustering, permutations +R/matrix_plot.R Interactive and sampled raster rendering +R/example_data.R Example loading and XLSX download generation +examples/ Synthetic ANI, MALDI and metadata CSVs +tests/run_tests.R Numeric, import, statistics and rendering regressions +benchmarks/benchmark.R Repeated staged scaling measurements +docs/UPGRADE_WORKLOG.md Implementation scope and release criteria +.github/workflows/r-tests.yml Linux and Windows checks ``` -## Usage -The input should be provided in the form of an xlsx file. The file should contain the data in the following format: -_|_bacteria1_|_bacteria2_|_bacteria3_|_bacteria4_|_bacteria5_| -|---|---|---|---|---|---| -|_bacteria1_|_100_|_98.5_|_97.5_|_96.5_|_95.5_| -|_bacteria2_|_98.5_|_100_|_98.5_|_97.5_|_96.5_| -|_bacteria3_|_97.5_|_98.5_|_100_|_98.5_|_97.5_| -|_bacteria4_|_96.5_|_97.5_|_98.5_|_100_|_98.5_| -|_bacteria5_|_95.5_|_96.5_|_97.5_|_98.5_|_100_| - -*Note that the diagonal of the matrix should contain the values 100. The values in the matrix should be the ANI values between the bacteria. The values should be between 0 and 100. There should be as many rows and columns as there are bacteria in the sample. The bacteria should be named in the first row and column.* - -If you want to perform a combined visualization of the ANI and MALDI analysis, you should make sure that the bacteria are named the same in the ANI and MALDI data and all bacteria are present in both datasets. - -## Options -The following options can be set in the app: -* **Worksheet with ANI values**: The worksheet in the xlsx file that contains the ANI values. When an excel file is loaded, the worksheets in the file are listed in the dropdown menu. -* **Worksheet with MALDI values**: The worksheet in the xlsx file that contains the MALDI values. When an excel file is loaded, the worksheets in the file are listed in the dropdown menu. - --- advanced options -- -![Advanced options](images/options-new.png) -* **Decimal places**: The number of decimal places to show in the correlation plot. -* **Size of numbers in the plot**: The size of the numbers in the correlation plot. -* **Hide colorscale**: Hide the colorscale in the correlation plot. Default value is True. -* **Show dendrograms**: Show dendrograms in the correlation plot. Default value is False. -* **Show numbers**: Show numbers in the correlation plot. Default value is True. -* **Log scale**: Use a log scale for the correlation plot. Default value is False. This might improve the visualization of the correlation plot when the values are very different. - --- advanced options - Legacy mode -- - -![Legacy options](images/options.png) -* **Decimal places**: The number of decimal places to show in the correlation plot. -* **Size of numbers in the plot**: The size of the numbers in the correlation plot. -* **Scale of the plot**: The scale of the plot, this will make the plot larger or smaller. The default value of 1 means that the output plots will be 1000 by 1000 pixels. -* **Size of the ANI/MALDI labels**: The size of the ANI/MALDI labels in the combined correlation plot. -* **Color mode**: The color mode of the correlation plot. The default value is 'diverging', the other option is 'sequential'. -* **Colorscale**: Based on the color mode, different color pallets can be selected. The default value is 'RdBu' for the 'diverging' color mode and 'YlOrRd' for the 'sequential' color mode. - -### Diverging color pallets: -![Diverging color pallets](www/Diverging.png) -### Sequential color pallets: -![Sequential color pallets](www/Sequential.png) - -## Download tab -The download tab allows you to download the plots as html files. The plots can be opened in a browser later on. Saving as a png can be done by clicking the export button on the interactive plot. - -**Note:** Legacy mode is not supported in the download tab. To download the plots in legacy mode, right click on the plot and select 'Save as image'. +## Existing use + +MAniR was used to visualize genomic similarity comparisons in Versmessen et al. (2024), *Diagnostics*, 14, 1800, ["Average Nucleotide Identity and Digital DNA-DNA Hybridization Analysis Following PromethION Nanopore-Based Whole Genome Sequencing Allows for Accurate Prokaryotic Typing"](https://doi.org/10.3390/diagnostics14161800). The original tool was designed for ANI and MALDI analyses and later generalized to symmetric pairwise data. + +## License + +GPL-3.0, as in the original repository. diff --git a/app.R b/app.R index a5228b6..8622ec4 100644 --- a/app.R +++ b/app.R @@ -1,38 +1,21 @@ -# -# This is a Shiny web application. You can run the application by clicking -# the 'Run App' button above. -# -# Find out more about building applications with Shiny here: -# -# http://shiny.rstudio.com/ -# - -# For local usage -packages <- c( - "shiny", "shinyjs", "shinyBS", "shinyWidgets", "shinycssloaders", - "openxlsx", "RColorBrewer", "corrplot", "periscope", "heatmaply" -) -new_packages <- packages[!(packages %in% installed.packages()[, "Package"])] -if (length(new_packages)) install.packages(new.packages) -lapply(packages, require, character.only = TRUE) - - -# For shinyapps.io -library("shiny") -library("shinyjs") -library("shinyBS") -library("shinyWidgets") -library("openxlsx") -library("RColorBrewer") -library("corrplot") -library("periscope") -library("heatmaply") -library("plotly") - -# import UI -source("ui.R") -# import server -source("server.R") - -# Run the application -shinyApp(ui = ui, server = server) +# MAniR Shiny entry point. Dependencies are documented in README and renv. +required <- c("shiny", "plotly", "htmltools", "htmlwidgets", + "openxlsx", "RColorBrewer") +missing <- setdiff(required, rownames(installed.packages())) +if (length(missing)) + stop("Install required packages before launching: ", + paste(missing, collapse = ", "), + ". See README.md for installation instructions.") +max_upload_mb <- as.numeric(Sys.getenv("MANIR_MAX_UPLOAD_MB", "1024")) +if (!is.finite(max_upload_mb) || max_upload_mb < 1) + stop("MANIR_MAX_UPLOAD_MB must be a positive number.") +options(shiny.maxRequestSize = max_upload_mb * 1024^2) +source("R/matrix_io.R", local = TRUE) +source("R/matrix_analysis.R", local = TRUE) +source("R/research_workflows.R", local = TRUE) +source("R/matrix_plot.R", local = TRUE) +source("R/example_data.R", local = TRUE) +source("R/research_ui.R", local = TRUE) +source("ui.R", local = TRUE) +source("server.R", local = TRUE) +shiny::shinyApp(ui = ui, server = server) diff --git a/benchmarks/benchmark.R b/benchmarks/benchmark.R new file mode 100644 index 0000000..41c9c90 --- /dev/null +++ b/benchmarks/benchmark.R @@ -0,0 +1,78 @@ +#!/usr/bin/env Rscript +# Benchmark selected calculation and display stages. Run with: +# Rscript benchmarks/benchmark.R +# Rscript benchmarks/benchmark.R --smoke +# Rscript benchmarks/benchmark.R --large +# Results are hardware-dependent; repeated runs and environment details +# are required before reporting performance claims. + +source("R/matrix_io.R") +source("R/matrix_analysis.R") +source("R/matrix_plot.R") + +args <- commandArgs(trailingOnly = TRUE) +smoke <- "--smoke" %in% args +large <- "--large" %in% args +sizes <- if (smoke) { + c(60L, 120L) +} else if (large) { + c(500L, 1000L, 2500L, 5000L, 10000L) +} else { + c(100L, 300L, 600L, 1000L, 2500L) +} +repeats <- if (smoke) 1L else 3L +dir.create("benchmarks/results", recursive = TRUE, showWarnings = FALSE) +results <- list() +idx <- 1L + +for (n in sizes) { + cat("Generating synthetic matrix for", n, "isolates\n") + set.seed(777) + features <- matrix(stats::rnorm(n * 7L), nrow = n, ncol = 7L) + m <- exp(-as.matrix(stats::dist(features)) / 3) + ids <- sprintf("isolate_%06d", seq_len(n)) + dimnames(m) <- list(ids, ids) + diag(m) <- 1 + rm(features) + gc() + for (repeat_index in seq_len(repeats)) { + run_case <- function(stage, expr) { + gc(reset = TRUE) + start <- proc.time()[["elapsed"]] + result <- force(expr) + elapsed <- proc.time()[["elapsed"]] - start + # R's reported high-water vector heap is approximate, not process RSS. + approx_heap_mb <- unname(gc()[2L, "max used"]) * 8 / 1024^2 + results[[idx]] <<- data.frame( + n = n, repeat_index = repeat_index, stage = stage, + seconds = elapsed, approx_vector_heap_mb = approx_heap_mb, + renderer = "MAniR v3", stringsAsFactors = FALSE) + idx <<- idx + 1L + invisible(result) + } + run_case("validate", validate_matrix(m, kind = "similarity")) + if (n <= 2500L) { + run_case("cluster", matrix_order(m, kind = "similarity")) + } else { + run_case("skip_cluster_large", matrix_order(m, kind = "similarity")) + } + run_case("pair_sampling_100k", paired_values(m, m, + max_pairs = 100000L)) + run_case("raster_512", { + file <- tempfile(fileext = ".png") + ma_save_png(m, file, max_side = 512L) + unlink(file) + }) + } + rm(m) + gc() +} +result <- do.call(rbind, results) +print(result, row.names = FALSE) +out <- file.path("benchmarks/results", + paste0("MAniR-", format(Sys.time(), "%Y%m%d-%H%M%S"), + if (smoke) "-smoke" else "", ".csv")) +utils::write.csv(result, out, row.names = FALSE) +cat("Results written to:", out, "\n") +cat("R version:", R.version.string, "\n") +print(utils::sessionInfo()) diff --git a/benchmarks/compare_original.R b/benchmarks/compare_original.R new file mode 100644 index 0000000..e6436c3 --- /dev/null +++ b/benchmarks/compare_original.R @@ -0,0 +1,85 @@ +#!/usr/bin/env Rscript +# Compare the historical corrplot + heatmaply pipeline with the upgraded +# cluster-once + adaptive-plot pipeline. This replays representative calls, +# rather than executing the original interactive app in a browser. +# Prerequisites: install.packages(c("corrplot", "heatmaply", "plotly")) +# Usage: Rscript benchmarks/compare_original.R +# Rscript benchmarks/compare_original.R --smoke + +source("R/matrix_io.R") +source("R/matrix_analysis.R") +source("R/matrix_plot.R") +for (pkg in c("corrplot", "heatmaply", "plotly")) { + if (!requireNamespace(pkg, quietly = TRUE)) + stop("Install ", pkg, " to compare with the historical rendering pipeline.") +} +smoke <- "--smoke" %in% commandArgs(trailingOnly = TRUE) +sizes <- if (smoke) c(50L, 100L) else c(100L, 300L, 600L) +repeats <- if (smoke) 1L else 3L +results <- list() +index <- 1L +dir.create("benchmarks/results", recursive = TRUE, showWarnings = FALSE) + +record <- function(n, repeat_index, pipeline, expression) { + gc(reset = TRUE) + start <- proc.time()[["elapsed"]] + invisible(force(expression)) + elapsed <- proc.time()[["elapsed"]] - start + results[[index]] <<- data.frame( + n = n, repeat_index = repeat_index, pipeline = pipeline, + seconds = elapsed, + approx_vector_heap_mb = unname(gc()[2L, "max used"]) * 8 / 1024^2) + index <<- index + 1L +} + +for (n in sizes) { + set.seed(2026) + features <- matrix(stats::rnorm(n * 5L), ncol = 5L) + m <- exp(-as.matrix(stats::dist(features)) / 3) + ids <- sprintf("isolate_%05d", seq_len(n)) + dimnames(m) <- list(ids, ids) + diag(m) <- 1 + rm(features) + for (repeat_index in seq_len(repeats)) { + record(n, repeat_index, "original_corrplot_then_heatmaply", { + # Original MAniR built a corrplot to obtain cluster order and also + # constructed a heatmaply figure. Legacy plots are run on an offscreen + # graphics device so the script works headlessly. + pdf_file <- tempfile(fileext = ".pdf") + grDevices::pdf(pdf_file) + tryCatch({ + corrplot::corrplot.mixed(m, lower = "color", upper = "number", + is.corr = FALSE, order = "hclust", + diag = "n") + }, finally = { + grDevices::dev.off() + unlink(pdf_file) + }) + fig <- heatmaply::heatmaply(m, show_dendrogram = c(FALSE, FALSE), + cellnote = round(m, 2), hide_colorbar = TRUE) + plotly::plotly_build(fig) + }) + record(n, repeat_index, "upgraded_cluster_then_adaptive_render", { + ordering <- matrix_order(m, kind = "similarity") + ordered <- m[ordering$ids, ordering$ids, drop = FALSE] + if (n <= 300L) { + plotly::plotly_build(ma_interactive(ordered, name = "Matrix")) + } else { + png_file <- tempfile(fileext = ".png") + ma_save_png(ordered, png_file, max_side = 512L) + unlink(png_file) + } + }) + } + rm(m) + gc() +} +result <- do.call(rbind, results) +print(result, row.names = FALSE) +output <- file.path("benchmarks/results", + paste0("comparison-", format(Sys.time(), "%Y%m%d-%H%M%S"), ".csv")) +utils::write.csv(result, output, row.names = FALSE) +cat("Benchmark output:", output, "\n") +cat("The renderers have different capabilities above 300 isolates; compare\n", + "end-user latency, not pixel-for-pixel rendering speed, in that range.\n") +print(utils::sessionInfo()) diff --git a/docs/INTERPRETING_RESULTS.md b/docs/INTERPRETING_RESULTS.md new file mode 100644 index 0000000..f995a3d --- /dev/null +++ b/docs/INTERPRETING_RESULTS.md @@ -0,0 +1,199 @@ +# Reading MAniR results + +MAniR compares **pairwise measurements for the same isolates**. It does not +calculate ANI from genomes or align raw MALDI-TOF peaks. Start with two +precomputed, named, square, symmetric matrices. For example, one could contain +genomic ANI percentages and another MALDI-TOF spectral similarities. Each row +and column refers to an isolate, and the same cell in both matrices must refer +to the same pair. The bundled teaching data are fictional. + +## Choose the right input type + +- **Similarity:** larger values indicate greater similarity (for example, ANI + or a MALDI spectral similarity score). The absolute range depends on the + method, so 99% ANI and 0.99 MALDI similarity are not interchangeable. +- **Correlation:** values lie between -1 and +1. A more positive value + indicates a more positive relationship; -1 is strong inverse correlation. +- **Distance:** smaller values mean more similar samples. MAniR reverses + distance ordering internally when constructing a clustering dissimilarity or + comparing ranks, but does **not** change the original uploaded values. + +"Unspecified" treats larger values as more similar for clustering. Supply the +correct type if you want the scientific meaning of the ordering and rank +comparison to be accurate. Neither the palette nor a logarithmic +transformation changes the input type. + +## Reading single heatmaps + +![Screenshot from the running MAniR app: heatmap](images/heatmap.png) + +*The actual Matrix 1 tab with the bundled synthetic data.* + + +Each cell is one row-isolate versus column-isolate comparison. A symmetric +matrix repeats the same number on both sides of the diagonal. Clustering +reorders the rows and columns **together**, placing similar patterns adjacent. +A cluster-looking block in the picture is a visual clue, not a validated taxon. + +The color legend is **relative display color (0–1)**, not the input units. +MAniR maps the range of each displayed matrix to the palette. With the +default diverging palette, red represents the low end and blue the high end +of that display range. Hover over a cell for its exact input value. For a +distance matrix, remember that low (red) values indicate closer samples, +the opposite of the biological interpretation of a similarity matrix. + +If you choose a categorical metadata field, colored rectangles appear in +a narrow track above the interactive heatmap. A separate legend above the +plot explains which group has each color; the colors are stable when you +switch the matrix ordering. Metadata are additional isolate attributes, +not measurements of pairwise agreement. Gray indicates missing metadata. +Large raster views show a narrow side track rather than putting a legend +over the plot. + +## The two combined views + +![Screenshot from the running MAniR app: combined matrix](images/combined-heatmap.png) + +*The actual split-matrix view. Its two triangles are scaled separately.* + + +A split matrix uses **matrix 1 above the diagonal** and **matrix 2 below +the diagonal**, with the same isolates along both axes. Combined (order 1) +uses clustering from matrix 1; Combined (order 2) puts matrix 2 above the +diagonal and clusters using matrix 2 instead. Compare the apparent blocks +and which samples move when you change the ordering. + +MAniR normalizes the **two triangles separately**. The same blue shade +can therefore represent ANI of 99% and MALDI similarity of 0.9; this +is not equal biological similarity. The neutral diagonal in a split view +is a visual separator, not a measured 0.5. Hover to see which matrix +contributed a cell and its original value. + +## Pairwise comparison and rank gaps + +![Screenshot from the running MAniR app: pairwise scatterplot](images/pairwise-comparison.png) + +*The actual scatterplot and pair selection workflow.* + +![Actual original-value pair inspector](images/pair-inspector.png) + +*Inspect the original numerical values for a selected isolate pair.* + + +Each scatterplot dot shows one unique unordered pair of isolates. +For n isolates, there are n(n-1)/2 pairs, excluding the diagonal and the +mirrored half. With the 12-isolate example, that is 66 pairs. Matrix 1 +supplies the X value and matrix 2 the Y value. An upward pattern suggests +positive association between the two types of pairwise measurements. + +Two useful summaries are Pearson's r for a linear relationship and +Spearman's rho for the consistency of ranks. Values lie between -1 and +1. +They do not establish that two typing methods have equal resolution, +accuracy or biological validity. Since each isolate is reused in many +pairs, those dots are **not independent observations**. + +The rank-gap table is useful when units differ. It ranks pairs by each +measurement, placing more similar samples higher in the ranking. For +distance matrices, the direction is reversed before ranking. The absolute +difference between the two percentile ranks is shown as a **rank gap**: +a larger gap means the pair occupies a more different relative position +in the two matrices. Orange outlines in the plot mark up to five of the +largest rank gaps. This is an exploratory list, **not** an outlier test or +a measure of statistical significance. + +The bundled example intentionally includes two unusual pairs: +ISO_02 / ISO_03 have fictional ANI 99.655 and MALDI similarity 0.52; +ISO_04 / ISO_05 have fictional ANI 97.22 and MALDI similarity 0.88. +They illustrate the need to inspect individual discordant pairs. +Do not interpret those numbers as measured bacterial biology. + +The downloaded pairwise CSV omits the raw difference column unless you have +confirmed the matrices are directly comparable. The synthetic example always +omits it because subtracting its measurements would be misleading. + +The app evaluates up to the selected maximum number of distinct pairs. +For larger datasets, it uses a reproducible sample and reports the +number of evaluated pairs. The rank gaps and displayed summary then +describe **that sample**, not necessarily every pair in the input. + +## Cluster agreement + +![Actual MAniR cluster comparison with overlap table](images/cluster-comparison.png) + +*Compare the group assignments across methods instead of comparing arbitrary +cluster numbers directly.* + + +Choose the number of clusters k in the sidebar. MAniR independently +clusters each matrix using its specified type, then cuts both trees into +k groups. The linkage method and choice of k may change the result. + +Cluster labels such as "1" and "2" are arbitrary. Two labels with the +same number are not necessarily the same biological group. Use the +cluster-overlap table to see which groups contain the same isolates. +The adjusted Rand index (ARI) is invariant to renaming clusters: +1 indicates the same partition, around 0 corresponds to chance-level +agreement under its adjustment model, and negative values can indicate +less agreement than that model expects. + +Adjusted Wallace is directional. Matrix 1 → matrix 2 asks how well +pairs grouped together by the first matrix remain grouped by the second, +after correcting for the expected chance grouping. Reversing the +direction changes which matrix supplies the original pair groupings; +the values can differ. An adjusted Wallace value is **not the probability +that the first typing method is biologically correct**. + +Both metrics compare the selected cluster assignments, not the full +distribution of matrix values or independently confirmed biological labels. + +## Optional Mantel test + +The Mantel test assesses matrix association while retaining the +dependence between cells by permuting **whole isolate labels** in one +matrix. Its permutation p-value is not obtained by treating every dot in +the scatterplot as an independent observation. The app uses a two-sided +permutation test and requires complete matrices with no more than 400 +shared isolates. A small p-value is evidence against the chosen +no-association permutation null, **not** evidence that the methods are +equivalent, diagnostic or causal. Save the number of permutations and +random seed with the results. + +## Difference plots: only directly comparable measurements + +A difference is original matrix 1 minus original matrix 2 for the same +pair. Use this only when both matrices measure the **same quantity**, +in the **same units**, with compatible preprocessing. Comparing ANI +from two sequencing runs can qualify; ANI percentages versus MALDI +spectral scores do not. The example deliberately disables this feature +even if the comparable-measurements box is checked. + +In a valid difference heatmap, zero maps to the neutral midpoint and +positive/negative differences map to opposite sides of the diverging +palette. The colors are symmetric around zero but rescaled for display: +hover or export the exact difference matrix to interpret magnitudes. +A difference by itself does not establish which method is correct. + +## Metadata and reproducibility + +![Actual MAniR metadata comparison](images/metadata-groups.png) + +*Within-group and between-group summaries for the selected metadata field.* + +![Actual MAniR export page](images/research-notes-export.png) + +*Save an editable research record alongside the original matrices and +figures.* + + +Metadata categories (group, source, batch, etc.) are descriptive. +Within-group versus between-group pair summaries may suggest something +to investigate, but they are not independent-replicate statistical tests +and do not account for experimental confounding. If apparent biological +groups follow batches, consider an appropriate follow-up study. + +CSV and RDS exports contain original numerical values. Figures may use +normalized colors and representative downsampling for very large +matrices. Keep the original matrices and metadata, the settings manifest, +the result tables and the actual package versions with published figures. + +[Back to README](../README.md) diff --git a/docs/RESEARCH_WORKFLOWS.md b/docs/RESEARCH_WORKFLOWS.md new file mode 100644 index 0000000..b29f633 --- /dev/null +++ b/docs/RESEARCH_WORKFLOWS.md @@ -0,0 +1,178 @@ +# Analyze a research question with MAniR + +MAniR accepts **precomputed, symmetric, named pairwise matrices**. It does not +process raw MALDI-TOF spectra or calculate ANI from genome assemblies. A matrix +has one row and one column per isolate. The number at an intersection +describes that pair. All comparisons require the **same isolate IDs** or a +deliberately selected intersection. + +The application now starts with a question rather than a list of statistical +tools. You can work through a whole analysis without needing to know which +statistic to choose in advance. + +![Actual Start here screen in running MAniR](images/start-here.png) + +*Actual Shiny app after loading the bundled synthetic example. Choose a +research question to jump directly to the relevant results.* + +## Begin with your own data + +1. Upload your first matrix. CSV and RDS are preferable for very large + datasets; Excel workbooks can contain two matrices and a metadata sheet. +2. Provide short names such as "ANI from WGS" and "MALDI similarity" and + identify each matrix as similarity, correlation or distance. These choices + matter for clustering and the direction of rank comparisons. +3. Upload a second matrix if comparing methods, and a metadata table if + examining known biological groups, specimen sources or experimental batches. + Choose whether the datasets must contain exactly the same isolates or + whether only shared isolates should be compared. +4. Click **Load and analyze uploaded files**. The start page shows how many + samples are available, which questions you can answer and whether matching + removed any isolates. You can always return to this page via **All questions** + or the **Start here** tab. + +To try the workflow without data, click **Load example**. This loads 12 fictional +isolates, a percentage-like ANI matrix, a 0–1 MALDI-like similarity matrix and +group/source/batch metadata. These numbers are synthetic and must not be used +as measured biological evidence. + +## Question 1: Do the methods describe similar relationships? + +![Actual MAniR overview showing method association](images/method-overview.png) + +*Overview: the original matrices' association summary, with a direct link to +inspect the isolate pairs behind it.* + + +Click **Compare the methods**. Start with Spearman's rank correlation: +it summarizes whether isolate pairs that rank high in one method tend to +rank high in the other. Pearson's r describes a linear relationship. +For distance matrices, MAniR reverses their direction in these association +summaries so that higher oriented values always mean greater similarity. + +Use **Inspect the pairs behind these numbers** to see the original scatterplot. +An overall correlation can coexist with individual pairs that rank very +differently, so review them before writing a conclusion. The optional Mantel +test uses whole-isolate label permutations for complete datasets of at most +400 isolates. It tests matrix association, not equivalent typing accuracy. + +## Question 2: Which isolate pairs deserve follow-up? + +![Actual MAniR pairwise comparison after loading example data](images/pairwise-comparison.png) + +*Each scatterplot point represents a unique isolate pair. The pair inspector +and rank-gap list appear in this view.* + +![Close-up of the actual pair inspector](images/pair-inspector.png) + +*Select two isolates to read the original values and available metadata. +The highlighted example pair uses fictional data.* + + +Click **Find unusual pairs**. MAniR lists pairs with the largest **rank gaps**: +pairs occupying noticeably different positions in the two ranked lists. +Choose a pair from that list, or type any two shared isolate IDs in the +search boxes. MAniR shows their exact original values and, when selected, +their metadata group labels. The corresponding point is outlined in the +scatterplot, even if the pair was absent from a sampled overview. + +In the fictional example, try **ISO_02 and ISO_03**. They have ANI-like +similarity 99.655 and MALDI-like similarity 0.52. A difference in rankings +is a prompt to inspect the spectra, genome quality and metadata, **not** +evidence of an error or a statistically significant outlier. + +For very large datasets, the scatterplot and ranked list may use up to +the chosen maximum number of sampled pairs. The direct isolate-pair +inspector always looks up the original source matrices, not a sampled +or normalized preview. + +## Question 3: Do the methods group isolates similarly? + +![Actual MAniR cluster comparison and overlap table](images/cluster-comparison.png) + +*Cluster comparison: agreement measures, overlap and memberships for shared +isolates.* + + +Click **Compare clusters**. Pick the number of clusters (k) in the toolbar. +Each matrix is clustered independently using your selected linkage and then +cut into k groups. The overlap table shows exactly how memberships +correspond between methods. + +The adjusted Rand index compares the two partitions independent of +their arbitrary numeric cluster labels. The adjusted Wallace coefficients +ask directional questions and need not be equal. Compare their values with +the cluster-overlap table before deciding which isolates need inspection. +Neither measure establishes biological typing accuracy. + +Clustering is limited to 2,000 shared isolates in the current implementation. +For larger data, start by exploring a justified subset or import a +precomputed sample order. + +## Question 4: Are known groups, replicates or batches reflected in the data? + +![Actual MAniR metadata summaries and group distributions](images/metadata-groups.png) + +*Choose a metadata field to see descriptive within-group and between-group +measurements on each matrix's original scale.* + + +Click **Explore my groups**. Select a group, replicate identifier or batch +column from **Group / annotation** in the results toolbar. MAniR shows +within-group and between-group pair counts, mean/median values and separate +distribution plots for each available matrix, each in its **own original units**. + +A difference may indicate a feature worth investigating, but the isolate +pairs in these plots are **not independent replicates**. Biological groups +and experimental batches can also be confounded. The summaries are +descriptive and are not a formal test of batch effects or discrimination. + +## Question 5: What does a particular cell mean? + +![Actual MAniR matrix view with example data](images/heatmap.png) + +*The first matrix view. Hover over a cell in the live app for its exact +original numerical value.* + +![Actual MAniR split-triangle combined heatmap](images/combined-heatmap.png) + +*The combined view displays different input matrices in the two triangles; +each triangle uses independent display normalization.* + + +Click **Explore heatmaps** and hover over the cell to see the original +value. The two combined views put one matrix above the diagonal and the +other below, reordering both by either method. Each triangle uses its +own display normalization. Equal colors in different matrices do **not** +mean equal biological similarity. On large data, zoom into a smaller +region to inspect it without sending the entire matrix to the browser. + +The Difference view is available only after explicitly confirming +equivalent measurements and units. It is deliberately blocked for the +mixed-unit teaching example. If ANI is expressed in percentages and +MALDI similarity is on a 0–1 scale, use the scatterplot and rank-gap +inspection instead of subtracting the matrices. + +## Record your observations + +![Actual MAniR export panel with illustrative researcher notes entered for the screenshot](images/research-notes-export.png) + +*The export page with illustrative notes entered during screenshot capture. +The app does not automatically write these observations or conclusions.* + + +Click **Open exports** or visit **Export** when you have explored the +question. Enter your research question and write your observations and +planned follow-up. **Download research notes (.md)** creates an editable +Markdown record containing the dataset names, analysis settings, pair +association statistics, and any selected metadata group summaries. +Cluster statistics are included only if you explicitly enable their +calculation in Export. This does not automatically run the Mantel test. +The text includes cautions about pair dependence and synthetic data. + +Save the original CSV/RDS matrices alongside the notes and figures. +Static and HTML plots may show normalized or downsampled previews, +while CSV and RDS exports retain original values. + +For details of each statistical quantity, see +[Reading MAniR results](INTERPRETING_RESULTS.md). diff --git a/docs/UPGRADE_WORKLOG.md b/docs/UPGRADE_WORKLOG.md new file mode 100644 index 0000000..fd6c51a --- /dev/null +++ b/docs/UPGRADE_WORKLOG.md @@ -0,0 +1,115 @@ +# MAniR scalable-analysis upgrade worklog + +Base revision: `0c149e8e082a04d9aee565ecf038855fd925a974` (main, May 2023). +Work branch: `upgrade/scalable-analysis`. + +## Scope +Implement the technical upgrade and research features from the audit, excluding +arXiv manuscript drafting. Do not change main until the upgrade is reviewed. +Preserve the historical original in Git and retain compatibility where practical. + +## Scientific invariants +- Numeric matrix entries must not change when reordering, plotting or exporting. +- Keep row and column sample identifiers aligned; detect duplicate and missing IDs. +- Respect the independent measurement scales of matrices. +- Similarity, correlation and distance matrices require distinct interpretations. +- Diagonal and mirrored pairs are not independent observations. +- Any sampled comparison must disclose the sample size and sampling method. +- Permutation tests must permute isolate labels, never independent matrix cells. +- Reference results on the 2023 sample workbooks must match original input values. + +## Work units +1. Input, validation and matrix matching; numeric/unit tests. +2. Shared clustering, scale handling and pairwise statistics. +3. Small and large plot engines; lazy loading, caching and navigation. +4. Shiny UI/server integration, metadata, exports and compatibility. +5. Benchmark harness, CI, dependency documentation, tests and README. + +## Verification +The execution environment running this edit does not include R. GitHub Actions +must execute the R test suite and benchmark smoke tests on the pull request. +Record actual timing and hardware before reporting performance improvements; +the benchmark script is infrastructure, not evidence of a speedup. + +## Release criteria +- All CI tests green. +- No change to existing pairwise numeric inputs during import/export. +- Proven matching ordering across all comparative views. +- Tested failure handling for bad/missing IDs, invalid scales and missing data. +- Accurate documentation of large-dataset preview sampling limits. +- Measured, repeated performance comparison before a release speed claim. + + +## Implementation progress (September 28, 2026) +Completed in the upgrade branch: +- Reworked upload parsing and numeric validation, including preservation of + leading-zero sample identifiers, row/column alignment, strict/intersection + matching, missingness checks and blockwise symmetry validation. +- Split calculation and rendering into reusable R modules; replaced repeated + clustering with a single selected sample order. Historical complete linkage + is the default; alternative linkage settings are available. +- Added lazy Plotly views for up to 300 isolates and a region-zoomable, + representative raster viewer for larger datasets. Large combined plots + slice the viewport before assembling normalized matrices. +- Added metadata color tracks, pairwise agreement summaries, a two-sided + isolate-permutation Mantel test, ARI and adjusted Wallace, and descriptive + within-group/between-group comparisons. +- Added CSV/TSV/gzip/RDS imports, exact original matrix exports, PNG, + PDF/SVG and HTML preview exports, settings manifest, tests, Linux/Windows CI, + configurable upload size, and staged benchmarking scripts. +- Opened draft PR #2 to keep the original main branch intact. + +Verification still outstanding: +- No R interpreter is installed in the environment that authored these + changes, so the R test and Shiny integration suites cannot be reported + as passing. The workflow is committed but no completed GitHub Actions + job has been observed yet. +- Run the bundled XLSX regression, both CI platforms, and at least three + repeated old/new benchmark comparisons on specified hardware. +- Run large real datasets locally, record memory/time and inspect exact + values and visual ordering before release. +- Record dependency versions from the validated environment, and produce + a lockfile with renv after a successful R run. + +Do not merge or tag this development branch as a validated release until +these checks pass. The arXiv manuscript is outside this work scope. + +- Added a self-contained, clearly labeled synthetic 12-isolate example with + matching ANI- and MALDI-like matrices and metadata. The upgraded interface + offers a one-click loader and an XLSX download; numerical and Shiny tests + cover both the demo and switching back to user uploads. + +- Reorganized Shiny into a desktop split workspace with independently scrolling + upload options and results. Moved live palette, metadata, cell labels and + context-sensitive statistical controls to a persistent results toolbar. + Upload action stays visible in a fixed sidebar footer, interpretation text + starts collapsed, plots size to viewport and narrow windows fall back to + normal scrolling. Added UI structure regression checks. + +- Grouped five heatmap views under a single primary Heatmaps tab and added + context-sensitive controls: color and zoom only for heatmaps, pair limits + only for pairwise analysis, and k only for cluster comparison. Successful + loading now opens Matrix 1 automatically, without page scrolling. + +## September 29, 2026: question-led research workflow + +- Added **Start here**, a task-based researcher home screen with five real + analysis questions and clear data prerequisites; loading an example or + user matrix returns to this screen. +- Added exact original-value drilldown for any pair of shared isolates, + selection from the top ranked disagreements, and point highlighting on + the scatterplot. Rank-gap lists may use a reproducibly sampled set of + pairs, but direct lookup always reads original matrices. +- Added metadata within-/between-group tables and separate original-scale + distribution plots for each matrix, with explicit caveats about + non-independent pairs and batch confounding. +- Added editable research notes in Markdown with source and analysis details, + group summaries and optional explicit clustering. The report does not + trigger a Mantel test and does not claim typing accuracy. +- Added researcher-entered matrix names, compact data-ready messages and + question-based navigation; preserved existing detailed tabs for advanced + users. Scientific summaries reverse distance direction when interpreting + pair relationships, while exact uploaded numbers are unchanged. +- Added regression and Shiny navigation tests and the walkthrough at + docs/RESEARCH_WORKFLOWS.md. Benchmarks still require repeatable hardware + measurements before any performance claims. diff --git a/docs/images/cluster-comparison.png b/docs/images/cluster-comparison.png new file mode 100644 index 0000000..fa91c92 Binary files /dev/null and b/docs/images/cluster-comparison.png differ diff --git a/docs/images/combined-heatmap.png b/docs/images/combined-heatmap.png new file mode 100644 index 0000000..d581c03 Binary files /dev/null and b/docs/images/combined-heatmap.png differ diff --git a/docs/images/heatmap.png b/docs/images/heatmap.png new file mode 100644 index 0000000..fd71db4 Binary files /dev/null and b/docs/images/heatmap.png differ diff --git a/docs/images/metadata-groups.png b/docs/images/metadata-groups.png new file mode 100644 index 0000000..902b27e Binary files /dev/null and b/docs/images/metadata-groups.png differ diff --git a/docs/images/method-overview.png b/docs/images/method-overview.png new file mode 100644 index 0000000..4e17a9d Binary files /dev/null and b/docs/images/method-overview.png differ diff --git a/docs/images/pair-inspector.png b/docs/images/pair-inspector.png new file mode 100644 index 0000000..a7561c2 Binary files /dev/null and b/docs/images/pair-inspector.png differ diff --git a/docs/images/pairwise-comparison.png b/docs/images/pairwise-comparison.png new file mode 100644 index 0000000..66a56d4 Binary files /dev/null and b/docs/images/pairwise-comparison.png differ diff --git a/docs/images/research-notes-export.png b/docs/images/research-notes-export.png new file mode 100644 index 0000000..3bb8128 Binary files /dev/null and b/docs/images/research-notes-export.png differ diff --git a/docs/images/start-here.png b/docs/images/start-here.png new file mode 100644 index 0000000..0905d0a Binary files /dev/null and b/docs/images/start-here.png differ diff --git a/examples/ani.csv b/examples/ani.csv new file mode 100644 index 0000000..0184c0e --- /dev/null +++ b/examples/ani.csv @@ -0,0 +1,13 @@ +sample_id,ISO_01,ISO_02,ISO_03,ISO_04,ISO_05,ISO_06,ISO_07,ISO_08,ISO_09,ISO_10,ISO_11,ISO_12 +ISO_01,100,99.885,98.85,98.965,95.69,95.52,95.35,97.22,97.05,96.88,96.71,96.54 +ISO_02,99.885,100,99.655,99.77,96.88,96.71,96.54,96.37,96.2,96.03,95.86,95.69 +ISO_03,98.85,99.655,100,99.425,96.03,95.86,95.69,95.52,95.35,97.22,97.05,96.88 +ISO_04,98.965,99.77,99.425,100,97.22,97.05,96.88,96.71,96.54,96.37,96.2,96.03 +ISO_05,95.69,96.88,96.03,97.22,100,98.965,99.08,99.195,95.69,95.52,95.35,97.22 +ISO_06,95.52,96.71,95.86,97.05,98.965,100,99.885,98.85,96.88,96.71,96.54,96.37 +ISO_07,95.35,96.54,95.69,96.88,99.08,99.885,100,99.655,96.03,95.86,95.69,95.52 +ISO_08,97.22,96.37,95.52,96.71,99.195,98.85,99.655,100,97.22,97.05,96.88,96.71 +ISO_09,97.05,96.2,95.35,96.54,95.69,96.88,96.03,97.22,100,99.195,99.31,99.425 +ISO_10,96.88,96.03,97.22,96.37,95.52,96.71,95.86,97.05,99.195,100,98.965,99.08 +ISO_11,96.71,95.86,97.05,96.2,95.35,96.54,95.69,96.88,99.31,98.965,100,99.885 +ISO_12,96.54,95.69,96.88,96.03,97.22,96.37,95.52,96.71,99.425,99.08,99.885,100 diff --git a/examples/maldi.csv b/examples/maldi.csv new file mode 100644 index 0000000..70c246d --- /dev/null +++ b/examples/maldi.csv @@ -0,0 +1,13 @@ +sample_id,ISO_01,ISO_02,ISO_03,ISO_04,ISO_05,ISO_06,ISO_07,ISO_08,ISO_09,ISO_10,ISO_11,ISO_12 +ISO_01,1,0.914,0.819,0.895,0.504,0.582,0.66,0.309,0.387,0.465,0.543,0.621 +ISO_02,0.914,1,0.52,0.857,0.348,0.426,0.504,0.582,0.66,0.309,0.387,0.465 +ISO_03,0.819,0.52,1,0.819,0.621,0.27,0.348,0.426,0.504,0.582,0.66,0.309 +ISO_04,0.895,0.857,0.819,1,0.88,0.543,0.621,0.27,0.348,0.426,0.504,0.582 +ISO_05,0.504,0.348,0.621,0.88,1,0.895,0.8,0.876,0.621,0.27,0.348,0.426 +ISO_06,0.582,0.426,0.27,0.543,0.895,1,0.933,0.838,0.465,0.543,0.621,0.27 +ISO_07,0.66,0.504,0.348,0.621,0.8,0.933,1,0.8,0.309,0.387,0.465,0.543 +ISO_08,0.309,0.582,0.426,0.27,0.876,0.838,0.8,1,0.582,0.66,0.309,0.387 +ISO_09,0.387,0.66,0.504,0.348,0.621,0.465,0.309,0.582,1,0.876,0.952,0.857 +ISO_10,0.465,0.309,0.582,0.426,0.27,0.543,0.387,0.66,0.876,1,0.914,0.819 +ISO_11,0.543,0.387,0.66,0.504,0.348,0.621,0.465,0.309,0.952,0.914,1,0.952 +ISO_12,0.621,0.465,0.309,0.582,0.426,0.27,0.543,0.387,0.857,0.819,0.952,1 diff --git a/examples/metadata.csv b/examples/metadata.csv new file mode 100644 index 0000000..d91f2a0 --- /dev/null +++ b/examples/metadata.csv @@ -0,0 +1,13 @@ +sample_id,group,source,batch +ISO_01,Group_A,urine,Batch_1 +ISO_02,Group_A,blood,Batch_2 +ISO_03,Group_A,stool,Batch_1 +ISO_04,Group_A,urine,Batch_2 +ISO_05,Group_B,blood,Batch_1 +ISO_06,Group_B,stool,Batch_2 +ISO_07,Group_B,urine,Batch_1 +ISO_08,Group_B,blood,Batch_2 +ISO_09,Group_C,stool,Batch_1 +ISO_10,Group_C,urine,Batch_2 +ISO_11,Group_C,blood,Batch_1 +ISO_12,Group_C,stool,Batch_2 diff --git a/scripts/capture-docs-screenshots.js b/scripts/capture-docs-screenshots.js new file mode 100644 index 0000000..afb260f --- /dev/null +++ b/scripts/capture-docs-screenshots.js @@ -0,0 +1,158 @@ +/* Capture REAL MAniR screens from a running Shiny session. + * Use only the bundled SYNTHETIC example, never a researcher's uploaded data. + * + * Run: + * Rscript -e "shiny::runApp('.', host='127.0.0.1', port=3838)" & + * npm install --no-save --no-package-lock playwright + * node scripts/capture-docs-screenshots.js + * + * Screenshots are deliberately not retouched or composited. + */ +const fs = require("node:fs"); +const path = require("node:path"); +const { chromium } = require("playwright"); + +const url = process.env.MANIR_SCREENSHOT_URL || "http://127.0.0.1:3838"; +const outputDir = path.resolve("docs/images"); +const screenshotOptions = { animations: "disabled", timeout: 30000 }; +const maxWait = 60000; + +function fail(message) { + throw new Error("MAniR screenshot capture: " + message); +} + +async function waitForText(page, selector, text) { + await page.waitForFunction( + ({ selector, text }) => + document.querySelector(selector)?.textContent?.includes(text), + { selector, text }, + { timeout: maxWait } + ); +} + +async function save(page, name) { + await page.screenshot({ + path: path.join(outputDir, name), + fullPage: false, + ...screenshotOptions + }); + const size = fs.statSync(path.join(outputDir, name)).size; + if (size < 8000) fail(name + " looks unexpectedly empty (" + size + " bytes)"); + console.log("Captured " + name + " (" + Math.round(size / 1024) + " KiB)"); +} + +async function goStart(page) { + await page.locator('a[data-toggle="tab"]') + .filter({ hasText: /^Start here$/ }).first().click(); + await page.locator("#start_heatmap").waitFor({ timeout: maxWait }); +} + +async function capture() { + fs.mkdirSync(outputDir, { recursive: true }); + const args = ["--no-sandbox", "--disable-dev-shm-usage"]; + const browser = await chromium.launch({ + headless: true, + executablePath: process.env.CHROME_BIN || undefined, + args + }); + const page = await browser.newPage({ + viewport: { width: 1680, height: 1000 }, + deviceScaleFactor: 1, + colorScheme: "light", + reducedMotion: "reduce" + }); + const errors = []; + page.on("pageerror", e => errors.push(e.message)); + page.on("console", message => { + if (message.type() === "error") console.log("Browser:", message.text()); + }); + + try { + const response = await page.goto(url, { + waitUntil: "domcontentloaded", + timeout: maxWait + }); + if (!response?.ok()) fail("Shiny app returned HTTP " + response?.status()); + await page.locator("#load_example").waitFor({ timeout: maxWait }); + await page.locator("#load_example").click(); + await waitForText(page, "#research_status", "Teaching example ready"); + await waitForText(page, "#research_status", "12"); + // Give the example-loaded notification time to disappear. + await page.waitForTimeout(4400); + await save(page, "start-here.png"); + + // Real Plotly heatmap, with the default metadata field in the example. + await page.locator("#start_heatmap").click(); + await page.locator("#plot1_interactive .main-svg").first() + .waitFor({ timeout: maxWait }); + await waitForText(page, "#plot1_intro", "12 isolates"); + await page.waitForTimeout(600); + await save(page, "heatmap.png"); + + // Real split-triangle view, both matrices ordered by the first. + await page.locator('a[data-toggle="tab"]') + .filter({ hasText: /^Combined \(order 1\)$/ }).first().click(); + await page.locator("#combined1_interactive .main-svg").first() + .waitFor({ timeout: maxWait }); + await page.waitForTimeout(600); + await save(page, "combined-heatmap.png"); + + await goStart(page); + await page.locator("#start_agreement").click(); + await page.locator("#agreement table").waitFor({ timeout: maxWait }); + await page.waitForTimeout(300); + await save(page, "method-overview.png"); + + await goStart(page); + await page.locator("#start_pairs").click(); + await waitForText(page, "#pair_inspection", "0.52"); + await page.locator("#scatter img").waitFor({ timeout: maxWait }); + await page.waitForTimeout(400); + await save(page, "pairwise-comparison.png"); + await page.locator(".pair-focus").screenshot({ + path: path.join(outputDir, "pair-inspector.png"), + ...screenshotOptions + }); + + await goStart(page); + await page.locator("#start_cluster").click(); + await page.locator("#cluster_summary table").waitFor({ timeout: maxWait }); + await page.locator("#cluster_overlap table").waitFor({ timeout: maxWait }); + await page.waitForTimeout(400); + await save(page, "cluster-comparison.png"); + + await goStart(page); + await page.locator("#start_groups").click(); + await waitForText(page, "#metadata_group_status", "Exploring"); + await page.locator("#group_distributions img") + .waitFor({ timeout: maxWait }); + await page.waitForTimeout(400); + await save(page, "metadata-groups.png"); + + await goStart(page); + await page.locator("#start_export").click(); + await page.locator("#research_question").fill( + "Do MALDI-TOF similarities reflect genomic ANI relationships?" + ); + await page.locator("#research_notes").fill( + "Synthetic teaching example. Inspect discordant isolate pairs and " + + "check whether the selected metadata groups explain the difference. " + + "Follow up with real spectra and sequence quality controls." + ); + await page.waitForTimeout(300); + await save(page, "research-notes-export.png"); + + if (errors.length) { + // Shiny/Plotly can issue nonfatal widget warnings. Retain logs for + // review instead of claiming the screenshots are error-free. + console.warn("Browser JS messages:", errors.join(" | ")); + } + } finally { + await browser.close(); + } +} + +capture().catch(error => { + console.error(error); + process.exitCode = 1; +}); diff --git a/server.R b/server.R index 37d2eba..57398e1 100644 --- a/server.R +++ b/server.R @@ -1,631 +1,1101 @@ -library("shiny") -library("shinyjs") -library("shinyBS") -library("shinyWidgets") -library("openxlsx") -library("RColorBrewer") -library("corrplot") -library("periscope") -library("heatmaply") -library("plotly") - - -# Define server logic required to draw a histogram -server <- function(input, output, session) { - - sendCustomMessage <- function(id,msg) { - session$sendCustomMessage(id, msg) - } - - debugStart <- function() { - # click on Run tha analysis on a sample file button and then click on Visualize the results - click("Samplefile") - # click on visualise but do this in setTimeout so that the sample file is loaded first using shinyjs - shinyjs::runjs("setTimeout(function(){ - $('#visualize').click(); - }, 500);") - } - - # disable the tabPanels Matrix1, Matrix2 - shinyjs::js$disableTab("Matrix\ 1") - shinyjs::js$disableTab("Matrix\ 2") - #Matrix 1 vs Matrix 2 (ordered on matrix 1) - shinyjs::js$disableTab("Matrix\ 1 vs Matrix\ 2\ (ordered\ on\ matrix\ 1)") - #Matrix 1 vs Matrix 2 (ordered on matrix 2) - shinyjs::js$disableTab("Matrix\ 1 vs Matrix\ 2\ (ordered\ on\ matrix\ 2)") - - #debugStart() - - getcolorscale <- function() { - if (input$cmode == "sequential") { - return(COL1(input$sequentialcolor, 200)) - } else { - return(COL2(input$divergentcolor, 200)) - } - } - - single_plot_legacy <- function(data) { - par( - mar = c(input$labelcex + 1, 4.1, 4.1, 2.1), - xpd = TRUE - ) - # single plot - corrplot.mixed( - data, - lower = "color", - lower.col = getcolorscale(), - upper = "number", - upper.col = getcolorscale(), - is.corr = FALSE, - order = "hclust", - diag = "n", - tl.col = "black", - number.cex = input$ncex, - tl.cex = input$tlcex, - number.digits = input$dec, - tl.pos = "lt", - cl.cex = input$clcex - ) - } - - single_plot <- function(data, metadata, file=NULL) { - heatmaply( - data, - col = getcolorscale(), - #dendrogram = input$dendrograms, - # input$dec is the number of decimal places - label_format_fun = function(...) format(..., digits = input$dec + 2), - # add number to each cell also with input$dec for decimals shown and center it but only if show_numbers is TRUE - cellnote = if (input$show_numbers) round(data, input$dec) else NULL, - #cellnote = round(data, input$dec), - cellnote_textposition = "middle center", - # dendrogram only on the side - show_dendrogram = c(input$dendrograms, FALSE), - # add title if input$add_title is TRUE - #main = if (input$add_title) input$title else "", - # hide colorbar if input$hide_colorbar is TRUE - hide_colorbar = input$hide_colorbar, - # if metadata is not NULL, add it to the heatmap as side colors (row only) - row_side_colors = if (!is.null(metadata)) metadata else NULL, - key = TRUE, - # if file is not NULL, save the heatmap to the file - file = if (!is.null(file)) file else NULL, - # use 1000 by 1000 if file is not NULL - width = if (!is.null(file)) 1000 else NULL, - height = if (!is.null(file)) 1000 else NULL, - # input$ncex describe the size of the numbers - cellnote_size = input$ncex * 10, - # add a little bit of margin to the top - margin = c(0, 0, 10, 0), - ) - } - - combined_plot_legacy <- function(data1, data2) { - par( - mar = c(input$labelcex + 1, 4.1, 4.1, 2.1), - oma = c(3 * input$labelcex, 0, 0, 3 * input$labelcex), - xpd = TRUE - ) - corrplot( - data1, - is.corr = FALSE, - type = "upper", - #order = "hclust", - tl.col = "black", - method = "color", - col = getcolorscale(), - addgrid.col = "grey", - addCoef.col = "black", - number.cex = input$ncex, - number.digits = input$dec, - diag = TRUE, - tl.pos = "lt", - tl.cex = input$tlcex, - cl.cex = input$clcex - ) - corrplot( - data2, - is.corr = FALSE, - type = "lower", - order = "original", - tl.col = "black", - method = "color", - col = getcolorscale(), - addgrid.col = "grey", - addCoef.col = "black", - number.cex = input$ncex, - number.digits = input$dec, - diag = FALSE, - tl.cex = input$tlcex, - tl.pos = "n", - cl.pos = "b", - cl.cex = input$clcex, - add = TRUE - ) - - # Add axis titles - mtext( - input$yas, - side = 4, - outer = TRUE, - line = input$labelcex, - cex = input$labelcex - ) - mtext( - input$xas, - side = 1, - outer = TRUE, - line = input$labelcex, - cex = input$labelcex - ) - } - - combined_plot <- function(data1, data2, order_x, order_y, metadata, file=NULL) { - data1 <- as.data.frame(data1) - data2 <- as.data.frame(data2) - # reorder the data - data1 <- data1[order_x, order_y] - data2 <- data2[order_x, order_y] - # make a copy of data1 - combined_data <- data1 - # replace lower triangle with data2 - combined_data[lower.tri(combined_data)] <- data2[lower.tri(data2)] - combined_data <- as.matrix(combined_data) - - # create a copy of the data as original_data - original_data <- combined_data - - if (input$logscale) { - # scale upper triangle between 0 and 1 - combined_data[upper.tri(combined_data)] <- (log(combined_data[upper.tri(combined_data)]) - min(log(combined_data[upper.tri(combined_data)]))) / (max(log(combined_data[upper.tri(combined_data)])) - min(log(combined_data[upper.tri(combined_data)]))) - # scale lower triangle between 0 and 1 - combined_data[lower.tri(combined_data)] <- (log(combined_data[lower.tri(combined_data)]) - min(log(combined_data[lower.tri(combined_data)]))) / (max(log(combined_data[lower.tri(combined_data)])) - min(log(combined_data[lower.tri(combined_data)]))) - } else { - # scale upper triangle between 0 and 1 - combined_data[upper.tri(combined_data)] <- (combined_data[upper.tri(combined_data)] - min(combined_data[upper.tri(combined_data)])) / - (max(combined_data[upper.tri(combined_data)]) - min(combined_data[upper.tri(combined_data)])) - # scale lower triangle between 0 and 1 - combined_data[lower.tri(combined_data)] <- (combined_data[lower.tri(combined_data)] - min(combined_data[lower.tri(combined_data)])) / - (max(combined_data[lower.tri(combined_data)]) - min(combined_data[lower.tri(combined_data)])) - } - # make the diagonal 1 - diag(combined_data) <- 1 - # create custom hovertext. Include the original value and which matrix it came from (input$yas or input$xas) - custom_text <- paste0( - "Original value:", - round(original_data, input$dec), - "
", - "Matrix:", - ifelse(upper.tri(original_data), input$yas, input$xas) - ) - - # make it a matrix - custom_text <- matrix(custom_text, nrow = nrow(original_data), ncol = ncol(original_data)) - - # transpose the data (both combined_data and original_data) - combined_data <- t(combined_data) - original_data <- t(original_data) - - # flip rows of both - combined_data <- combined_data[rev(1:nrow(combined_data)), ] - original_data <- original_data[rev(1:nrow(original_data)), ] - - # same for custom_text - custom_text <- t(custom_text) - custom_text <- custom_text[rev(1:nrow(custom_text)), ] - - - #print(custom_text) - - heatmaply( - combined_data, - col = getcolorscale(), - # input$dec is the number of decimal places - label_format_fun = function(...) format(..., digits = input$dec + 2), - # add number to each cell also with input$dec for decimals shown and center it but only if show_numbers is TRUE - cellnote = if (input$show_numbers) round(original_data, input$dec) else NULL, - #cellnote = round(original_data, input$dec), - cellnote_textposition = "middle center", - # add the custom hovertext - custom_hovertext = custom_text, - # no dendrogram - show_dendrogram = c(FALSE, FALSE), - # do not reorder the rows or columns - Rowv = order_x, - Colv = order_y, - #revC = TRUE, - # add the axis titles - xlab = input$xas, - ylab = input$yas, - # hide colorbar - hide_colorbar = TRUE, - # add the metadata if it exists - row_side_colors = if (!is.null(metadata)) metadata else NULL, - # title if input$add_title is TRUE - #main = if (input$add_title) input$title else "" - # size of numbers in cells is set by input$ncex - cellnote_size = input$ncex*10, - # add file name if file is not NULL - file=file - ) - } - check_errors <- function(col1, col2, output_id) { - if (!all(col1 %in% col2) || !all(col2 %in% col1)) { - # The page has an output_id without the _Error suffix that normally displays the output plot. - # We need to make sure this plot is not displayed when there is an error. - output[[gsub("_Error", "", output_id)]] <- NULL - - not_in_matrix1 <- col2[!(col2 %in% col1)] - not_in_matrix2 <- col1[!(col1 %in% col2)] - output[[output_id]] <- renderUI({ - div(class = "alert alert-danger", role = "alert", { - tagList( - h3("Error: The columns of the two matrices are not the same. Please check your input."), - # print the missing columns - h4("Missing columns in Matrix 1:"), - # print only the missing columns in Matrix 1, not all differences - p(paste(not_in_matrix1, collapse = ", ")), - br(), - h4("Missing columns in Matrix 2:"), - # print only the missing columns in Matrix 2, not all differences - p(paste(not_in_matrix2, collapse = ", ")) - ) - }) - }) - return(FALSE) - } - return(TRUE) - } - - - output$downloadSampleFile <- downloadHandler( - filename = function() { - "sample_file.xlsx" - }, - content = function(con) { - file.copy("www/moc_data.xlsx", con) - } - ) - - wb <- reactive({ - if (is.null(input$input_excel) == FALSE | input$Samplefile > 0) { - if (!is.null(input$input_excel)) { - loadWorkbook(input$input_excel$datapath) - } else if (input$Samplefile > 0) { - loadWorkbook("www/moc_data.xlsx") - } - } else { - return(NULL) - } - }) - - - observeEvent(c(input$input_excel, input$Samplefile), { - if (is.null(input$input_excel) == FALSE | input$Samplefile > 0) { - sheets <- sheets(wb()) - # sheet selection boxes - output$tab1 <- renderUI({ - selectInput( - "sheet1", - HTML("Worksheet with first correlation
matrix"), - choices = sheets, - selected = sheets[1] - ) - }) - output$tab2 <- renderUI({ - selectInput( - "sheet2", - "Worksheet with second correlation matrix (optional)", - choices = c(sheets, "None"), - selected = sheets[min(2, length(sheets))] - ) - }) - # metadata tab - output$tab3 <- renderUI({ - selectInput( - "sheet3", - "Worksheet with metadata (optional)", - choices = c(sheets, "None"), - selected = if (length(sheets) > 2) sheets[3] else "None" - ) - }) - - # Xaxis and Yaxis selection boxes + auto suggestion based on sheet names - output$Yaxis <- renderUI({ - textInput("yas", label = "Name for matrix 1 (Y-axis on combined plot)", value = sheets[1]) - }) - output$Xaxis <- renderUI({ - textInput("xas", label = "Name for matrix 2 (X-axis on combined plot)", value = sheets[min(2, length(sheets))]) - }) - } - }) - - observeEvent(input$sheet2, { - # if no second sheet is selected, don't use Xaxis/Yaxis - if (input$sheet2 == "None") { - output$Xaxis <- NULL - output$Yaxis <- NULL - } - }) - - # observe input$legacymode, if status is switched, click the visualize button - observeEvent(input$legacymode, { - # do not run if no file is uploaded - if (is.null(input$input_excel) == FALSE | input$Samplefile > 0) { - # if legacymode is switched on, click the visualize button - click("visualize") - } - }) - - # observe input$scale, if changed, click the visualize button - observeEvent(input$scale, { - # do not run if no file is uploaded - if (is.null(input$input_excel) == FALSE | input$Samplefile > 0) { - # if scale is changed, click the visualize button - click("visualize") - } - }) - - - - - observeEvent(input$visualize, { - withProgress(message = "Making plots", value = 0, { - workbook <- wb() - # check that there is a workbook - if (is.null(workbook)) { - return() - } - disable(id = "visualize") - - # if metadata is not None, read metadata - if (input$sheet3 != "None") { - metadata <- as.data.frame(readWorkbook(workbook, sheet = input$sheet3, colNames = TRUE, rowNames = TRUE)) - } else { - metadata <- NULL - } - - # save metadata to session - session$userData$metadata <- metadata - - first_correlation_matrix <- - as.matrix(readWorkbook(workbook, - colNames = TRUE, - rowNames = TRUE, - input$sheet1 - )) - rownames(first_correlation_matrix) <- trimws(rownames(first_correlation_matrix)) - colnames(first_correlation_matrix) <- trimws(colnames(first_correlation_matrix)) - - # adjust format with correct rownames and make matrix - first_correlation_plot <- corrplot.mixed( - first_correlation_matrix, - lower = "color", - upper = "number", - is.corr = FALSE, - order = "hclust", - diag = "n", - tl.col = "black", - number.cex = input$ncex, - tl.cex = input$tlcex, - tl.pos = "lt", - ) - # save to session - session$userData$first_correlation_matrix <- first_correlation_matrix - # send first_correlation_matrix as custom message to the client together with the metadata - # this is used to make the plotly plot - sendCustomMessage("first_correlation_matrix", list(first_correlation_matrix, metadata)) - # if not legacy, use plotly - if (input$legacymode == FALSE) { - output$ANI <- renderPlotly({ - ANI_plot <- single_plot(first_correlation_matrix, metadata) - session$userData$ANI_order_x <- ANI_plot$x$layout$xaxis$ticktext - session$userData$ANI_order_y <- ANI_plot$x$layout$yaxis$ticktext - # also save the plotly plot to a png file - #single_plot(first_correlation_matrix, metadata, paste0(session$userData$tmp_dir, "/ANI.png")) - #session$userData$ANI_plot <- ANI_plot - ANI_plot - # export the plotly plot to a png file - }) - } else { - # update width and height of the plot based on input$scale (default 1000*1000 with scale=1) - scale=input$scale - shinyjs::runjs(paste0("$('#ANI_legacy').width(", scale, " * 1000)")) - shinyjs::runjs(paste0("$('#ANI_legacy').height(", scale, " * 1000)")) - output$ANI_legacy <- renderPlot(single_plot_legacy(first_correlation_matrix)) - } - - # enable the "Matrix 1" tab - shinyjs::js$enableTab("Matrix\ 1") - # click on the "Matrix 1" tab if we are on Instructions tab - shinyjs::js$goToMatrix1tab() - incProgress(1 / 4) - - if (input$sheet2 != "None") { - ws <- readWorkbook( - workbook, - colNames = TRUE, - rowNames = TRUE, - sheet = input$sheet2 - ) - rownames(ws) <- trimws(rownames(ws)) - colnames(ws) <- trimws(colnames(ws)) - # adjust format with correct rownames and make matrix - second_correlation_matrix <- as.matrix(ws) - second_correlation_plot <- corrplot.mixed( - second_correlation_matrix, - lower = "color", - upper = "number", - is.corr = FALSE, - order = "hclust", - diag = "n", - tl.col = "black", - number.cex = input$ncex, - tl.cex = input$tlcex, - tl.pos = "lt" - ) - - # save to session - session$userData$second_correlation_matrix <- second_correlation_matrix - - # if not legacy, use plotly - if (input$legacymode == FALSE) { - output$MALDI <- renderPlotly({ - MALDI_plot <- single_plot(second_correlation_matrix, metadata) - session$userData$MALDI_order_x <- MALDI_plot$x$layout$xaxis$ticktext - session$userData$MALDI_order_y <- MALDI_plot$x$layout$yaxis$ticktext - # also save the plotly plot to a png file - #single_plot(second_correlation_matrix, metadata, paste0(session$userData$tmp_dir, "/MALDI.png")) - #session$userData$MALDI_plot <- MALDI_plot - MALDI_plot}) - } else { - # update width and height of the plot based on input$scale (default 1000*1000 with scale=1) - scale=input$scale - shinyjs::runjs(paste0("$('#MALDI_legacy').width(", scale, " * 1000)")) - shinyjs::runjs(paste0("$('#MALDI_legacy').height(", scale, " * 1000)")) - output$MALDI_legacy <- renderPlot(single_plot_legacy(second_correlation_matrix)) - } - # enable the "Matrix 2" tab - shinyjs::js$enableTab("Matrix\ 2") - } - incProgress(1 / 4) - - ## mixed plots - if (input$sheet1 != "None" && input$sheet2 != "None") { - # New MALDI matrix with order of columns from ANI matrix - - col_matrix1 <- colnames(first_correlation_plot$corr) - #print(col_matrix1) - # check if all columns are present in MALDI matrix - if (check_errors(col_matrix1, colnames(second_correlation_matrix), "ANIMALDI_Error")) { - ani_maldi <- second_correlation_matrix[col_matrix1, col_matrix1] - first_correlation_matrix_ordered <- first_correlation_matrix[col_matrix1,col_matrix1] - #print(ani_maldi) - # save to session - session$userData$ani_maldi <- ani_maldi - if (input$legacymode == FALSE) { - output$ANIMALDI <- renderPlotly(combined_plot(first_correlation_matrix_ordered, ani_maldi, session$userData$ANI_order_x, session$userData$ANI_order_y, metadata)) - } else { - # update width and height of the plot based on input$scale (default 1000*1000 with scale=1) - scale=input$scale - shinyjs::runjs(paste0("$('#ANIMALDI_legacy').width(", scale, " * 1000)")) - shinyjs::runjs(paste0("$('#ANIMALDI_legacy').height(", scale, " * 1000)")) - output$ANIMALDI_legacy <- renderPlot(combined_plot_legacy(first_correlation_matrix_ordered, ani_maldi)) - } - } - # enable the "Matrix 1 vs Matrix 2 (ordered on matrix 1)" tab - shinyjs::js$enableTab("Matrix\ 1\ vs\ Matrix\ 2\ (ordered\ on\ matrix\ 1)") - incProgress(1 / 4) - - # check if all columns are present in ANI matrix - col_matrix2 <- colnames(second_correlation_plot$corr) - #print(col_matrix2) - if (check_errors(col_matrix2, colnames(first_correlation_matrix), "MALDIANI_Error")) { - maldi_ani <- first_correlation_matrix[col_matrix2, col_matrix2] - second_correlation_matrix_ordered <- second_correlation_matrix[col_matrix2,col_matrix2] - #print(maldi_ani) - # save to session - session$userData$maldi_ani <- maldi_ani - if (input$legacymode == FALSE) { - # if session$userData$MALDI_order_x is NULL, we first need to render the MALDI plot, we don't need to do this if we already have the order :) - if (is.null(session$userData$MALDI_order_x)) { - MALDI_plot <- single_plot(second_correlation_matrix, metadata) - session$userData$MALDI_order_x <- MALDI_plot$x$layout$xaxis$ticktext - session$userData$MALDI_order_y <- MALDI_plot$x$layout$yaxis$ticktext - } - output$MALDIANI <- renderPlotly(combined_plot(maldi_ani, second_correlation_matrix_ordered, session$userData$MALDI_order_x, session$userData$MALDI_order_y, metadata)) - } else { - # update width and height of the plot based on input$scale (default 1000*1000 with scale=1) - scale=input$scale - shinyjs::runjs(paste0("$('#MALDIANI_legacy').width(", scale, " * 1000)")) - shinyjs::runjs(paste0("$('#MALDIANI_legacy').height(", scale, " * 1000)")) - output$MALDIANI_legacy <- renderPlot(combined_plot_legacy(maldi_ani, second_correlation_matrix_ordered)) - } - } - # enable the "Matrix 2 vs Matrix 1 (ordered on matrix 2)" tab - shinyjs::js$enableTab("Matrix\ 1\ vs\ Matrix\ 2\ (ordered\ on\ matrix\ 2)") - incProgress(1 / 4) - } - - enable(id = "visualize") - }) - }) - # download button # generate matrix1 (ANI) plot as html, add date and time to filename - output$download1 <- downloadHandler( - filename = function() { - paste0(input$yas,"-",Sys.Date(),".html") - }, - content = function(file) { - tmpdir <- tempdir() - #print(tmpdir) - single_plot(session$userData$first_correlation_matrix, session$userData$metadata, paste0(tmpdir, "/ANI.html")) - file.copy(paste0(tmpdir, "/ANI.html"), file) - } - ) - # repeat for matrix2 (MALDI) - output$download2 <- downloadHandler( - filename = function() { - paste0(input$xas,"-",Sys.Date(),".html") - }, - content = function(file) { - tmpdir <- tempdir() - single_plot(session$userData$second_correlation_matrix, session$userData$metadata, paste0(tmpdir, "/MALDI.html")) - file.copy(paste0(tmpdir, "/MALDI.html"), file) - } - ) - # repeat for matrix1 vs matrix2 (ordered on matrix 1) - output$download3 <- downloadHandler( - filename = function() { - paste0(input$yas,"_vs_",input$xas,"-",Sys.Date(),".html") - }, - content = function(file) { - tmpdir <- tempdir() - combined_plot(session$userData$first_correlation_matrix, session$userData$ani_maldi, session$userData$ANI_order_x, session$userData$ANI_order_y, session$userData$metadata, paste0(tmpdir, "/ANIMALDI.html")) - file.copy(paste0(tmpdir, "/ANIMALDI.html"), file) - } - ) - # repeat for matrix2 vs matrix1 (ordered on matrix 2) - output$download4 <- downloadHandler( - filename = function() { - paste0(input$xas,"_vs_",input$yas,"-",Sys.Date(),".html") - }, - content = function(file) { - tmpdir <- tempdir() - combined_plot(session$userData$maldi_ani, session$userData$second_correlation_matrix, session$userData$MALDI_order_x, session$userData$MALDI_order_y, session$userData$metadata, paste0(tmpdir, "/MALDIANI.html")) - file.copy(paste0(tmpdir, "/MALDIANI.html"), file) - } - ) - - # we have action buttons to check first if session$userData contains the data we need, if so we click button using shinyjs, otherwise return an alert message - # ids of buttons are action_download1, action_download2, action_download3, action_download4 - observeEvent(input$action_download1, { - if (!is.null(session$userData$first_correlation_matrix)) { - shinyjs::runjs("$('#download1')[0].click()") - } else { - # alert message - createAlert(session=session, anchorId = "alert",content = "Please upload a matrix first or select a sheet for matrix 1",style = "danger") - } - }) - observeEvent(input$action_download2, { - if (!is.null(session$userData$second_correlation_matrix)) { - shinyjs::runjs("$('#download2')[0].click()") - } else { - createAlert(session=session, anchorId = "alert",content = "Please upload a matrix first or select a sheet for matrix 2",style = "danger") - } - }) - observeEvent(input$action_download3, { - if (!is.null(session$userData$first_correlation_matrix) && !is.null(session$userData$ani_maldi)) { - shinyjs::runjs("$('#download3')[0].click()") - } else { - createAlert(session=session, anchorId = "alert",content = "Please upload a matrix first or select a sheet for matrix 1 and 2",style = "danger") - } - }) - observeEvent(input$action_download4, { - if (!is.null(session$userData$second_correlation_matrix) && !is.null(session$userData$maldi_ani)) { - shinyjs::runjs("$('#download4')[0].click()") - } else { - createAlert(session=session, anchorId = "alert",content = "Please upload a matrix first or select a sheet for matrix 1 and 2",style = "danger") - } - }) - -} +# Session-local state: uploaded matrices are never placed in global caches. +server <- function(input, output, session) { + is_excel <- function(file) { + !is.null(file) && tolower(tools::file_ext(file$name)) %in% c("xlsx", "xlsm") + } + output$first_sheet_ui <- shiny::renderUI({ + if (!is_excel(input$first_file)) return(NULL) + sheets <- tryCatch(matrix_sheet_names(input$first_file$datapath, input$first_file$name), + error = function(e) character()) + shiny::selectInput("first_sheet", "First matrix worksheet", + choices = sheets, selected = sheets[1L]) + }) + output$second_sheet_ui <- shiny::renderUI({ + f <- if (!is.null(input$second_file)) input$second_file else input$first_file + if (!is_excel(f)) return(NULL) + sheets <- tryCatch(matrix_sheet_names(f$datapath, f$name), + error = function(e) character()) + suggested <- if (is.null(input$second_file) && length(sheets) > 1L) + sheets[2L] else "None" + shiny::selectInput("second_sheet", "Second matrix worksheet", + choices = c("None", sheets), selected = suggested) + }) + output$metadata_sheet_ui <- shiny::renderUI({ + f <- if (!is.null(input$metadata_file)) input$metadata_file else input$first_file + if (!is_excel(f)) return(NULL) + sheets <- tryCatch(matrix_sheet_names(f$datapath, f$name), + error = function(e) character()) + suggested <- if (is.null(input$metadata_file) && + is.null(input$second_file) && length(sheets) > 2L) + sheets[3L] else "None" + shiny::selectInput("metadata_sheet", "Metadata worksheet", + choices = c("None", sheets), selected = suggested) + }) + + analyze_input <- function(example = FALSE) { + if (!example) shiny::req(input$first_file) + shiny::withProgress(message = "Validating matrices and computing sample order", + value = 0, { + tryCatch({ + if (example) { + demo <- manir_load_example() + a <- demo$first + b <- demo$second + meta <- demo$metadata + kind1 <- "similarity" + kind2 <- "similarity" + match_mode <- "strict" + label1 <- "ANI (synthetic)" + label2 <- "MALDI (synthetic)" + cluster_requested <- TRUE + linkage <- "complete" + shiny::incProgress(0.40) + } else { + kind1 <- input$kind1 + kind2 <- input$kind2 + match_mode <- input$match_mode + label1 <- trimws(if (is.null(input$label1)) "Matrix 1" else input$label1) + label2 <- trimws(if (is.null(input$label2)) "Matrix 2" else input$label2) + if (!nzchar(label1)) label1 <- "Matrix 1" + if (!nzchar(label2)) label2 <- "Matrix 2" + cluster_requested <- isTRUE(input$cluster) + linkage <- input$linkage + f <- input$first_file + wb1 <- if (is_excel(f)) openxlsx::loadWorkbook(f$datapath) else NULL + a <- read_matrix_input(f$datapath, + sheet = if (is_excel(f)) input$first_sheet else NULL, + workbook = wb1, format = f$name, kind = input$kind1) + shiny::incProgress(0.20) + f2 <- if (!is.null(input$second_file)) input$second_file else f + has_second <- !is.null(input$second_file) || + (is_excel(f) && !is.null(input$second_sheet) && + input$second_sheet != "None") + b <- NULL + if (has_second) { + if (is_excel(f2) && (is.null(input$second_sheet) || + input$second_sheet == "None")) + stop("Select a second matrix worksheet.") + wb2 <- if (!is.null(input$second_file) && is_excel(f2)) + openxlsx::loadWorkbook(f2$datapath) else wb1 + b <- read_matrix_input(f2$datapath, + sheet = if (is_excel(f2)) input$second_sheet else NULL, + workbook = wb2, format = f2$name, kind = input$kind2) + # Match once for early actionable errors; avoid retaining copies. + shared_ids <- intersect(colnames(a), colnames(b)) + if (input$match_mode == "strict" && + !setequal(colnames(a), colnames(b))) + stop(sprintf("Matrices have %d and %d isolates; %d are shared. Select 'Shared isolates only' or fix the IDs.", + nrow(a), nrow(b), length(shared_ids))) + if (length(shared_ids) < 2L) stop("At least two shared isolates are required.") + } + shiny::incProgress(0.20) + meta <- NULL + fmeta <- if (!is.null(input$metadata_file)) + input$metadata_file else f + if (is_excel(fmeta) && !is.null(input$metadata_sheet) && + input$metadata_sheet != "None") { + wbm <- if (!is.null(input$metadata_file)) + openxlsx::loadWorkbook(fmeta$datapath) else wb1 + meta <- read_metadata_input(fmeta$datapath, + input$metadata_sheet, wbm, format = fmeta$name) + } else if (!is.null(input$metadata_file) && !is_excel(fmeta)) { + meta <- read_metadata_input(fmeta$datapath, format = fmeta$name) + } + if (!is.null(meta) && !all(colnames(a) %in% rownames(meta))) + shiny::showNotification("Some matrix samples have no metadata.", + type = "warning", duration = 8) + } + explicit <- NULL + if (!example && !is.null(input$order_file)) { + explicit <- trimws(readLines(input$order_file$datapath, warn = FALSE)) + explicit <- sub("[,\t].*$", "", explicit) + explicit <- explicit[nzchar(explicit) & explicit != "sample_id"] + if (anyDuplicated(explicit)) stop("The imported sample order has duplicate IDs.") + if (!any(explicit %in% colnames(a))) + stop("The imported sample order matches no samples.") + } + order_for <- function(m, kind) { + if (!is.null(explicit)) + return(c(intersect(explicit, colnames(m)), + setdiff(colnames(m), explicit))) + matrix_order(m, kind, cluster = cluster_requested, + linkage = linkage)$ids + } + order1 <- order_for(a, kind1) + shiny::incProgress(0.30) + order2 <- if (!is.null(b)) order_for(b, kind2) else NULL + shiny::incProgress(0.30) + shiny::updateSelectInput(session, "metadata_column", + choices = c("None" = "", if (!is.null(meta)) names(meta)), + selected = if (example && !is.null(meta) && "group" %in% names(meta)) + "group" else "") + shiny::showNotification( + sprintf("Loaded %d isolates%s.", nrow(a), + if (!is.null(b)) paste0(" and ", nrow(b), " in matrix 2") + else ""), + type = "message", duration = 4) + list(first = a, second = b, metadata = meta, + order1 = order1, order2 = order2, + source = if (example) "synthetic example" else "uploaded files", + matching = match_mode, + clustering_skipped = cluster_requested && + is.null(explicit) && + (nrow(a) > 2000L || (!is.null(b) && nrow(b) > 2000L)), + kind1 = kind1, kind2 = kind2, + label1 = label1, label2 = label2, + linkage = linkage) + }, error = function(e) { + shiny::showNotification(conditionMessage(e), type = "error", + duration = NULL) + NULL + }) + }) + } + loaded <- shiny::reactiveVal(NULL) + output$sidebar_status <- shiny::renderUI({ + d <- loaded() + if (is.null(d)) + return(shiny::span(class = "load-status", + "Choose the example or upload matrices to begin.")) + shiny::span(class = "load-status", + sprintf("Loaded: %s | %s isolates%s", d$source, + format(nrow(d$first), big.mark = ","), + if (is.null(d$second)) "" else + sprintf(" | %s in matrix 2", + format(nrow(d$second), big.mark = ",")))) + }) + # Put the research question first. The user can jump directly to the + # relevant analysis without first learning the list of statistical tabs. + show_research_start <- function() { + shiny::updateTabsetPanel(session, "results_tab", selected = "Start here") + } + shiny::observeEvent(input$visualize, { + result <- analyze_input(example = FALSE) + if (!is.null(result)) { + loaded(result) + show_research_start() + } + }) + shiny::observeEvent(input$load_example, { + shiny::updateCheckboxInput(session, "comparable_scales", value = FALSE) + shiny::updateSelectInput(session, "kind1", selected = "similarity") + shiny::updateSelectInput(session, "kind2", selected = "similarity") + shiny::updateRadioButtons(session, "match_mode", selected = "strict") + shiny::updateCheckboxInput(session, "cluster", value = TRUE) + shiny::updateSelectInput(session, "linkage", selected = "complete") + shiny::updateNumericInput(session, "cluster_k", value = 3) + shiny::updateTextInput(session, "label1", value = "Matrix 1") + shiny::updateTextInput(session, "label2", value = "Matrix 2") + result <- analyze_input(example = TRUE) + if (!is.null(result)) { + loaded(result) + show_research_start() + } + }) + output$download_example <- shiny::downloadHandler( + filename = function() "MAniR_synthetic_example.xlsx", + content = function(file) manir_write_example_workbook(file) + ) + + # Isolate searches use server-side Selectize so a 10k-isolate project + # does not inject tens of thousands of options into the browser. + shiny::observeEvent(loaded(), { + d <- loaded() + if (is.null(d)) return() + ids <- if (is.null(d$second)) colnames(d$first) else + intersect(colnames(d$first), colnames(d$second)) + first_default <- if (identical(d$source, "synthetic example")) + "ISO_02" else ids[1L] + second_default <- if (identical(d$source, "synthetic example")) + "ISO_03" else ids[min(2L, length(ids))] + shiny::updateSelectizeInput(session, "inspect_isolate", + choices = ids, selected = first_default, server = TRUE) + shiny::updateSelectizeInput(session, "inspect_partner", + choices = ids, selected = second_default, server = TRUE) + }) + + data <- shiny::reactive({ shiny::req(loaded()); loaded() }) + output$active_analysis <- shiny::renderUI({ + d <- loaded() + if (is.null(d)) + return(shiny::span(class = "small-help", "No data loaded")) + changed <- !identical(d$source, "synthetic example") && + ((!is.null(input$kind1) && !identical(input$kind1, d$kind1)) || + (!is.null(input$kind2) && !identical(input$kind2, d$kind2)) || + (!is.null(input$linkage) && !identical(input$linkage, d$linkage)) || + (!is.null(input$match_mode) && !identical(input$match_mode, d$matching))) + shiny::div( + shiny::span(class = "data-indicator", + sprintf("%s · %s isolates%s", + if (identical(d$source, "synthetic example")) "Teaching example" + else "Your data", format(nrow(d$first), big.mark = ","), + if (is.null(d$second)) "" else + sprintf(" · %s shared", length(intersect(colnames(d$first), + colnames(d$second)))))), + if (changed) + shiny::span(class = "settings-warning", + "Settings changed. Click Load and analyze to apply.") + ) + }) + current_goal <- shiny::reactiveVal(NULL) + output$research_context <- shiny::renderUI({ + goal <- current_goal() + if (is.null(goal) || !identical(input$results_tab, goal$tab)) return(NULL) + shiny::div(class = "research-context", + shiny::strong(goal$title), + shiny::span(goal$hint), + shiny::actionButton("back_to_questions", "All questions", + class = "btn-link btn-sm") + ) + }) + shiny::observeEvent(input$back_to_questions, { + current_goal(NULL) + shiny::updateTabsetPanel(session, "results_tab", selected = "Start here") + }) + open_question <- function(tab, title, hint, requires_two = FALSE, + requires_metadata = FALSE) { + d <- loaded() + if (is.null(d)) { + shiny::showNotification( + "Load the teaching example or upload a matrix first.", + type = "message", duration = 6) + return(invisible(NULL)) + } + if (requires_two && is.null(d$second)) { + shiny::showNotification( + "This question needs two matrices for the same isolates. Add a second matrix and reload.", + type = "message", duration = 8) + return(invisible(NULL)) + } + if (requires_metadata && is.null(d$metadata)) { + shiny::showNotification( + "This question needs sample metadata. Upload a metadata table with matching isolate IDs.", + type = "message", duration = 8) + return(invisible(NULL)) + } + current_goal(list(tab = tab, title = title, hint = hint)) + if (is.null(input$research_question) || + !nzchar(trimws(input$research_question))) + shiny::updateTextInput(session, "research_question", value = title) + shiny::updateTabsetPanel(session, "results_tab", selected = tab) + } + shiny::observeEvent(input$start_agreement, + open_question("Overview", "Do the two methods agree?", + "Start with the correlation and inspect the scatterplot if individual pairs differ.", + requires_two = TRUE)) + shiny::observeEvent(input$start_pairs, + open_question("Pairwise comparison", "Which isolate pairs need follow-up?", + "Select an unusual pair below to inspect its original values and sample groups.", + requires_two = TRUE)) + shiny::observeEvent(input$overview_open_pairs, + open_question("Pairwise comparison", "Which pairs explain the matrix association?", + "The pair inspector uses exact original values, including pairs that were not in a scatterplot sample.", + requires_two = TRUE)) + shiny::observeEvent(input$start_cluster, + open_question("Cluster comparison", "Do the methods group isolates similarly?", + "Use the cluster-overlap table; change the number of clusters if justified.", + requires_two = TRUE)) + shiny::observeEvent(input$start_groups, + open_question("Metadata", "Do sample groups or batches show a pattern?", + "Select the biological group or experimental batch in the toolbar.", + requires_metadata = TRUE)) + shiny::observeEvent(input$start_heatmap, { + open_question("Heatmaps", "Explore the sample relationship matrix", + "Hover over cells for original values; try the combined view when two matrices are loaded.") + if (!is.null(loaded())) + shiny::updateTabsetPanel(session, "matrix_view", selected = "Matrix 1") + }) + shiny::observeEvent(input$start_export, + open_question("Export", "Record and export your findings", + "Save editable notes along with original matrix values and figures.")) + + output$research_status <- shiny::renderUI({ + d <- loaded() + if (is.null(d)) + return(shiny::div(class = "start-status empty", + shiny::strong("First, load your data"), + shiny::p("Use the example button on the left to see a complete analysis, or upload your own matrix. Add a second matrix to compare methods and metadata to examine groups or batches."))) + n_shared <- if (is.null(d$second)) NULL else + length(intersect(colnames(d$first), colnames(d$second))) + shiny::div(class = "start-status ready", + shiny::strong(if (identical(d$source, "synthetic example")) + "Teaching example ready (fictional data)" else "Your dataset is ready"), + shiny::div(class = "start-facts", + shiny::span(sprintf("%s: %d isolates", d$label1, nrow(d$first))), + if (!is.null(d$second)) + shiny::span(sprintf("%s: %d isolates; %d shared", + d$label2, nrow(d$second), n_shared)), + if (!is.null(d$metadata)) + shiny::span(sprintf("Metadata: %s", + paste(names(d$metadata), collapse = ", "))) + ), + if (is.null(d$second)) + shiny::p("You can explore the matrix now. For method agreement and pair discrepancies, upload a second matrix."), + if (!is.null(d$second) && + length(intersect(colnames(d$first), colnames(d$second))) < + max(nrow(d$first), nrow(d$second))) + shiny::p(sprintf( + "Only %d isolates are shared; the individual heatmaps still contain the unmatched samples.", + n_shared)), + if (is.null(d$metadata)) + shiny::p("Add metadata if you want to explore known groups or possible batch patterns."), + if (d$clustering_skipped) + shiny::p("Clustering was skipped for a large dataset. Use an imported sample order or smaller subset for cluster comparisons.") + ) + }) + has_two <- shiny::reactive(!is.null(data()$second)) + subset_if_needed <- function(m, ids) { + if (identical(colnames(m), ids) && identical(rownames(m), ids)) + m else m[ids, ids, drop = FALSE] + } + ordered_first <- shiny::reactive({ + d <- data() + subset_if_needed(d$first, d$order1) + }) + ordered_second <- shiny::reactive({ + d <- data() + shiny::req(d$second) + subset_if_needed(d$second, d$order2) + }) + shared <- shiny::reactive({ + d <- data() + shiny::req(d$second) + match_matrices(d$first, d$second, d$matching) + }) + combined_first <- shiny::reactive({ + d <- data() + both <- shared() + ids <- d$order1[d$order1 %in% both$ids] + list(first = subset_if_needed(d$first, ids), + second = subset_if_needed(d$second, ids)) + }) + combined_second <- shiny::reactive({ + d <- data() + both <- shared() + ids <- d$order2[d$order2 %in% both$ids] + list(first = subset_if_needed(d$second, ids), + second = subset_if_needed(d$first, ids)) + }) + # A checkbox cannot make two fundamentally different measurement types + # subtractable. The bundled ANI/MALDI example is always protected. + can_difference <- shiny::reactive({ + d <- data() + !is.null(d$second) && isTRUE(input$comparable_scales) && + !identical(d$source, "synthetic example") + }) + diff_matrix <- shiny::reactive({ + shiny::req(can_difference()) + combined_first() + }) + format_range <- function(m) { + values <- m[is.finite(m)] + if (!length(values)) return("no finite values") + sprintf("%s to %s", format(signif(min(values), 5L), trim = TRUE), + format(signif(max(values), 5L), trim = TRUE)) + } + visible_indices <- function(n) { + ix <- if (isTRUE(input$zoom_enabled) && n > 300L) { + start <- max(1L, min(n, as.integer(input$zoom_start))) + seq.int(start, min(n, start + as.integer(input$zoom_size) - 1L)) + } else seq_len(n) + if (length(ix) > 512L) + ix <- ix[unique(as.integer(round(seq(1, length(ix), length.out = 512L))))] + ix + } + pair_data <- shiny::reactive({ + m <- shared() + paired_values(m$first, m$second, max_pairs = + if (is.null(input$max_pairs)) 100000L else input$max_pairs) + }) + + output$overview <- shiny::renderUI({ + d <- data() + shiny::tagList( + shiny::h3("Dataset overview"), + shiny::p(if (identical(d$source, "synthetic example")) + "Synthetic teaching dataset. These are fictional similarities, not measured biological results." + else "Uploaded dataset."), + shiny::div(class = "metric", sprintf("Matrix 1: %s isolates", + format(nrow(d$first), big.mark = ","))), + if (!is.null(d$second)) + shiny::div(class = "metric", sprintf("Matrix 2: %s isolates; %s shared", + format(nrow(d$second), big.mark = ","), + format(length(shared()$ids), big.mark = ","))), + if (!is.null(d$second) && d$matching == "intersection") + shiny::p(sprintf("Excluded from comparison: %d only in matrix 1, %d only in matrix 2.", + length(shared()$only_first), length(shared()$only_second))), + if (d$clustering_skipped) + shiny::p("Clustering was skipped above 2,000 isolates. Import a sample order for large datasets."), + if (!is.null(d$second) && pair_data()$sampled) + shiny::p(sprintf("Pairwise statistics are based on %s of %s distinct possible pairs, sampled with seed %s.", + format(pair_data()$evaluated_pairs, big.mark = ","), + format(pair_data()$total_pairs, big.mark = ","), + pair_data()$seed)), + if (!is.null(d$second) && !can_difference()) + shiny::p(if (identical(d$source, "synthetic example")) + "ANI percentages and MALDI spectral similarities have different units. Look at Pearson/Spearman association and rank gaps; direct differences are disabled for this example." + else "Direct differences are hidden until you confirm that the two matrices measure the same quantity in the same units.") + ) + }) + output$overview_insight <- shiny::renderUI({ + d <- data() + if (is.null(d$second)) + return(shiny::p(class = "section-note", + "With one matrix, explore the heatmap or upload a second matrix to compare methods.")) + pairs <- pair_data() + stats <- manir_directional_association(pairs, d$kind1, d$kind2) + if (!is.finite(stats$spearman)) + return(shiny::div(class = "start-status empty", + shiny::strong("Rank correlation is not estimable"), + shiny::p("The values may be constant or there may be too few usable isolate pairs. Inspect the original matrices."))) + shiny::div(class = "start-status ready", + shiny::strong(sprintf("For %s vs %s, Spearman rho = %s", + d$label1, d$label2, manir_fmt(stats$spearman))), + shiny::p(sprintf( + "Calculated from %s unordered isolate pairs%s. Values for distance matrices are reversed in this summary so that a larger oriented value always means greater similarity.", + format(stats$n, big.mark = ","), + if (pairs$sampled) " in a reproducible subset" else "")), + shiny::p("This describes the ranking of pairs, not whether either method is biologically correct. Check individual discrepancies and experimental metadata next.") + ) + }) + output$agreement <- shiny::renderTable({ + shiny::req(has_two()) + pp <- pair_data() + d <- data() + stats <- manir_directional_association(pp, d$kind1, d$kind2) + raw <- if (can_difference()) matrix_agreement(pp) else NULL + adjusted <- identical(d$kind1, "distance") || + identical(d$kind2, "distance") + data.frame( + Measure = c("Valid isolate pairs", + if (adjusted) "Pearson r (distance direction adjusted)" + else "Pearson r", + if (adjusted) "Spearman rho (distance direction adjusted)" + else "Spearman rho", + if (can_difference()) c("Mean absolute difference", + "Root mean squared difference")), + Value = c(stats$n, signif(stats$pearson, 5), + signif(stats$spearman, 5), + if (can_difference()) + c(signif(raw$mae, 5), signif(raw$rmse, 5))) + ) + }) + output$mantel_note <- shiny::renderUI({ + shiny::p(class = "small-help", + "Optional Mantel test: click Run Mantel test in the sidebar. It permutes whole isolate labels to test matrix association. It does not demonstrate equal typing performance, and it cannot run on incomplete matrices or above 400 shared isolates.") + }) + output$replicate_table <- shiny::renderTable({ + d <- data() + shiny::req(d$metadata, nzchar(input$metadata_column)) + replicate_summary(d$first, d$metadata, input$metadata_column, + max_pairs = input$max_pairs) + }) + + # Each plot is calculated only when its tab is shown. Palette changes do + # not reload workbooks or recompute clustering. + make_view <- function(prefix, source, name, combined = FALSE, + first_label = "Matrix 1", second_label = "Matrix 2", + is_difference = FALSE) { + if (!is_difference) { + output[[paste0(prefix, "_intro")]] <- shiny::renderUI({ + m <- source() + d <- data() + if (combined) { + shiny::div(class = "section-note", + shiny::strong(sprintf("Upper triangle: %s (original range %s). ", + first_label, format_range(m$first))), + shiny::strong(sprintf("Lower triangle: %s (original range %s).", + second_label, format_range(m$second))), + shiny::p(class = "small-help", + "The common 0–1 color bar refers to separately normalized display colors, not a common measurement scale. A neutral diagonal separates the methods.") + ) + } else { + kind <- if (prefix == "plot1") d$kind1 else d$kind2 + shiny::p(class = "section-note", + sprintf("%s contains %d isolates. Original data range: %s. Input type: %s. Colors are rescaled for display; hover to see actual values.", + name, nrow(m), format_range(m), kind)) + } + }) + output[[paste0(prefix, "_legend")]] <- shiny::renderUI({ + d <- data() + field <- input$metadata_column + key <- ma_metadata_palette(d$metadata, field) + if (is.null(key)) return(NULL) + shiny::div(class = "metadata-key", + shiny::span(class = "key-title", + sprintf("%s annotation:", field)), + lapply(names(key), function(group) + shiny::span( + shiny::span(class = "swatch", + style = paste0("background-color:", unname(key[[group]]))), + group + )), + shiny::span(class = "small-help", + "(color track above the heatmap; not a similarity scale)") + ) + }) + } + output[[paste0(prefix, "_ui")]] <- shiny::renderUI({ + if (is_difference) shiny::req(can_difference()) + m <- source() + size <- if (combined || is_difference) nrow(m$first) else nrow(m) + if (size <= 300L) + shiny::div(class = "plot-frame", + plotly::plotlyOutput(paste0(prefix, "_interactive"), + width = "100%", height = "100%")) + else shiny::tagList( + shiny::p(class = "small-help", + "Representative raster preview. Click a cell for its exact original value. Use Display options to zoom."), + shiny::div(class = "plot-frame", + shiny::plotOutput(paste0(prefix, "_raster"), + width = "100%", height = "100%", + click = paste0(prefix, "_click"))) + ) + }) + output[[paste0(prefix, "_interactive")]] <- plotly::renderPlotly({ + if (is_difference) shiny::req(can_difference()) + m <- source() + size <- if (combined || is_difference) nrow(m$first) else nrow(m) + shiny::req(size <= 300L) + if (is_difference) m <- m$first - m$second + d <- data() + meta <- if (is_difference || !isTRUE(nzchar(input$metadata_column))) + NULL else d$metadata + ma_interactive(m, name = name, palette = input$palette, + show_numbers = input$show_numbers, combined = combined, + first_name = first_label, second_name = second_label, + log_scale = input$log_scale && !is_difference, + center_zero = is_difference, + metadata = meta, group_column = input$metadata_column) + }) + output[[paste0(prefix, "_raster")]] <- shiny::renderPlot({ + if (is_difference) shiny::req(can_difference()) + m <- source() + size <- if (combined || is_difference) nrow(m$first) else nrow(m) + shiny::req(size > 300L) + ix <- visible_indices(size) + if (combined || is_difference) { + # Slice first: do not build three full N*N combined copies for a preview. + a <- m$first[ix, ix, drop = FALSE] + b <- m$second[ix, ix, drop = FALSE] + if (combined) { + m <- ma_combined(a, b, input$log_scale)$values + normal <- TRUE + } else { + m <- a - b + normal <- FALSE + } + } else { + m <- m[ix, ix, drop = FALSE] + normal <- FALSE + } + graphics::par(mar = c(9, 9, 5, 2)) + d <- data() + meta <- if (is_difference || !nzchar(input$metadata_column)) NULL + else d$metadata + ma_raster(m, palette = input$palette, title = name, + metadata = meta, group_column = input$metadata_column, + normalized = normal, log_scale = input$log_scale && !is_difference, + center_zero = is_difference) + if (length(ix) < size) + graphics::mtext(if (isTRUE(input$zoom_enabled)) + sprintf("Zoom region; %d of %d isolates (starting at %d).", + length(ix), size, min(ix)) + else sprintf("Representative overview: %d of %d isolates. Zoom for exact detail.", + length(ix), size), side = 3, line = 0.1, cex = 0.75) + }, res = 110) + output[[paste0(prefix, "_cell")]] <- shiny::renderText({ + shiny::req(input[[paste0(prefix, "_click")]]) + if (is_difference) shiny::req(can_difference()) + m <- source() + base <- if (combined || is_difference) m$first else m + ix <- visible_indices(nrow(base)) + click <- input[[paste0(prefix, "_click")]] + col <- as.integer(round(click$x)) + row <- as.integer(length(ix) + 1L - round(click$y)) + if (is.na(col) || is.na(row) || col < 1L || + row < 1L || col > length(ix) || row > length(ix)) return("") + i <- ix[row] + j <- ix[col] + value <- if (combined && i > j) m$second[i, j] + else if (is_difference) m$first[i, j] - m$second[i, j] + else if (combined) m$first[i, j] else m[i, j] + sprintf("%s / %s: %s%s", rownames(base)[i], + colnames(base)[j], format(value, digits = 9), + if (combined) if (i < j) paste0(" (", first_label, ")") + else if (i > j) paste0(" (", second_label, ")") + else " (diagonal)" else "") + }) + } + make_view("plot1", ordered_first, "Matrix 1") + make_view("plot2", ordered_second, "Matrix 2") + make_view("combined1", combined_first, "Combined, ordered by matrix 1", + combined = TRUE) + make_view("combined2", combined_second, "Combined, ordered by matrix 2", + combined = TRUE, first_label = "Matrix 2", second_label = "Matrix 1") + make_view("difference", diff_matrix, "Matrix 1 minus matrix 2", + is_difference = TRUE) + + output$pairwise_intro <- shiny::renderUI({ + shiny::req(has_two()) + d <- data() + p <- pair_data() + axis1 <- if (identical(d$source, "synthetic example")) + "fictional ANI-like percentage" else paste("matrix 1", d$kind1) + axis2 <- if (identical(d$source, "synthetic example")) + "fictional MALDI-like similarity (0–1)" else paste("matrix 2", d$kind2) + shiny::p(class = "section-note", + sprintf("%s distinct pairs with a value in both matrices, of %s possible pairs. X = %s; Y = %s.%s", + format(p$valid_pairs, big.mark = ","), + format(p$total_pairs, big.mark = ","), + axis1, axis2, + if (p$sampled) + sprintf(" Evaluated a reproducible sample of %s pairs (seed %d).", + format(p$evaluated_pairs, big.mark = ","), p$seed) + else " All pairs are included.")) + }) + output$top_pairs_picker <- shiny::renderUI({ + if (!has_two()) return(NULL) + d <- data() + top <- pair_rank_gaps(pair_data(), d$kind1, d$kind2, top = 20L) + if (!nrow(top)) return(NULL) + labels <- sprintf("%s / %s (rank gap %.3f)", + top$sample_1, top$sample_2, top$rank_gap) + shiny::selectInput("rank_pair", "Explore a pair with different rankings", + choices = c("Choose from the largest rank gaps" = "", + stats::setNames(as.character(seq_len(nrow(top))), labels))) + }) + shiny::observeEvent(input$rank_pair, { + if (is.null(input$rank_pair) || !nzchar(input$rank_pair) || + !has_two()) return() + d <- data() + top <- pair_rank_gaps(pair_data(), d$kind1, d$kind2, top = 20L) + ix <- suppressWarnings(as.integer(input$rank_pair)) + if (is.na(ix) || ix < 1L || ix > nrow(top)) return() + shiny::updateSelectizeInput(session, "inspect_isolate", + selected = top$sample_1[ix]) + shiny::updateSelectizeInput(session, "inspect_partner", + selected = top$sample_2[ix]) + }) + selected_pair <- shiny::reactive({ + d <- data() + first <- input$inspect_isolate + second <- input$inspect_partner + shiny::req(length(first) == 1L, length(second) == 1L, + nzchar(first), nzchar(second), first != second) + manir_pair_inspection(d$first, d$second, first, second, + metadata = d$metadata, field = input$metadata_column, + comparable = can_difference()) + }) + output$pair_inspection <- shiny::renderUI({ + d <- loaded() + if (is.null(d) || is.null(d$second)) + return(shiny::p(class = "small-help", + "Load two matrices to inspect corresponding values for a pair.")) + if (is.null(input$inspect_isolate) || is.null(input$inspect_partner) || + !nzchar(input$inspect_isolate) || !nzchar(input$inspect_partner) || + identical(input$inspect_isolate, input$inspect_partner)) + return(shiny::p(class = "small-help", + "Choose two different shared isolates above.")) + p <- selected_pair() + fmt <- function(x) if (length(x) != 1L || !is.finite(x)) + "Missing" else format(signif(x, 6), trim = TRUE) + shiny::div(class = "pair-inspection-values", + shiny::div(shiny::span(d$label1), + shiny::strong(fmt(p$first))), + shiny::div(shiny::span(d$label2), + shiny::strong(fmt(p$second))), + if (!is.null(p$difference)) + shiny::div(shiny::span("Difference, original units"), + shiny::strong(fmt(p$difference))), + if (nzchar(p$metadata_field) && + (!is.na(p$group_1) || !is.na(p$group_2))) + shiny::p(class = "pair-annotation", + sprintf("%s: %s = %s; %s = %s", + p$metadata_field, p$isolate_1, + if (is.na(p$group_1)) "missing" else p$group_1, + p$isolate_2, + if (is.na(p$group_2)) "missing" else p$group_2)), + if (is.null(p$difference)) + shiny::p(class = "small-help", + "Original values shown separately. A difference is omitted because equivalent measurement units have not been confirmed.") + ) + }) + + output$scatter <- shiny::renderPlot({ + shiny::req(has_two()) + p <- pair_data() + d <- p$data + shiny::validate(shiny::need(nrow(d) >= 2L, + "At least two nonmissing sample pairs are needed.")) + current <- data() + first_label <- if (identical(current$source, "synthetic example")) + "Illustrative ANI (%)" else sprintf("%s (%s)", current$label1, current$kind1) + second_label <- if (identical(current$source, "synthetic example")) + "Illustrative MALDI similarity (0–1)" else + sprintf("%s (%s)", current$label2, current$kind2) + graphics::plot(d$first, d$second, pch = 19L, + col = grDevices::adjustcolor("#305f86", alpha.f = 0.58), + cex = 0.9, xlab = first_label, ylab = second_label, + main = sprintf("Distinct isolate pairs (n = %s%s)", + format(nrow(d), big.mark = ","), + if (p$sampled) ", sampled" else "")) + if (can_difference()) graphics::abline(0, 1, lty = 2, col = "#555555") + if (nrow(d) >= 3L) { + gap <- pair_rank_gaps(p, current$kind1, current$kind2, top = 5L) + key <- paste(d$sample_1, d$sample_2, sep = "|") + highlighted <- match(paste(gap$sample_1, gap$sample_2, sep = "|"), key) + graphics::points(d$first[highlighted], d$second[highlighted], + pch = 1L, cex = 1.65, lwd = 1.5, col = "#c45a35") + } + if (length(input$inspect_isolate) == 1L && + length(input$inspect_partner) == 1L && + nzchar(input$inspect_isolate) && nzchar(input$inspect_partner) && + !identical(input$inspect_isolate, input$inspect_partner)) { + chosen <- tryCatch(selected_pair(), error = function(e) NULL) + if (!is.null(chosen) && is.finite(chosen$first) && + is.finite(chosen$second)) { + graphics::points(chosen$first, chosen$second, pch = 21L, + bg = "#fac06e", col = "#803a1d", cex = 2, lwd = 1.4) + graphics::legend("topright", legend = "Selected pair", + pch = 21L, pt.bg = "#fac06e", bty = "n", cex = 0.85) + } + } + }) + output$rank_gaps <- shiny::renderTable({ + shiny::req(has_two()) + current <- data() + gap <- pair_rank_gaps(pair_data(), current$kind1, current$kind2, top = 10L) + if (!nrow(gap)) return(NULL) + names(gap) <- c("Isolate 1", "Isolate 2", "Matrix 1", "Matrix 2", "Rank gap") + gap + }, digits = 4, rownames = FALSE) + output$absolute_discrepancies_intro <- shiny::renderUI({ + if (!can_difference()) return(NULL) + shiny::tagList( + shiny::h4("Largest absolute differences"), + shiny::p(class = "small-help", + "These raw differences are available only because the two matrices have been marked as directly comparable. Sort by their magnitude for descriptive inspection, not a significance test.") + ) + }) + output$discrepancies <- shiny::renderTable({ + shiny::req(has_two(), can_difference()) + d <- pair_data()$data + d <- d[order(abs(d$difference), decreasing = TRUE), , drop = FALSE] + utils::head(d, 20L) + }, digits = 5) + + concordance <- shiny::reactive({ + shiny::req(has_two()) + m <- shared() + shiny::validate(shiny::need(nrow(m$first) <= 2000L, + "Cluster concordance is limited to 2,000 shared isolates.")) + shiny::validate(shiny::need(input$cluster_k < nrow(m$first), + "Choose fewer clusters than shared isolates.")) + cluster_concordance(m$first, m$second, kind_a = data()$kind1, + kind_b = data()$kind2, k = input$cluster_k, + linkage = data()$linkage) + }) + output$cluster_insight <- shiny::renderUI({ + d <- data() + if (is.null(d$second)) + return(shiny::p("Load a second matrix to compare cluster assignments.")) + c <- concordance() + shiny::div(class = "start-status ready", + shiny::strong(sprintf("%d shared isolates were partitioned into %d groups in each matrix.", + nrow(c$assignments), input$cluster_k)), + shiny::p(sprintf( + "Adjusted Rand index: %s. Adjusted Wallace, %s to %s: %s; in reverse: %s.", + manir_fmt(c$ari), d$label1, d$label2, + manir_fmt(c$adjusted_wallace_1_to_2), + manir_fmt(c$adjusted_wallace_2_to_1))), + shiny::p("The group numbers are arbitrary. Use the overlap table to identify groups that split between methods, then inspect those isolates in the heatmap or pair view.") + ) + }) + output$cluster_intro <- shiny::renderUI({ + shiny::req(has_two()) + d <- data() + shiny::p(class = "section-note", + sprintf("Clustering %d shared isolates independently in each matrix, using %d clusters and %s linkage. Change k in the toolbar to see how grouping agreement changes.", + length(shared()$ids), input$cluster_k, d$linkage)) + }) + output$cluster_summary <- shiny::renderTable({ + c <- concordance() + d <- data() + data.frame(measure = c("Adjusted Rand index", + sprintf("Adjusted Wallace (%s -> %s)", d$label1, d$label2), + sprintf("Adjusted Wallace (%s -> %s)", d$label2, d$label1)), + value = c(c$ari, c$adjusted_wallace_1_to_2, + c$adjusted_wallace_2_to_1)) + }) + output$cluster_overlap <- shiny::renderTable({ + x <- concordance()$contingency + overlap <- as.data.frame.matrix(x) + names(overlap) <- paste("Matrix 2 cluster", colnames(x)) + overlap <- data.frame("Matrix 1 cluster" = rownames(x), overlap, + check.names = FALSE, row.names = NULL) + overlap + }, rownames = FALSE) + output$cluster_table <- shiny::renderTable({ + assignment <- utils::head(concordance()$assignments, 100L) + d <- data() + names(assignment) <- c("Isolate", paste(d$label1, "cluster"), + paste(d$label2, "cluster")) + assignment + }, rownames = FALSE) + group_summary <- shiny::reactive({ + d <- data() + shiny::req(!is.null(d$metadata), length(input$metadata_column) == 1L, + nzchar(input$metadata_column)) + manir_group_overview(d$first, d$second, d$metadata, + input$metadata_column, + max_pairs = if (is.null(input$max_pairs)) 100000L else input$max_pairs) + }) + output$metadata_group_status <- shiny::renderUI({ + d <- data() + if (is.null(d$metadata)) + return(shiny::div(class = "start-status empty", + shiny::strong("Add sample metadata to investigate groups"), + shiny::p("Upload a file with isolate IDs and a biological group, replicate or batch column, then reload the data."))) + if (is.null(input$metadata_column) || !nzchar(input$metadata_column)) + return(shiny::div(class = "start-status empty", + shiny::strong("Choose a group or batch field"), + shiny::p(sprintf("Select one of these fields in the toolbar: %s.", + paste(names(d$metadata), collapse = ", "))))) + shiny::div(class = "start-status ready", + shiny::strong(sprintf("Exploring '%s'", input$metadata_column)), + shiny::p("These are descriptive pair summaries. Isolate pairs are reused, so the table and plots do not provide independent-sample p-values.")) + }) + output$group_overview <- shiny::renderTable({ + x <- group_summary() + names(x) <- c("Matrix", "Pair category", "Pairs", "Mean", + "Median", "Sampled") + x + }, digits = 5, rownames = FALSE) + output$group_plot_ui <- shiny::renderUI({ + d <- data() + if (is.null(d$metadata) || is.null(input$metadata_column) || + !nzchar(input$metadata_column)) return(NULL) + shiny::tagList( + shiny::h4("Distribution of pairwise measurements"), + shiny::p(class = "small-help", + "Each method uses its own original numerical scale. Boxplots show the spread of sampled or full pair values within and between groups, not independent biological replicates."), + shiny::plotOutput("group_distributions", height = "315px") + ) + }) + output$group_distributions <- shiny::renderPlot({ + d <- data() + shiny::req(d$metadata, length(input$metadata_column) == 1L, + nzchar(input$metadata_column)) + matrices <- list(d$first) + labels <- c(d$label1) + if (!is.null(d$second)) { + matrices <- c(matrices, list(d$second)) + labels <- c(labels, d$label2) + } + n <- length(matrices) + old <- graphics::par(mfrow = c(1L, n), mar = c(5, 4.5, 3.4, 1), + oma = c(0, 0, 0, 0)) + on.exit(graphics::par(old), add = TRUE) + for (i in seq_len(n)) { + gp <- manir_group_pairs(matrices[[i]], d$metadata, + input$metadata_column) + if (nrow(gp$data) && length(unique(gp$data$group)) > 1L) { + graphics::boxplot(value ~ group, data = gp$data, + main = labels[i], ylab = "Original matrix value", xlab = "Pair category", + col = c("#d4e9f4", "#b7d3d9"), outline = FALSE) + graphics::mtext(if (gp$sampled) "Representative sample of pairs" + else "All available pairs", + side = 3, line = 0.15, cex = 0.65) + } else { + graphics::plot.new() + graphics::title(main = labels[i]) + graphics::text(.5, .5, + "At least one within- and one between-group pair are needed.") + } + } + }, res = 110) + output$metadata_preview <- shiny::renderTable({ + shiny::req(data()$metadata) + utils::head(data()$metadata, 100L) + }, rownames = TRUE) + output$difference_explainer <- shiny::renderUI({ + d <- data() + if (is.null(d$second)) + return(shiny::p(class = "section-note", + "Upload a second matrix, or load the example, before comparing pairs.")) + if (identical(d$source, "synthetic example")) + return(shiny::div(class = "reading-guide", + shiny::strong("Unavailable for the example"), + shiny::p("The fictional ANI measurements are percentage-like (about 95–100), while the fictional MALDI similarities range from 0 to 1. These are different measurement types. The application deliberately blocks direct subtraction for this example. Use the pairwise rank-gap table or the two combined heatmaps instead."))) + if (!can_difference()) + return(shiny::p(class = "section-note", + "To enable a difference map, confirm in the sidebar that both matrices measure the same quantity in the same units and were processed compatibly.")) + shiny::p(class = "section-note", + "Difference = matrix 1 minus matrix 2 in original units. Zero is the neutral midpoint; positive and negative values appear on opposite sides. Colors are scaled symmetrically around zero, so hover or export the exact matrix for numerical comparisons.") + }) + output$download_difference_ui <- shiny::renderUI({ + if (!can_difference()) return(NULL) + shiny::downloadButton("download_difference", "Exact difference matrix CSV") + }) + output$difference_download_notice <- shiny::renderUI({ + d <- data() + if (!can_difference()) + shiny::p(class = "small-help", + if (identical(d$source, "synthetic example")) + "The difference export is disabled for the mixed-unit example." + else "The difference export appears after you confirm comparable measurements and load both matrices.") + }) + output$metadata_note <- shiny::renderUI({ + shiny::req(data()$metadata) + shiny::p("Showing up to 100 metadata rows. Choose a categorical metadata field in the toolbar to compare within-group and between-group measurements.") + }) + + mantel_result <- shiny::eventReactive(input$run_mantel, { + shiny::req(has_two()) + tryCatch({ + x <- shared() + matrix_mantel(x$first, x$second, permutations = input$permutations) + }, error = function(e) list(error = conditionMessage(e))) + }) + output$mantel_result <- shiny::renderPrint({ + shiny::req(mantel_result()) + r <- mantel_result() + if (!is.null(r$error)) cat("Mantel test: ", r$error, "\n") + else cat(sprintf("Mantel test: r = %.5f, two-sided permutation p = %.5g; %d label permutations, seed %d.\n", + r$observed, r$p_two_sided, r$permutations, r$seed)) + }) + + output$download_research_summary <- shiny::downloadHandler( + filename = function() "MAniR_research_notes.md", + content = function(file) { + d <- data() + max_pairs <- if (is.null(input$max_pairs)) 100000L else input$max_pairs + pairs <- if (is.null(d$second)) NULL else pair_data() + field <- if (is.null(input$metadata_column)) "" else input$metadata_column + groups <- if (!is.null(d$metadata) && nzchar(field)) + group_summary() else NULL + clusters <- NULL + if (isTRUE(input$report_clusters) && !is.null(d$second)) { + m <- shared() + k <- if (is.null(input$cluster_k)) 3L else as.integer(input$cluster_k) + if (nrow(m$first) <= 2000L && k >= 2L && k < nrow(m$first)) + clusters <- concordance() + else + shiny::showNotification( + "Cluster statistics were omitted: the dataset or k is outside the supported limits.", + type = "warning", duration = 7) + } + question <- if (is.null(input$research_question)) "" else input$research_question + notes <- if (is.null(input$research_notes)) "" else input$research_notes + text <- manir_research_report(d, pairs = pairs, group_table = groups, + group_field = field, cluster = clusters, comparable = can_difference(), + question = question, notes = notes, max_pairs = max_pairs) + writeLines(text, con = file, useBytes = TRUE) + } + ) + output$download_first <- shiny::downloadHandler( + filename = function() "MAniR_matrix1.csv", + content = function(file) write_matrix_csv(data()$first, file)) + output$download_second <- shiny::downloadHandler( + filename = function() "MAniR_matrix2.csv", + content = function(file) { + shiny::req(data()$second) + write_matrix_csv(data()$second, file) + }) + output$download_pairs <- shiny::downloadHandler( + filename = function() "MAniR_pairwise_values.csv", + content = function(file) { + shiny::req(has_two()) + values <- pair_export_data(pair_data(), comparable = can_difference()) + utils::write.csv(values, file, row.names = FALSE) + }) + output$download_clusters <- shiny::downloadHandler( + filename = function() "MAniR_clusters.csv", + content = function(file) utils::write.csv( + concordance()$assignments, file, row.names = FALSE)) + output$download_rds <- shiny::downloadHandler( + filename = function() "MAniR_matrices.rds", + content = function(file) { + d <- data() + saveRDS(list(first = d$first, second = d$second, + metadata = d$metadata, order1 = d$order1, + order2 = d$order2, matching = d$matching, + kinds = c(d$kind1, d$kind2)), file) + }) + output$download_first_png <- shiny::downloadHandler( + filename = function() "MAniR_matrix1.png", + content = function(file) + ma_save_png(ordered_first(), file, palette = input$palette, + title = "Matrix 1", log_scale = input$log_scale)) + output$download_combined_png <- shiny::downloadHandler( + filename = function() "MAniR_combined.png", + content = function(file) { + m <- combined_first() + # Export no more than 1,200 representative isolates to bound memory, + # then calculate display normalization on that exact exported subset. + ix <- ma_preview(m$first, max_side = 1200L)$indices + a <- m$first[ix, ix, drop = FALSE] + b <- m$second[ix, ix, drop = FALSE] + shown <- ma_combined(a, b, input$log_scale)$values + ma_save_png(shown, file, palette = input$palette, + title = sprintf("Combined matrix, %d of %d isolates", length(ix), + nrow(m$first)), normalized = TRUE) + }) + output$download_pdf <- shiny::downloadHandler( + filename = function() "MAniR_matrix1.pdf", + content = function(file) + ma_save_pdf(ordered_first(), file, palette = input$palette, + title = "Matrix 1", log_scale = input$log_scale)) + output$download_svg <- shiny::downloadHandler( + filename = function() "MAniR_matrix1.svg", + content = function(file) + ma_save_svg(ordered_first(), file, palette = input$palette, + title = "Matrix 1", log_scale = input$log_scale)) + output$download_html <- shiny::downloadHandler( + filename = function() "MAniR_interactive_preview.html", + content = function(file) { + m <- ordered_first() + ix <- ma_preview(m, max_side = 300L)$indices + widget <- ma_interactive(m[ix, ix, drop = FALSE], + name = sprintf("Matrix 1 (%d of %d isolates)", length(ix), nrow(m)), + palette = input$palette, show_numbers = input$show_numbers, + log_scale = input$log_scale) + htmlwidgets::saveWidget(widget, file = file, selfcontained = TRUE) + }) + output$download_difference <- shiny::downloadHandler( + filename = function() "MAniR_difference_matrix.csv", + content = function(file) { + shiny::req(can_difference()) + m <- combined_first() + # Full difference matrices are intentionally materialized only when + # explicitly requested for export. + write_matrix_csv(m$first - m$second, file) + }) + output$download_settings <- shiny::downloadHandler( + filename = function() "MAniR_analysis_settings.txt", + content = function(file) { + d <- data() + writeLines(c( + paste("MAniR generated:", Sys.time()), + paste("First matrix:", d$label1, nrow(d$first), "isolates"), + paste("Second matrix:", + if (is.null(d$second)) "None" else + paste(d$label2, nrow(d$second), "isolates")), + paste("Matrix kinds:", d$kind1, d$kind2), + paste("Sample matching:", d$matching), + paste("Cluster requested:", input$cluster), + paste("Cluster limit:", 2000L), + paste("Linkage:", d$linkage), + paste("Color palette:", input$palette), + paste("Log display scaling:", input$log_scale), + paste("Comparable units selected:", input$comparable_scales), + paste("Difference analysis permitted:", can_difference()), + paste("Maximum analyzed pairs:", input$max_pairs), + paste("Pair sampling seed:", 1L), + paste("Mantel seed:", 1L), + paste("Session:", paste(utils::capture.output(utils::sessionInfo()), + collapse = "\n")) + ), file) + }) +} diff --git a/tests/run_tests.R b/tests/run_tests.R new file mode 100644 index 0000000..442916c --- /dev/null +++ b/tests/run_tests.R @@ -0,0 +1,434 @@ +# Run with: Rscript tests/run_tests.R +source("R/matrix_io.R") +source("R/matrix_analysis.R") +source("R/matrix_plot.R") +source("R/example_data.R") +source("R/research_workflows.R") +source("R/research_ui.R") + +expect_error <- function(expr, pattern = NULL) { + e <- tryCatch({force(expr); NULL}, error = function(e) conditionMessage(e)) + if (is.null(e)) stop("Expected an error, but none was raised.", call. = FALSE) + if (!is.null(pattern) && !grepl(pattern, e, ignore.case = TRUE)) + stop("Expected error matching: ", pattern, "; got: ", e, call. = FALSE) + invisible(e) +} +test <- function(label, expression) { + force(expression) + cat("PASS:", label, "\n") +} + +ids <- c("Isolate B", "Isolate A", "Isolate C", "Isolate D") +m <- matrix(c( + 100, 80, 40, 30, + 80,100, 45, 35, + 40, 45,100, 95, + 30, 35, 95,100 +), 4, byrow = TRUE, dimnames = list(ids, ids)) +test("matrix import reorders named rows to named columns", { + scrambled <- m[c(3, 1, 4, 2), , drop = FALSE] + imported <- validate_matrix(scrambled, "similarity") + stopifnot(identical(dimnames(imported), dimnames(m)), + isTRUE(all.equal(unname(imported), unname(m), + check.attributes = FALSE))) +}) +test("numeric data frames take the exact-value matrix import path", { + data <- as.data.frame(m, check.names = FALSE) + result <- validate_matrix(data, "similarity") + stopifnot(isTRUE(all.equal(unname(result), unname(m), + check.attributes = FALSE))) +}) +test("matrix identifiers are trimmed without changing values", { + dirty <- m + rownames(dirty) <- paste0(" ", rownames(dirty), " ") + colnames(dirty) <- paste0(" ", colnames(dirty), " ") + cleaned <- validate_matrix(dirty) + stopifnot(identical(rownames(cleaned), ids), + identical(colnames(cleaned), ids)) +}) +test("duplicate, inconsistent, nonnumeric, negative and asymmetric data fail", { + x <- m; rownames(x)[2] <- rownames(x)[1] + expect_error(validate_matrix(x), "Duplicate") + x <- m; colnames(x)[2] <- "Wrong ID" + expect_error(validate_matrix(x), "differ") + x <- as.data.frame(m); x[1, 3] <- "not a number" + expect_error(validate_matrix(x), "nonnumeric") + x <- m; x[1, 2] <- 70 + expect_error(validate_matrix(x), "symmetric") + x <- m; x[1, 2] <- -1; x[2, 1] <- -1 + expect_error(validate_matrix(x, "similarity"), "negative") + x <- m; x[1, 2] <- 2; x[2, 1] <- 2 + expect_error(validate_matrix(x, "correlation"), "between -1 and 1") +}) +test("missing values must occur in mirrored pairs", { + x <- m; x[1, 2] <- NA_real_ + expect_error(validate_matrix(x), "mirrored") + x[2, 1] <- NA_real_ + stopifnot(is.na(validate_matrix(x)[1, 2])) +}) +test("matched matrices preserve exact values", { + reversed <- m[rev(ids), rev(ids), drop = FALSE] / 100 + mm <- match_matrices(m, reversed) + stopifnot(identical(mm$ids, ids), + isTRUE(all.equal(mm$second, m / 100, + check.attributes = FALSE))) +}) +test("intersection reports excluded samples", { + x <- m[1:3, 1:3] + y <- m[2:4, 2:4] + res <- match_matrices(x, y, "intersection") + stopifnot(length(res$ids) == 2L, + identical(res$only_first, ids[1]), + identical(res$only_second, ids[4])) + expect_error(match_matrices(x, y, "strict"), "differ") +}) +test("pair indices cover the strictly upper triangle exactly once", { + p <- upper_pair_indices(4, max_pairs = 100) + stopifnot(identical(p$i, c(1L, 1L, 2L, 1L, 2L, 3L)), + identical(p$j, c(2L, 3L, 3L, 4L, 4L, 4L)), + p$total == 6, !p$sampled) +}) +test("sampling is reproducible and does not alter the session RNG", { + set.seed(1234) + before <- .Random.seed + p1 <- upper_pair_indices(500, 1000, seed = 41) + stopifnot(identical(before, .Random.seed)) + p2 <- upper_pair_indices(500, 1000, seed = 41) + stopifnot(identical(p1, p2), p1$sampled, + all(p1$i < p1$j), !anyDuplicated(paste(p1$i, p1$j))) +}) +test("matrix pair comparison excludes mirrored and diagonal pairs", { + pp <- paired_values(m, m * 2) + stopifnot(nrow(pp$data) == 6L, !pp$sampled) + stats <- matrix_agreement(pp) + stopifnot(abs(stats$pearson - 1) < 1e-12, + abs(stats$spearman - 1) < 1e-12) +}) +test("scale handling preserves source matrices", { + before <- m + combined <- ma_combined(m, m / 100) + stopifnot(identical(m, before), + identical(combined$original[1, 2], m[1, 2]), + identical(combined$original[2, 1], m[2, 1] / 100), + all(combined$values >= 0 & combined$values <= 1)) + constant <- matrix(4, 2, 2) + stopifnot(all(ma_scale(constant) == 0.5)) + centered <- matrix(c(-3, -1, 0, 3), nrow = 2) + stopifnot(isTRUE(all.equal(as.vector(ma_scale(centered, + center_zero = TRUE)), c(0, 1/3, 0.5, 1)))) + stopifnot(all(is.finite(ma_scale(matrix(c(0, 1, 2, 3), 2), TRUE)))) + expect_error(ma_scale(matrix(c(-1, 0, 1, 2), 2), TRUE), "nonnegative") +}) +test("cluster ordering and adjusted Rand index are reproducible", { + c1 <- matrix_order(m) + c2 <- matrix_order(m) + stopifnot(identical(c1$ids, c2$ids), + identical(sort(c1$ids), sort(ids)), + adjusted_rand(c(1, 1, 2, 2), c(2, 2, 1, 1)) == 1) + stopifnot(abs(adjusted_wallace(c(1, 1, 2, 2), + c(2, 2, 1, 1)) - 1) < 1e-12) + result <- cluster_concordance(m, m, k = 2) + stopifnot(abs(result$ari - 1) < 1e-12, + abs(result$adjusted_wallace_1_to_2 - 1) < 1e-12, + abs(result$adjusted_wallace_2_to_1 - 1) < 1e-12, + nrow(result$assignments) == 4L) + skip <- matrix_order(m, max_cluster = 2L) + stopifnot(isTRUE(skip$skipped), is.null(skip$tree)) +}) +test("Mantel permutation uses label permutations and restores RNG", { + set.seed(48) + before <- .Random.seed + res <- matrix_mantel(m, m, permutations = 99, seed = 44) + stopifnot(abs(res$observed - 1) < 1e-12, + res$p_two_sided > 0 && res$p_two_sided <= 1, + identical(before, .Random.seed)) +}) +test("metadata alignment and replicate summaries work", { + meta <- data.frame(group = c("G1", "G1", "G2", "G2"), + row.names = rev(ids)) + aligned <- align_metadata(meta, ids) + stopifnot(identical(rownames(aligned), ids)) + summary <- replicate_summary(m, meta, "group") + stopifnot(nrow(summary) == 2L, sum(summary$pairs) == 6L) +}) +test("CSV export and reimport retain original values", { + path <- tempfile(fileext = ".csv") + write_matrix_csv(m, path) + imported <- read_matrix_input(path) + stopifnot(isTRUE(all.equal(m, imported, check.attributes = FALSE))) +}) +test("compressed TSV input keeps names and numeric precision", { + path <- tempfile(fileext = ".tsv.gz") + con <- gzfile(path, "wt") + utils::write.table(data.frame(sample_id = ids, m, check.names = FALSE), + file = con, sep = "\t", row.names = FALSE, quote = TRUE) + close(con) + imported <- read_matrix_input(path) + stopifnot(isTRUE(all.equal(m, imported, check.attributes = FALSE))) +}) +test("RDS input supports numeric matrices", { + path <- tempfile(fileext = ".rds") + saveRDS(m, path) + imported <- read_matrix_input(path) + stopifnot(isTRUE(all.equal(m, imported, check.attributes = FALSE))) +}) +test("large matrix preview is bounded and retains exact sampled values", { + big <- matrix(1, 900, 900) + diag(big) <- 100 + dimnames(big) <- list(paste0("I", seq_len(900)), + paste0("I", seq_len(900))) + preview <- ma_preview(big, max_side = 128) + stopifnot(identical(dim(preview$matrix), c(128L, 128L)), + identical(preview$matrix, + big[preview$indices, preview$indices, drop = FALSE])) + png_file <- tempfile(fileext = ".png") + ma_save_png(big, png_file, max_side = 128) + stopifnot(file.exists(png_file), file.info(png_file)$size > 0) + pdf_file <- tempfile(fileext = ".pdf") + ma_save_pdf(big[seq_len(20), seq_len(20)], pdf_file) + stopifnot(file.exists(pdf_file), file.info(pdf_file)$size > 0) +}) + + +test("bundled XLSX example imports and preserves matrix pairing", { + file <- "www/moc_data.xlsx" + stopifnot(file.exists(file)) + sheets <- openxlsx::getSheetNames(file) + stopifnot(length(sheets) >= 2L) + wb <- openxlsx::loadWorkbook(file) + a <- read_matrix_input(file, sheet = sheets[1L], workbook = wb) + b <- read_matrix_input(file, sheet = sheets[2L], workbook = wb) + matched <- match_matrices(a, b) + mixed <- ma_combined(matched$first, matched$second) + stopifnot(nrow(a) > 1L, nrow(b) > 1L, + identical(rownames(mixed$original), matched$ids), + isTRUE(all.equal(mixed$original[upper.tri(mixed$original)], + matched$first[upper.tri(matched$first)])), + isTRUE(all.equal(mixed$original[lower.tri(mixed$original)], + matched$second[lower.tri(matched$second)]))) +}) + + +test("CSV import preserves leading zeroes in sample IDs", { + id <- c("001", "002", "003") + x <- matrix(c(1, .8, .5, .8, 1, .6, .5, .6, 1), + nrow = 3L, dimnames = list(id, id)) + file <- tempfile(fileext = ".csv") + write_matrix_csv(x, file) + y <- read_matrix_input(file) + stopifnot(identical(rownames(y), id), identical(colnames(y), id)) +}) + + +test("built-in synthetic ANI/MALDI example is valid and includes metadata", { + demo <- manir_load_example() + stopifnot( + identical(dim(demo$first), c(12L, 12L)), + identical(dim(demo$second), c(12L, 12L)), + identical(dimnames(demo$first), dimnames(demo$second)), + all(diag(demo$first) == 100), + all(diag(demo$second) == 1), + identical(rownames(demo$metadata), rownames(demo$first)), + identical(names(demo$metadata), c("group", "source", "batch")), + length(unique(demo$metadata$group)) == 3L, + abs(demo$second["ISO_02", "ISO_03"] - 0.52) < 1e-12, + abs(demo$second["ISO_04", "ISO_05"] - 0.88) < 1e-12 + ) + values <- paired_values(demo$first, demo$second) + stopifnot(!values$sampled, values$valid_pairs == 66L) +}) + +test("downloadable XLSX example round-trips all matrices and metadata", { + demo <- manir_load_example() + path <- tempfile(fileext = ".xlsx") + manir_write_example_workbook(path) + stopifnot(file.exists(path), file.info(path)$size > 0) + stopifnot(identical(openxlsx::getSheetNames(path), + c("ANI", "MALDI", "metadata", "README"))) + first <- read_matrix_input(path, sheet = "ANI") + second <- read_matrix_input(path, sheet = "MALDI") + metadata <- read_metadata_input(path, sheet = "metadata") + stopifnot( + isTRUE(all.equal(first, demo$first, check.attributes = FALSE)), + isTRUE(all.equal(second, demo$second, check.attributes = FALSE)), + identical(metadata, demo$metadata) + ) + guide <- openxlsx::read.xlsx(path, sheet = "README") + stopifnot(grepl("SYNTHETIC", guide$Notes[1L])) +}) + + +test("pair export hides raw differences between incompatible measurement scales", { + example <- manir_load_example() + pairs <- paired_values(example$first, example$second) + separate <- pair_export_data(pairs) + comparable <- pair_export_data(pairs, comparable = TRUE) + stopifnot(!"difference" %in% names(separate), + "difference" %in% names(comparable), + nrow(separate) == 66L) +}) + +test("rank gaps compare pair order without subtracting incompatible units", { + example <- manir_load_example() + pair <- paired_values(example$first, example$second) + top <- pair_rank_gaps(pair, "similarity", "similarity", top = 10L) + stopifnot(nrow(top) == 10L, all(is.finite(top$rank_gap)), + all(top$rank_gap >= 0 & top$rank_gap <= 1), + all(diff(top$rank_gap) <= 0)) + # Distances are reversed before comparing pair ranks, so negating all + # second-matrix scores and marking them as distance changes no rank gaps. + reversed <- pair + reversed$data$second <- -reversed$data$second + alt <- pair_rank_gaps(reversed, "similarity", "distance", top = 10L) + stopifnot(isTRUE(all.equal(top$rank_gap, alt$rank_gap))) + expect_error(pair_rank_gaps(pair, "invalid", "similarity"), "Unrecognized") +}) + +test("metadata colors keep their meaning across both matrix orders", { + example <- manir_load_example() + key <- ma_metadata_palette(example$metadata, "group") + reordered <- example$metadata[rev(rownames(example$metadata)), , drop = FALSE] + stopifnot(length(key) == 3L, + identical(key, ma_metadata_palette(reordered, "group")), + is.null(ma_metadata_palette(example$metadata, "missing"))) + # The strip must live above the plot, not in the y-axis label margin. + p <- plotly::plotly_build(ma_interactive( + example$first, metadata = example$metadata, group_column = "group")) + stopifnot(length(p$x$layout$shapes) == nrow(example$first), + all(vapply(p$x$layout$shapes, + function(x) identical(x$yref, "paper") && x$y0 > 1, + logical(1L)))) +}) + + +test("research question choices are concrete and available on the start page", { + source("ui.R", local = TRUE) + html <- htmltools::renderTags(ui)$html + for (text in c("Start here", "What do you want to find out?", + "Do two methods give similar results?", + "Which isolate pairs deserve a closer look?", + "Do both methods make the same groups?", + "Are known groups or batches reflected in the data?", + "I want to inspect my matrix.", + "inspect_isolate", "inspect_partner", + "Download research notes", "group_plot_ui")) { + if (!grepl(text, html, fixed = TRUE)) + stop("Missing research workflow control or help: ", text) + } + for (id in c("start_agreement", "start_pairs", "start_cluster", + "start_groups", "start_heatmap", "start_export", + "inspect_isolate", "inspect_partner", "research_question", + "research_notes")) { + occurrences <- gregexpr(paste0('id="', id, '"'), html, + fixed = TRUE)[[1L]] + stopifnot(length(occurrences) == 1L, occurrences[1L] != -1L) + } +}) + +test("pair inspection preserves exact values and distinguishes incomparable units", { + demo <- manir_load_example() + p <- manir_pair_inspection(demo$first, demo$second, "ISO_02", "ISO_03", + demo$metadata, "group") + stopifnot(isTRUE(all.equal(p$first, demo$first["ISO_02", "ISO_03"])), + isTRUE(all.equal(p$second, .52)), + is.null(p$difference), identical(p$group_1, "Group_A"), + identical(p$group_2, "Group_A")) + same <- manir_pair_inspection(demo$first, demo$first, "ISO_02", "ISO_03", + comparable = TRUE) + stopifnot(identical(same$difference, 0)) + expect_error(manir_pair_inspection(demo$first, demo$second, + "ISO_02", "ISO_02"), "different") + expect_error(manir_pair_inspection(demo$first, demo$second, + "not_an_isolate", "ISO_02"), "present") +}) + +test("within- and between-group comparison retains original scales and sample accounting", { + demo <- manir_load_example() + result <- manir_group_overview(demo$first, demo$second, + demo$metadata, "group") + stopifnot(nrow(result) == 4L, + identical(unique(result$matrix), c("Matrix 1", "Matrix 2")), + sum(result$pairs[result$matrix == "Matrix 1"]) == 66L, + sum(result$pairs[result$matrix == "Matrix 2"]) == 66L) + plot_values <- manir_group_pairs(demo$first, demo$metadata, "group") + stopifnot(nrow(plot_values$data) == 66L, + !plot_values$sampled, + identical(sort(unique(plot_values$data$group)), + c("Between", "Within"))) + expect_error(manir_group_overview(demo$first, metadata = demo$metadata, + field = "missing"), "Select") +}) + +test("direction-adjusted association treats distances as distances", { + demo <- manir_load_example() + pair <- paired_values(demo$first, demo$second) + related <- manir_directional_association(pair, "similarity", "similarity") + opposite <- manir_directional_association(pair, "distance", "similarity") + stopifnot(isTRUE(all.equal(related$pearson, -opposite$pearson)), + isTRUE(all.equal(related$spearman, -opposite$spearman)), + related$n == 66L) +}) + +test("research notes are editable, truthful and contain no mixed-scale difference", { + demo <- manir_load_example() + dataset <- c(demo, list(source = "synthetic example", + matching = "strict", linkage = "complete", + kind1 = "similarity", kind2 = "similarity", + label1 = "ANI (synthetic)", label2 = "MALDI (synthetic)")) + pairs <- paired_values(demo$first, demo$second) + groups <- manir_group_overview(demo$first, demo$second, + demo$metadata, "group") + notes <- manir_research_report(dataset, pairs, groups, "group", + comparable = FALSE, + question = "Do these methods describe similar relationships?", + notes = "Recheck the discordant pair with original data.") + joined <- paste(notes, collapse = "\n") + stopifnot(grepl("SYNTHETIC", joined), + grepl("Spearman", joined), + grepl("Recheck the discordant pair", joined), + grepl("Raw differences omitted", joined), + !grepl("Mean absolute difference", joined)) + single <- dataset + single$second <- NULL + one <- manir_research_report(single) + stopifnot(!grepl("Pairwise relationship", paste(one, collapse = "\n"))) +}) + +test("workspace separates scrolling inputs from persistent live controls", { + source("ui.R", local = TRUE) + rendered <- htmltools::renderTags(ui) + html <- rendered$html + for (expected in c("workspace", "control-sidebar", "sidebar-scroll", + "sidebar-footer", "results-toolbar", "results-shell", + "Display options")) { + if (!grepl(expected, html, fixed = TRUE)) + stop("Missing expected workspace element: ", expected) + } + # The primary navigation keeps its five matrix views in a single tab. + stopifnot(grepl('id="matrix_view"', html, fixed = TRUE), + grepl("Heatmaps", html, fixed = TRUE)) + # htmltools hoists stylesheets from the body into the document head. + stopifnot(grepl("workspace.css", rendered$head, fixed = TRUE)) + # Repeated Shiny input IDs would lead to controls updating the wrong value. + for (id in c("palette", "metadata_column", "show_numbers", "cluster_k", + "zoom_enabled", "visualize", "load_example")) { + found <- gregexpr(paste0('id="', id, '"'), html, fixed = TRUE)[[1L]] + stopifnot(length(found) == 1L, found[1L] != -1L) + } + css <- paste(readLines("www/workspace.css", warn = FALSE), collapse = "\n") + stopifnot(grepl("overflow-y: auto", css, fixed = TRUE), + grepl("max-width: 991px", css, fixed = TRUE), + grepl(".plot-frame", css, fixed = TRUE)) +}) + +test("every result tab includes contextual interpretation guidance", { + source("ui.R", local = TRUE) + view <- htmltools::renderTags(ui)$html + stopifnot(grepl("How to read this", view, fixed = TRUE), + grepl("Adjusted Wallace", view, fixed = TRUE), + grepl("rank differences", view, fixed = TRUE), + grepl("different measurement", view, fixed = TRUE), + grepl("metadata", view, fixed = TRUE)) +}) + +cat("All MAniR regression tests passed.\n") diff --git a/tests/test_shiny.R b/tests/test_shiny.R new file mode 100644 index 0000000..62f8144 --- /dev/null +++ b/tests/test_shiny.R @@ -0,0 +1,95 @@ +# Minimal server integration test. Requires Shiny and the declared runtime packages. +source("R/matrix_io.R") +source("R/matrix_analysis.R") +source("R/matrix_plot.R") +source("R/example_data.R") +source("R/research_workflows.R") +source("R/research_ui.R") +source("server.R") + +ids <- c("001", "002", "003", "004") +m <- matrix(c(1, .7, .4, .3, + .7, 1, .8, .5, + .4, .8, 1, .9, + .3, .5, .9, 1), 4, byrow = TRUE, + dimnames = list(ids, ids)) +path <- tempfile(fileext = ".csv") +write_matrix_csv(m, path) +file_info <- data.frame(name = "example.csv", + size = as.numeric(file.info(path)$size), + type = "text/csv", datapath = path, + stringsAsFactors = FALSE) + +shiny::testServer(server, { + session$setInputs( + first_file = file_info, + kind1 = "similarity", kind2 = "similarity", + cluster = FALSE, linkage = "complete", + match_mode = "strict", visualize = 1 + ) + loaded_data <- loaded() + stopifnot(!is.null(loaded_data), nrow(loaded_data$first) == 4L, + identical(colnames(loaded_data$first), ids), + is.null(loaded_data$second)) + # A palette change should affect only rendering, not the loaded matrix. + session$setInputs(palette = "Viridis") + stopifnot(identical(loaded()$first, loaded_data$first)) + session$setInputs(start_pairs = 1) + stopifnot(is.null(current_goal())) + session$setInputs(start_heatmap = 1) + stopifnot(identical(current_goal()$tab, "Heatmaps")) + session$setInputs(start_groups = 1) + stopifnot(identical(current_goal()$tab, "Heatmaps")) +}) + +shiny::testServer(server, { + session$setInputs(kind1 = "similarity", kind2 = "similarity", + cluster = FALSE, linkage = "complete", + match_mode = "strict", load_example = 1) + demo <- loaded() + stopifnot( + !is.null(demo), + identical(demo$source, "synthetic example"), + nrow(demo$first) == 12L, nrow(demo$second) == 12L, + nrow(demo$metadata) == 12L, + identical(demo$matching, "strict") + ) + # Even when a checkbox is set, mixed-unit teaching data must not be + # subtracted or exported as a misleading difference matrix. + session$setInputs(comparable_scales = TRUE) + stopifnot(!can_difference()) + session$setInputs(start_agreement = 1) + stopifnot(identical(current_goal()$tab, "Overview")) + session$setInputs(start_pairs = 1) + stopifnot(identical(current_goal()$tab, "Pairwise comparison")) + session$setInputs(inspect_isolate = "ISO_02", inspect_partner = "ISO_03") + exact <- selected_pair() + stopifnot(abs(exact$second - 0.52) < 1e-12, + is.null(exact$difference)) + session$setInputs(metadata_column = "group", start_groups = 1) + stopifnot(identical(current_goal()$tab, "Metadata"), + nrow(group_summary()) == 4L) + session$setInputs(start_cluster = 1) + stopifnot(identical(current_goal()$tab, "Cluster comparison")) + session$setInputs(start_export = 1) + stopifnot(identical(current_goal()$tab, "Export")) + session$setInputs(back_to_questions = 1) + stopifnot(is.null(current_goal())) + # An ordinary upload after the example must replace it without carrying + # across the example metadata or second matrix. + session$setInputs(first_file = file_info, visualize = 1) + own <- loaded() + stopifnot(identical(own$source, "uploaded files"), + nrow(own$first) == 4L, is.null(own$second), + is.null(own$metadata)) + session$setInputs(second_file = file_info, comparable_scales = TRUE, + visualize = 2) + stopifnot(can_difference(), + nrow(shared()$first) == 4L) + session$setInputs(load_example = 2) + stopifnot(identical(loaded()$source, "synthetic example"), + nrow(loaded()$second) == 12L, !can_difference(), + identical(loaded()$linkage, "complete")) +}) + +cat("Shiny upload and example reactive smoke tests passed.\n") diff --git a/ui.R b/ui.R index bd6fd09..097c03b 100644 --- a/ui.R +++ b/ui.R @@ -1,405 +1,345 @@ -library("shiny") -library("shinyjs") -library("shinyBS") -library("shinyWidgets") -library("openxlsx") -library("RColorBrewer") -library("corrplot") -library("periscope") -library("heatmaply") -library("plotly") - - -jscode <- " -shinyjs.disableTab = function(name) { -var tab = $('.nav li a[data-value=\"' + name + '\"]'); -tab.bind('click.tab', function(e) { -e.preventDefault(); -return false; -}); -tab.addClass('disabled'); -// on hover, show disabled cursor -tab.hover(function() { -$(this).css('cursor','not-allowed'); -}, function() { -$(this).css('cursor','auto'); -}); -} - -shinyjs.enableTab = function(name) { -var tab = $('.nav li a[data-value=\"' + name + '\"]'); -tab.unbind('click.tab'); -tab.removeClass('disabled'); -// reset hover style to hand pointing -tab.hover(function() { -$(this).css('cursor','pointer'); -}, function() { -$(this).css('cursor','auto'); -}); -} - -shinyjs.clickTab = function(name) { -var tab = $('.nav li a[data-value=\"' + name + '\"]'); -tab.click(); -} - -shinyjs.goToMatrix1tab = function() { - // set the active tab to the 'Matrix 1' tab if the current tab is the 'Instructions' tab - // note, multiple tabs can be active at the same time, so we need to check if the 'Instructions' tab is active - //instructions is the data-value of the a inside the li - if ($('.nav li a[data-value=\"Instructions\"]').parent().hasClass('active')) { - // click the 'Matrix 1' tab - tab = $('.nav li a[data-value=\"Matrix\ 1\"]'); - tab.click(); - } -} -" - -# Define UI for application that draws a histogram -ui <- fluidPage( - # Application title - useShinyjs(), - shinyjs::extendShinyjs(text = jscode, functions = c("disableTab", "enableTab", "clickTab", "goToMatrix1tab")), - tags$head(tags$style(HTML("body { - background-color:#fffff9; - color:#2F3C7E; - } - .well { - background-color:#2F3C7E; - color:#fffff9; - } - .sw-dropdown-in { - color: #2F3C7E; - } - .tab-content { - padding:10px; - background-color:#fffff9; - color: #2F3C7E; - border-radius:4px; - } - #outputPanel>li>a, - li[role='presentation']>a { - background-color:#DCD6D5FF; - } - #outputPanel>li.active>a{ - background-color:#FFF; - } - table, th, td { - border: 1px solid black; - padding:5px - } - ")), - tags$script(src = "https://cdn.plot.ly/plotly-2.14.0.min.js"), - tags$script(src = "custom_plotly.js") - ), - titlePanel("Correlation analysis"), - # Sidebar with a slider input for number of bins - sidebarLayout( - sidebarPanel( - tabsetPanel( - tabPanel( - "Input file", - fileInput("input_excel", "Excel containing the correlation data"), - fluidRow( - column( - 6, - uiOutput("tab1") - ), - column( - 6, - uiOutput("tab2") - ) - ), - # fluidrow for metadata tab - fluidRow( - column( - 6, - uiOutput("tab3") - ) - ), - fluidRow( - column( - 6, - uiOutput("Yaxis", inline = TRUE) - ), - column( - 6, - uiOutput("Xaxis", inline = TRUE) - ) - ), - actionButton("visualize", "Visualize the dataset"), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$div(tags$strong("Source code:")), - tags$a( - img(src = "bikc_github.png", width = "100px", alt = "Github"), - href = - "https://github.com/BiKC" - ) - ), - tabPanel( - "Plot settings", - switchInput("legacymode", "Legacy mode", value = FALSE), - sliderInput("dec", "Decimal places", 0, 3, 3, 1), - sliderInput( - "ncex", "Size of numbers in the plot", - 0.1, 10, 1.2, 0.1 - ), - # legacy settings - conditionalPanel( - condition = "input.legacymode==true", - sliderInput("clcex", "Size of colorscale numbers", 0.1, 10, 0.8, 0.1), - sliderInput( - "tlcex", "Size of text labels (row and column names)", - 0.1, 10, 0.8, 0.1 - ), - sliderInput( - "scale", "Scale of the plot (default 1=1000x1000)", - 0.5, 50, 1, 0.1 - ), - sliderInput( - "labelcex", "Size of the X/Y labels (combined plots)", - 1, 20, 3, 0.1 - ), - ), - # non-legacy settings - # checkbox for showing dendrograms - conditionalPanel( - condition = "input.legacymode==false", - # switchInput("add_title", "Add title", FALSE, size = "mini"), - conditionalPanel( - condition = "input.add_title==true", - textInput("title", "Title", "Correlation plot") - ), - h3("Single plot specific settings"), - switchInput("hide_colorbar", "Hide colorscale", TRUE, size = "mini"), - switchInput("dendrograms", "Show dendrograms", FALSE, size = "mini"), - switchInput("show_numbers", "Show numbers", TRUE, size = "mini"), - h3("Combined plot specific settings"), - switchInput("logscale", "Log scale", FALSE, size = "mini") - ), - selectInput("cmode", "Color mode", - c("sequential", "diverging"), - selected = "diverging" - ), - # Sequential colors - conditionalPanel( - condition = "input.cmode=='sequential'", - selectizeInput( - inputId = "sequentialcolor", - label = "Colorscale", - rev(c( - "Oranges", "Purples", "Reds", "Blues", "Greens", - "Greys", "OrRd", "YlOrRd", "YlOrBr", "YlGn" - )), - selected = "YlOrRd", - options = list(render = I( - '{ - option: function(item, escape) { - return "
" + escape(item.value) + "" - } - }' - )) - ) - ), - # Diverging colors - conditionalPanel( - condition = "input.cmode=='diverging'", - selectizeInput( - inputId = "divergentcolor", - label = "Colorscale", - rev(c("RdBu", "BrBG", "PiYG", "PRGn", "PuOr", "RdYlBu")), - selected = "RdBu", - options = list(render = I( - '{ - option: function(item, escape) { - return "
" + escape(item.value) + "" - } - }' - )) - ), - ), - ), - tabPanel( - "Download plots", - # Note to warn user that generating plots can take a while - h3("Note:"), - div("Generating plots can take a while. Please be patient."), - tags$br(), - # message displaying it only downloads non-legacy plots as html - div("Only non-legacy plots are downloaded as html. Legacy plots are to be downloaded by right-clicking on the plot and selecting 'Save image as...'"), - tags$br(), - # Download button - # download buttons for matrix 1, matrix 2, matrix 1 vs matrix 2 (ordered by 1) and matrix 1 vs matrix 2 (ordered by 2) - # show actionbuttons for downloading plots - actionBttn("action_download1", "Download matrix 1", icon("download")), tags$br(), - actionBttn("action_download2", "Download matrix 2", icon("download")), tags$br(), - actionBttn("action_download3", "Download matrix 1 vs matrix 2 (ordered by 1)", icon("download")), tags$br(), - actionBttn("action_download4", "Download matrix 1 vs matrix 2 (ordered by 2)", icon("download")), tags$br(), - bsAlert("alert"), - # hide download buttons in conditional panel with false condition - div(id = "downloadButtons", style = "height: 0px; overflow: hidden;", - downloadButton("download1", "Download matrix 1", icon("download")), - downloadButton("download2", "Download matrix 2", icon("download")), - downloadButton("download3", "Download matrix 1 vs matrix 2 (ordered by 1)", icon("download")), - downloadButton("download4", "Download matrix 1 vs matrix 2 (ordered by 2)", icon("download")), - ) - #downloadButton("download", "Download plots", icon("download"), disabled = TRUE), - ) - ) - ), - - # Show a plot of the generated distribution - mainPanel( - tabsetPanel( - id = "outputPanel", - tabPanel( - "Instructions", - div(id="myDiv"), - h3("Correlation analysis tool"), - div("The input should be provided in the form of an xlsx file. - The file should contain the data in the following format:"), - tags$table( - tags$tr( - tags$th(""), tags$th("bacteria1"), tags$th("bacteria2"), - tags$th("bacteria3"), tags$th("bacteria4"), tags$th("bacteria5") - ), - tags$tr( - tags$th("bacteria1"), tags$td("100"), tags$td("98.5"), - tags$td("97.5"), tags$td("96.5"), tags$td("95.5") - ), - tags$tr( - tags$th("bacteria2"), tags$td("98.5"), tags$td("100"), - tags$td("98.5"), tags$td("97.5"), tags$td("96.5") - ), - tags$tr( - tags$th("bacteria3"), tags$td("97.5"), tags$td("98.5"), - tags$td("100"), tags$td("98.5"), tags$td("97.5") - ), - tags$tr( - tags$th("bacteria4"), tags$td("96.5"), tags$td("97.5"), - tags$td("98.5"), tags$td("100"), tags$td("98.5") - ), - tags$tr( - tags$th("bacteria5"), tags$td("95.5"), tags$td("96.5"), - tags$td("97.5"), tags$td("98.5"), tags$td("100") - ) - ), - div( - strong("Note: "), - "The diagonal should always be 100 since this is the same thing you are comparing." - ), - div( - strong("Note: "), - "Row and column names are free to choose however you always need the same values in both. - Avoid spaces in these column and row names!" - ), - br(), - tags$ol( - tags$li("Upload the Excel file"), - tags$li("Select the sheets containing the data. Note that the second sheet is optional. If provided, you can compare two correlation matrixes from different sheets."), - tags$li("If two sheets are provided, you can change the labels for the X and Y axis for the combined plots. By default, the names of the sheets will be suggested."), - tags$li("click on \"Visualize the dataset\". This can take a few seconds depending on the size of the dataset."), - tags$li("To customize the plot, go to the tab \"Plot settings\" on the left and change the settings as you please.") - ), - br(), - # advanced information about metadata, hidden in a collapsible panel - bsCollapsePanel( - #id = "advanced_info", - # title of the panel, including a arrow symbol to indicate that it is collapsible - title = tags$span(tags$i(class = "fa fa-arrow-right"), " Advanced information"), - div( - strong("Note: "), - "The metadata should be provided in the same Excel file as the data but in a separate sheet. The sheet should contain the data in the following format:" - # first column contains a sample id with the same name as the columns from the data sheet, the other columns contain the metadata with a header describing the metadata - ), - tags$table( - tags$tr( - tags$th("sample"), tags$th("metadata1"), tags$th("metadata2"), - tags$th("...") - ), - tags$tr( - tags$th("bacteria1"), tags$td("value1"), tags$td("value2"), - tags$td("...") - ), - tags$tr( - tags$th("bacteria2"), tags$td("value1"), tags$td("value2"), - tags$td("...") - ), - tags$tr( - tags$th("bacteria3"), tags$td("value1"), tags$td("value2"), - tags$td("...") - ), - tags$tr( - tags$th("bacteria4"), tags$td("value1"), tags$td("value2"), - tags$td("...") - ), - tags$tr( - tags$th("bacteria5"), tags$td("value1"), tags$td("value2"), - tags$td("...") - ) - ), - div( - strong("Note: "), - "The first column should always contain the sample id. The name of this column is not important. The other columns can be named as you please." - ), - div( - strong("Note: "), - "The metadata sheet is optional. If you do not provide a metadata sheet, the plots will be generated without metadata." - ) - ), - actionButton("Samplefile", "Run the analysis on a sample file"), - downloadButton("downloadSampleFile", "Download the sample file") - ), - tabPanel( - title = "Matrix 1", - conditionalPanel( - condition = "input.legacymode==false", - plotlyOutput("ANI", width = "100%", height = "80vh") - ), - conditionalPanel( - condition = "input.legacymode==true", - plotOutput("ANI_legacy", width = "100%", height = "80vh") - ) - ), - tabPanel( - title = "Matrix 2", - conditionalPanel( - condition = "input.legacymode==false", - plotlyOutput("MALDI", width = "100%", height = "80vh") - ), - conditionalPanel( - condition = "input.legacymode==true", - plotOutput("MALDI_legacy", width = "100%", height = "80vh") - ) - ), - tabPanel( - title = "Matrix 1 vs Matrix 2 (ordered on matrix 1)", - htmlOutput("ANIMALDI_Error"), - conditionalPanel( - condition = "input.legacymode==false", - plotlyOutput("ANIMALDI", width = "100%", height = "80vh") - ), - conditionalPanel( - condition = "input.legacymode==true", - plotOutput("ANIMALDI_legacy", width = "100%", height = "80vh") - ) - ), - tabPanel( - title = "Matrix 1 vs Matrix 2 (ordered on matrix 2)", - htmlOutput("MALDIANI_Error"), - conditionalPanel( - condition = "input.legacymode==false", - plotlyOutput("MALDIANI", width = "100%", height = "80vh") - ), - conditionalPanel( - condition = "input.legacymode==true", - plotOutput("MALDIANI_legacy", width = "100%", height = "80vh") - ) - ) - ) - ) - ) -) +# MAniR: matrix comparison and scalable visualization. +manir_guide <- function(lead, details = NULL) { + # Help stays one short line until opened, leaving the visualization visible. + preview <- strsplit(lead, "[.!?]")[[1L]][1L] + if (nchar(preview) > 108L) preview <- paste0(substr(preview, 1L, 105L), "...") + shiny::tags$details(class = "reading-guide", + shiny::tags$summary(shiny::strong("How to read this"), + shiny::span(class = "guide-preview", preview)), + shiny::div(class = "guide-body", + shiny::p(lead), + if (!is.null(details)) + shiny::tagList(shiny::strong("Further interpretation"), shiny::p(details)) + ) + ) +} +ui <- shiny::fluidPage( + shiny::tags$head( + shiny::tags$meta(name = "viewport", content = "width=device-width, initial-scale=1"), + shiny::tags$style(shiny::HTML(" + body { background: #f7f9fb; color: #213547; } + .well { background: #fff; border-color: #dae2ea; } + .main-panel { background: #fff; padding: 18px; border: 1px solid #dae2ea; + border-radius: 8px; } + .small-help { color: #56697a; font-size: .9em; margin-bottom: 10px; } + .plot-area { min-height: 520px; } + .metric { padding: 10px; margin: 6px 0; background: #f2f6f9; + border-left: 3px solid #487f9b; } + .tab-content { padding-top: 15px; } + .reading-guide { border-left: 3px solid #3c7494; background: #eef5fa; + padding: 12px 16px; margin: 12px 0 20px; color: #234257; + line-height: 1.45; border-radius: 4px; } + .reading-guide p { margin: 6px 0 0; } + .reading-guide details { margin-top: 8px; } + .reading-guide summary { cursor: pointer; font-weight: 600; } + .reading-guide details p { margin-top: 8px; max-width: 88ch; } + .metadata-key { display: flex; flex-wrap: wrap; align-items: center; + gap: 7px 16px; margin: 8px 0 3px; font-size: 13px; } + .metadata-key .swatch { display: inline-block; width: 15px; height: 13px; + border-radius: 2px; margin-right: 5px; + vertical-align: middle; } + .metadata-key .key-title { font-weight: 600; color: #29465c; } + .section-note { margin: 13px 0 8px; color: #3b5668; } + .results-table { margin: 12px 0 20px; } + .main-panel .btn { margin: 7px 7px 7px 0; } + ")), + shiny::tags$link(rel = "stylesheet", type = "text/css", + href = "workspace.css") + ), + shiny::div(class = "app-header", + shiny::h2("MAniR"), + shiny::span(class = "app-description", + "Compare pairwise similarities, correlations and distances") + ), + shiny::div(class = "workspace", + shiny::sidebarLayout( + shiny::sidebarPanel(width = 3, + shiny::div(class = "control-sidebar", + shiny::div(class = "sidebar-scroll", + shiny::div(class = "example-quick", + shiny::h4("Try MAniR with example data"), + shiny::p("12 synthetic isolates with ANI-like, MALDI-like and metadata matrices."), + shiny::actionButton("load_example", "Load example", class = "btn-primary"), + shiny::tags$details( + shiny::tags$summary("About the example / download"), + shiny::p("Synthetic demonstration data, not measured biological values."), + shiny::downloadButton("download_example", "Example workbook (.xlsx)") + ) + ), + shiny::tags$details(class = "control-group", open = "open", + shiny::tags$summary("Upload matrices"), + shiny::div(class = "group-body", + shiny::fileInput("first_file", "Matrix 1", + accept = c(".xlsx", ".xlsm", ".csv", ".tsv", ".txt", ".gz", ".rds")), + shiny::uiOutput("first_sheet_ui"), + shiny::fileInput("second_file", "Matrix 2 (optional)", + accept = c(".xlsx", ".xlsm", ".csv", ".tsv", ".gz", ".rds")), + shiny::uiOutput("second_sheet_ui"), + shiny::fileInput("metadata_file", "Metadata (optional)", + accept = c(".xlsx", ".csv", ".tsv", ".rds")), + shiny::uiOutput("metadata_sheet_ui"), + shiny::textInput("label1", "Short name for matrix 1", value = "Matrix 1", + placeholder = "e.g. ANI from WGS"), + shiny::textInput("label2", "Short name for matrix 2", value = "Matrix 2", + placeholder = "e.g. MALDI spectral similarity"), + shiny::fileInput("order_file", "Sample order (optional)", + accept = c(".txt", ".csv", ".tsv")), + shiny::selectInput("kind1", "Matrix 1 represents", + choices = c("Similarity" = "similarity", "Correlation" = "correlation", + "Distance" = "distance", "Unspecified" = "auto")), + shiny::selectInput("kind2", "Matrix 2 represents", + choices = c("Similarity" = "similarity", "Correlation" = "correlation", + "Distance" = "distance", "Unspecified" = "auto")), + shiny::radioButtons("match_mode", "Compare samples", + choices = c("Identical IDs" = "strict", + "Shared isolates" = "intersection"), + selected = "strict"), + shiny::p(class = "small-help", + "Similarity: larger means closer. Distance: smaller means closer. Correlation is between -1 and 1.") + ) + ), + shiny::tags$details(class = "control-group", + shiny::tags$summary("Analysis settings"), + shiny::div(class = "group-body", + shiny::checkboxInput("cluster", "Cluster samples on load", value = TRUE), + shiny::selectInput("linkage", "Clustering linkage", + choices = c("Complete (original default)" = "complete", + "Average" = "average", "Single" = "single", + "Ward D2" = "ward.D2"), selected = "complete"), + shiny::checkboxInput("comparable_scales", + "Same measurement and units in both matrices", value = FALSE), + shiny::p(class = "small-help", + "Only enable raw differences when measurements are directly comparable. ANI percentages and MALDI scores are different quantities."), + shiny::numericInput("permutations", "Mantel permutations", + 999L, min = 99L, max = 9999L), + shiny::p(class = "small-help", + "Changing the matrix types, linkage, matching rule or clustering requires loading again. Display controls on the right update immediately.") + ) + ) + ), + shiny::div(class = "sidebar-footer", + shiny::actionButton("visualize", "Load and analyze uploaded files", + class = "btn-primary"), + shiny::uiOutput("sidebar_status") + ) + ) + ), + shiny::mainPanel(width = 9, + shiny::div(class = "main-panel", + shiny::div(class = "results-toolbar", + shiny::conditionalPanel( + condition = "input.results_tab === 'Heatmaps'", + shiny::div(class = "toolbar-field", + shiny::selectInput("palette", "Colors", + choices = c("RdBu", "BrBG", "PiYG", "PRGn", "PuOr", "RdYlBu", + "Viridis", "YlOrRd", "Blues", "Greens", "Greys"), + selected = "RdBu") + ) + ), + shiny::div(class = "toolbar-field", + shiny::selectInput("metadata_column", "Group / annotation", + choices = c("None" = "")) + ), + shiny::conditionalPanel( + condition = "input.results_tab === 'Heatmaps'", + shiny::div(class = "toolbar-field control-checkbox", + shiny::checkboxInput("show_numbers", "Show cell values", value = FALSE) + ) + ), + shiny::conditionalPanel( + condition = "input.results_tab === 'Pairwise comparison'", + shiny::div(class = "toolbar-field contextual pair-limit", + shiny::numericInput("max_pairs", "Max pairs", + 100000L, min = 1000L, max = 1000000L, step = 1000L) + ) + ), + shiny::conditionalPanel( + condition = "input.results_tab === 'Cluster comparison'", + shiny::div(class = "toolbar-field contextual", + shiny::numericInput("cluster_k", "Clusters (k)", + 3L, min = 2L, max = 100L) + ) + ), + shiny::conditionalPanel( + condition = "input.results_tab === 'Overview'", + shiny::div(class = "toolbar-field control-checkbox", + shiny::actionButton("run_mantel", "Run Mantel test", + class = "btn-default btn-sm") + ) + ), + shiny::conditionalPanel( + condition = "input.results_tab === 'Heatmaps'", + shiny::tags$details(class = "toolbar-more", + shiny::tags$summary("Display options"), + shiny::div(class = "toolbar-extra", + shiny::div(class = "toolbar-field control-checkbox", + shiny::checkboxInput("log_scale", "Log(1+x) color scaling", + value = FALSE) + ), + shiny::div(class = "toolbar-field control-checkbox", + shiny::checkboxInput("zoom_enabled", "Zoom into large matrices", + value = FALSE) + ), + shiny::conditionalPanel( + condition = "input.zoom_enabled", + shiny::div(class = "toolbar-field", + shiny::numericInput("zoom_start", "First isolate", + 1L, min = 1L, step = 1L) + ), + shiny::div(class = "toolbar-field", + shiny::numericInput("zoom_size", "Number of isolates", + 300L, min = 10L, max = 1000L, step = 50L) + ) + ) + ) + ) + ), + shiny::div(class = "toolbar-status", + shiny::uiOutput("active_analysis") + ) + ), + shiny::uiOutput("research_context"), + shiny::div(class = "results-shell", + shiny::tabsetPanel(id = "results_tab", + shiny::tabPanel("Start here", manir_research_start()), + shiny::tabPanel("Overview", + manir_guide( + "Start with the number of shared isolates and the relationship between the two matrices. Correlations show whether pairs that are high in one measurement also tend to be high in the other; they do not establish equivalence.", + "Pearson's r summarizes a linear relationship. Spearman's rho compares ranks and can detect a monotonic relationship on different scales. The same isolate appears in several pairs, so ordinary independent-observation p-values would be inappropriate. Use the optional Mantel permutation test for matrix association."), + shiny::uiOutput("overview"), + shiny::uiOutput("overview_insight"), + shiny::h4("Association between matrices"), + shiny::tableOutput("agreement"), + shiny::actionButton("overview_open_pairs", + "Inspect the pairs behind these numbers", class = "btn-default"), + shiny::uiOutput("mantel_note"), + shiny::verbatimTextOutput("mantel_result"), + shiny::h4("Within- and between-group values"), + shiny::p(class = "small-help", + "Select a metadata category in the sidebar to describe how the first matrix differs within and between those groups. These are descriptive pairwise summaries, not an independent-sample test."), + shiny::tableOutput("replicate_table")), + shiny::tabPanel("Heatmaps", + shiny::div(class = "matrix-nav", + shiny::tabsetPanel(id = "matrix_view", type = "pills", + shiny::tabPanel("Matrix 1", + manir_guide( + "Every cell compares the isolate named on its row with the isolate named on its column. The diagonal compares an isolate with itself. Larger values mean more similar samples only for similarity and positive-correlation measurements.", + "Clustering puts isolates with related measurements next to each other; it does not change the values. The color bar shows a 0–1 display scale based on the data range, not necessarily the original numerical units. Hover over a cell for its original value. Metadata colors identify categories, not measured similarity."), + shiny::uiOutput("plot1_intro"), shiny::uiOutput("plot1_legend"), + shiny::uiOutput("plot1_ui"), shiny::verbatimTextOutput("plot1_cell")), + shiny::tabPanel("Matrix 2", + manir_guide( + "Read this matrix in the same way as matrix 1. Its clustering order can differ, and the display colors are scaled to this matrix's own numerical range.", + "Equal colors across the separate Matrix 1 and Matrix 2 plots do not imply equal biological measurements. Hover over any cell for the exact original value. Choose the same metadata track to see whether visual clusters correspond to the same sample categories."), + shiny::uiOutput("plot2_intro"), shiny::uiOutput("plot2_legend"), + shiny::uiOutput("plot2_ui"), shiny::verbatimTextOutput("plot2_cell")), + shiny::tabPanel("Combined (order 1)", + manir_guide( + "This split heatmap places matrix 1 above the diagonal and matrix 2 below it. Both triangles use the ordering calculated from matrix 1, so the same pair can be inspected in both methods.", + "Each triangle is normalized independently for display. Comparing the position of clusters is meaningful; directly comparing two color shades or subtracting their display values is not. The diagonal is displayed with a neutral midpoint color because it separates the two methods, not because its original measurements equal 0.5."), + shiny::uiOutput("combined1_intro"), shiny::uiOutput("combined1_legend"), + shiny::uiOutput("combined1_ui"), shiny::verbatimTextOutput("combined1_cell")), + shiny::tabPanel("Combined (order 2)", + manir_guide( + "The same split comparison, now ordered using matrix 2. The upper triangle is matrix 2 and the lower triangle is matrix 1.", + "Switch between both combined tabs to see how each method's ordering groups isolates. Triangle colors remain independently scaled and the diagonal is a visual separator. Inspect original values in the cell hover rather than using color as a shared measurement."), + shiny::uiOutput("combined2_intro"), shiny::uiOutput("combined2_legend"), + shiny::uiOutput("combined2_ui"), shiny::verbatimTextOutput("combined2_cell")), + shiny::tabPanel("Difference", + manir_guide( + "This tab calculates matrix 1 minus matrix 2 for each shared isolate pair. Zero is the midpoint of the diverging color scale; opposite sides represent opposite signs.", + "A difference is interpretable only when both matrices measure the same quantity in the same units and have compatible preprocessing. Two different measurement types, such as ANI percentages and MALDI spectral scores, should be examined with rank comparisons instead."), + shiny::uiOutput("difference_explainer"), shiny::uiOutput("difference_ui"), + shiny::verbatimTextOutput("difference_cell")) + ) + ) + ), + shiny::tabPanel("Pairwise comparison", + manir_guide( + "Each dot is one distinct, unordered isolate pair. Its X position is the pair's value in matrix 1 and its Y position is the value for the same pair in matrix 2. Neither the diagonal nor mirrored duplicates are counted.", + "An upward pattern suggests positive association, while points far from the main pattern merit closer inspection. Different units are allowed here: compare ranks or correlations, not the raw distance from a one-to-one line. Pairwise observations share isolates, so they are not statistically independent."), + shiny::uiOutput("pairwise_intro"), + shiny::div(class = "pair-focus", + shiny::h4("Inspect a specific isolate pair"), + shiny::p(class = "small-help", + "Pick any two shared isolates to inspect exact values in both matrices, or choose one of the pairs with the largest rank differences."), + shiny::uiOutput("top_pairs_picker"), + shiny::div(class = "pair-selectors", + shiny::selectizeInput("inspect_isolate", "First isolate", + choices = NULL, options = list(placeholder = "Search isolate...")), + shiny::selectizeInput("inspect_partner", "Second isolate", + choices = NULL, options = list(placeholder = "Search second isolate...")) + ), + shiny::uiOutput("pair_inspection") + ), + shiny::div(class = "plot-frame", + shiny::plotOutput("scatter", height = "100%") + ), + shiny::h4("Pairs with the largest rank differences"), + shiny::p(class = "small-help", + "These are exploratory discrepancies in the relative ordering of pairs, not statistically significant outliers. A rank gap near 0 means the pair has a similar position among all evaluated pairs in both matrices. Orange rings mark up to five of these pairs in the scatterplot."), + shiny::tableOutput("rank_gaps"), + shiny::uiOutput("absolute_discrepancies_intro"), + shiny::tableOutput("discrepancies"), + shiny::downloadButton("download_pairs", "Download pairwise values (CSV)")), + shiny::tabPanel("Cluster comparison", + manir_guide( + "Each matrix is independently clustered and cut into the same chosen number of groups (k). The statistics compare which isolate pairs are grouped together, regardless of the arbitrary cluster numbers.", + "Adjusted Rand index (ARI) equals 1 for identical partitions and is near 0 for chance-level agreement under its adjustment model. Adjusted Wallace is directional: matrix 1 to matrix 2 asks whether pairs grouped together in the first remain together in the second, adjusted for chance. Reverse the direction for the other value. These numbers describe agreement, not biological accuracy or a probability that either method is correct."), + shiny::uiOutput("cluster_intro"), + shiny::uiOutput("cluster_insight"), + shiny::tableOutput("cluster_summary"), + shiny::h4("How the clusters overlap"), + shiny::tableOutput("cluster_overlap"), + shiny::h4("Cluster membership by isolate"), + shiny::p(class = "small-help", + "Cluster numbers are arbitrary. Cluster 1 from one matrix is not necessarily the same group as cluster 1 from the other."), + shiny::tableOutput("cluster_table"), + shiny::downloadButton("download_clusters", "Download cluster assignments")), + shiny::tabPanel("Metadata", + manir_guide( + "Metadata describe each isolate, such as its group, specimen source or experimental batch. Select a categorical field in the sidebar to show a colored annotation track next to the heatmaps.", + "Metadata categories are not automatically cluster labels or validation truth. A batch-associated cluster may reflect an experimental effect and needs separate investigation. Numeric metadata should not be interpreted as categories unless intentionally converted."), + shiny::uiOutput("metadata_group_status"), + shiny::tableOutput("group_overview"), + shiny::uiOutput("group_plot_ui"), + shiny::h4("Sample metadata"), + shiny::tableOutput("metadata_preview"), + shiny::uiOutput("metadata_note")), + shiny::tabPanel("Export", + manir_guide( + "CSV and RDS preserve the original matrix values. PNG, PDF, SVG and interactive HTML preserve the displayed ordering and palette, but figure colors may be normalized or raster-sampled.", + "Plots from large datasets are representative previews, not complete value tables. Export the CSV or RDS alongside your figures and save the settings manifest to record clustering, color mapping, pair sampling and your R environment."), + shiny::h4("Research notebook"), + shiny::p(class = "small-help", + "Save an editable Markdown summary of the dataset and your selected analyses. It is a starting point for your own interpretation, not an automatic scientific conclusion."), + shiny::textInput("research_question", "Your research question (optional)", + placeholder = "e.g. Do MALDI-TOF similarities reflect ANI relationships?"), + shiny::textAreaInput("research_notes", "Your observations and next steps", + placeholder = "What do you notice? Which pairs need follow-up? What are the limitations?", + rows = 3, width = "100%"), + shiny::checkboxInput("report_clusters", + "Include cluster statistics (calculate if needed; at most 2,000 isolates)", + value = FALSE), + shiny::downloadButton("download_research_summary", "Download research notes (.md)", + class = "btn-primary"), + shiny::hr(), + shiny::uiOutput("difference_download_notice"), + shiny::downloadButton("download_first", "Matrix 1 CSV"), + shiny::downloadButton("download_second", "Matrix 2 CSV"), + shiny::downloadButton("download_rds", "Analysis matrices (RDS)"), + shiny::downloadButton("download_first_png", "Matrix 1 PNG"), + shiny::downloadButton("download_pdf", "Matrix 1 PDF"), + shiny::downloadButton("download_svg", "Matrix 1 SVG"), + shiny::downloadButton("download_html", "Interactive HTML preview"), + shiny::downloadButton("download_combined_png", "Combined PNG"), + shiny::uiOutput("download_difference_ui"), + shiny::downloadButton("download_settings", "Analysis settings (text)") + ) + ) + ) + ) + ) + ) + ) +) diff --git a/www/custom_plotly.js b/www/custom_plotly.js deleted file mode 100644 index 0487ba3..0000000 --- a/www/custom_plotly.js +++ /dev/null @@ -1,21 +0,0 @@ -const createPlotly = function(message) { - // message is an array where first element is the data and second is the metadata - let data = [{ - z: message[0], - type: 'heatmap', - colorscale: 'Viridis', - showscale: true, - colorbar: { - title: 'Colorbar Title' - }, - xgap: 1, - ygap: 1, - hovertemplate: 'Value: %{z}
Row: %{y}
Column: %{x}' - }]; - Plotly.newPlot('myDiv', data); -}; - -// custom message handler from shiny -Shiny.addCustomMessageHandler('first_correlation_matrix', function(message) { - createPlotly(message); -}); \ No newline at end of file diff --git a/www/workspace.css b/www/workspace.css new file mode 100644 index 0000000..03178d4 --- /dev/null +++ b/www/workspace.css @@ -0,0 +1,271 @@ + +/* Desktop analysis workspace: independent control and result scrolling. + * Mobile and short windows use the normal document flow instead. */ +:root { + --manir-ink: #203c50; + --manir-muted: #657b8e; + --manir-border: #dbe6ec; + --manir-brand: #176a86; + --manir-bg: #f2f6f8; +} +body { background: var(--manir-bg); color: var(--manir-ink); } +.container-fluid { padding-left: 18px; padding-right: 18px; } +.app-header { + display: flex; align-items: center; gap: 16px; + min-height: 73px; padding: 12px 3px 14px; flex-wrap: wrap; +} +.app-header h2 { font-size: 26px; font-weight: 650; letter-spacing: -.025em; margin: 0; } +.app-header .app-description { font-size: 13px; color: var(--manir-muted); } +.workspace { min-height: 0; flex: 1 1 auto; } +.workspace > .row { height: 100%; display: flex; flex-wrap: nowrap; } +.workspace > .row > .col-sm-3, .workspace > .row > .col-sm-9 { + min-width: 0; display: flex; flex-direction: column; float: none; +} +.workspace > .row > .col-sm-3 { width: 26%; } +.workspace > .row > .col-sm-9 { width: 74%; } +.workspace .well { + min-height: 0; flex: 1 1 auto; + padding: 0; margin-bottom: 0; background: white; + border: 1px solid var(--manir-border); + box-shadow: none; border-radius: 10px; + overflow: hidden; +} +.control-sidebar { + display: flex; flex-direction: column; height: 100%; min-height: 0; +} +.sidebar-scroll { + flex: 1 1 auto; min-height: 0; overflow-y: auto; + overscroll-behavior: contain; padding: 14px 16px 24px; + scrollbar-color: #b7cbd5 transparent; +} +.sidebar-scroll h4 { margin: 4px 0 8px; font-size: 15px; font-weight: 650; } +.example-quick { + border-radius: 8px; padding: 12px; background: #eef6f9; + margin-bottom: 13px; border: 1px solid #d4e6ef; +} +.example-quick .btn-primary { background: var(--manir-brand); border-color: var(--manir-brand); } +.example-quick p { font-size: 12px; line-height: 1.45; margin: 4px 0 10px; color: #4e6679; } +.example-quick details { margin: 8px 0 0; font-size: 12px; } +.example-quick details summary { cursor: pointer; color: #315770; } +.control-group { + border: 1px solid var(--manir-border); border-radius: 8px; + background: #fff; margin-bottom: 10px; +} +.control-group > summary { + list-style-position: inside; padding: 11px 12px; + font-weight: 650; color: #29485d; cursor: pointer; + background: #f8fbfc; border-radius: 8px; +} +.control-group[open] > summary { border-bottom: 1px solid var(--manir-border); border-radius: 8px 8px 0 0; } +.control-group > .group-body { padding: 12px 12px 2px; } +.group-body .form-group { margin-bottom: 12px; } +.group-body label { font-size: 12px; } +.group-body .small-help { font-size: 11px; margin: 4px 0 12px; } +.sidebar-footer { + background: #fff; flex: 0 0 auto; + padding: 11px 16px 12px; border-top: 1px solid var(--manir-border); + box-shadow: 0 -3px 14px rgba(19, 54, 74, .035); +} +.sidebar-footer .btn { display: block; width: 100%; font-weight: 650; margin: 0; } +.sidebar-footer .load-status { display: block; color: var(--manir-muted); font-size: 11px; margin-top: 6px; } +.workspace .main-panel { + flex: 1 1 auto; min-height: 0; overflow: hidden; + display: flex; flex-direction: column; + padding: 0; border: 1px solid var(--manir-border); + border-radius: 10px; box-shadow: none; background: #fff; +} +.results-toolbar { + flex: 0 0 auto; padding: 10px 17px 7px; + display: flex; align-items: flex-start; flex-wrap: wrap; + column-gap: 18px; row-gap: 6px; border-bottom: 1px solid var(--manir-border); + background: #fcfefe; +} +.toolbar-field { min-width: 120px; max-width: 220px; } +.toolbar-field .form-group, .toolbar-field .shiny-input-container { margin-bottom: 0; width: 100%; } +.toolbar-field label { font-size: 11px; font-weight: 650; margin-bottom: 3px; color: #466376; } +.toolbar-field .form-control { height: 31px; font-size: 12px; padding: 3px 8px; } +.toolbar-field.control-checkbox { align-self: center; min-width: auto; padding-top: 11px; } +.toolbar-field.control-checkbox label { font-weight: 500; font-size: 12px; white-space: nowrap; } +.toolbar-field.control-checkbox .checkbox { margin: 0; } +.toolbar-more { margin-top: 5px; flex: 0 0 auto; align-self: center; font-size: 12px; } +.toolbar-more summary { cursor: pointer; color: var(--manir-brand); padding: 6px; } +.toolbar-more[open] { width: 100%; } +.toolbar-extra { display: flex; flex-wrap: wrap; align-items: end; gap: 6px 16px; padding: 8px 0; } +.toolbar-extra .shiny-input-container { width: 138px; margin-bottom: 0; } +.toolbar-status { + flex: 1 1 200px; margin-left: auto; align-self: center; + text-align: right; max-width: 400px; + color: var(--manir-muted); +} +.toolbar-status p { font-size: 11px; line-height: 1.3; margin: 0; } +.toolbar-field.contextual { align-self: center; } +.toolbar-field.contextual .shiny-input-container { width: 94px; } +.results-shell { min-height: 0; flex: 1 1 auto; display: flex; flex-direction: column; } +.results-shell > .tabbable { display: flex; flex-direction: column; flex: 1 1 auto; min-height: 0; } +.results-shell .nav-tabs { + flex: 0 0 auto; padding: 0 15px; + display: flex; flex-wrap: nowrap; overflow-x: auto; overflow-y: hidden; + border-bottom: 1px solid var(--manir-border); scrollbar-width: thin; +} +.results-shell .nav-tabs > li { float: none; flex: 0 0 auto; } +.results-shell .nav-tabs > li > a { margin-right: 1px; padding: 11px 12px; font-size: 12px; white-space: nowrap; } +.results-shell .tab-content { + flex: 1 1 auto; min-height: 0; overflow-y: auto; + overscroll-behavior: contain; + padding: 8px 20px 24px; +} +.results-shell .tab-pane { max-width: 100%; } +/* Five matrix views share a single primary tab to keep navigation short. */ +.results-shell .matrix-nav > .tabbable { display: block; } +.results-shell .matrix-nav .nav-pills { + display: flex; flex-wrap: nowrap; gap: 3px; overflow-x: auto; + border-bottom: 1px solid var(--manir-border); padding: 0 0 9px; + margin-bottom: 8px; scrollbar-width: thin; +} +.results-shell .matrix-nav .nav-pills > li { + float: none; flex: 0 0 auto; margin: 0; +} +.results-shell .matrix-nav .nav-pills > li > a { + border: 1px solid var(--manir-border); border-radius: 6px; + background: #f8fbfc; color: #3c6076; font-size: 12px; + padding: 7px 11px; margin: 0; +} +.results-shell .matrix-nav .nav-pills > li.active > a { + border-color: #bfd6e1; background: #e9f4f9; color: #185c79; font-weight: 650; +} +.results-shell .matrix-nav .tab-content { + overflow: visible; flex: none; min-height: auto; padding: 0; +} +.matrix-nav .plot-frame { height: clamp(395px, calc(100dvh - 355px), 850px); } +.pair-limit .shiny-input-container { width: 150px !important; } + +.results-shell .reading-guide { + background: #f3f8fb; border: 1px solid #dae7ee; + border-left: 3px solid #52859e; border-radius: 5px; + padding: 0; margin: 5px 0 12px; +} +.results-shell .reading-guide > summary { + cursor: pointer; list-style-position: inside; color: #385c72; + font-size: 12px; padding: 8px 11px; user-select: none; +} +.results-shell .reading-guide > summary .guide-preview { font-weight: normal; color: var(--manir-muted); margin-left: 7px; } +.results-shell .reading-guide > .guide-body { padding: 3px 13px 12px; font-size: 12px; line-height: 1.5; max-width: 100ch; } +.results-shell .reading-guide > .guide-body p { margin: 2px 0 8px; } +.results-shell .section-note { margin: 8px 0; font-size: 12px; } +.results-shell .metadata-key { margin: 5px 0; } +.results-shell .results-table { margin: 10px 0; } +.results-shell h4 { font-size: 16px; margin: 14px 0 9px; } +.plot-frame { height: clamp(400px, calc(100dvh - 310px), 900px); width: 100%; min-width: 0; } +.plot-frame .shiny-plot-output, .plot-frame .plotly { + height: 100% !important; min-height: 0; width: 100%; +} +.results-shell .tab-content .btn { margin: 5px 8px 6px 0; } +@media (min-width: 992px) and (min-height: 580px) { + html, body { height: 100%; overflow: hidden; } + body > .container-fluid { + height: 100dvh; min-height: 0; display: flex; flex-direction: column; overflow: hidden; + } +} +@media (max-width: 991px), (max-height: 579px) { + html, body { height: auto; overflow: auto; } + .app-header { min-height: 54px; } + .workspace > .row { display: block; height: auto; } + .workspace > .row > .col-sm-3, .workspace > .row > .col-sm-9 { + display: block; width: 100%; float: none; padding-left: 0; padding-right: 0; + } + .workspace .well { margin-bottom: 12px; overflow: visible; height: auto; } + .control-sidebar { height: auto; } + .sidebar-scroll { overflow: visible; } + .sidebar-footer { position: sticky; bottom: 0; z-index: 40; border-radius: 0 0 8px 8px; } + .workspace .main-panel { overflow: visible; } + .results-shell > .tabbable { display: block; } + .results-shell .tab-content { overflow: visible; } + .plot-frame, .matrix-nav .plot-frame { height: min(68vh, 700px); min-height: 380px; } + .toolbar-status { text-align: left; max-width: none; } +} +@media (max-width: 600px) { + .container-fluid { padding-left: 10px; padding-right: 10px; } + .app-description { display: none; } + .results-toolbar { padding: 9px; gap: 8px; } + .toolbar-status { flex-basis: 100%; margin: 0; } + .results-shell .tab-content { padding: 8px 10px 18px; } + .results-shell .reading-guide .guide-preview { display: none; } +} + + +/* Research-question-first workspace. All panels scroll inside the existing + * result area, with no extra page-level scrollbar on ordinary desktops. */ +.start-hero { padding: 10px 0 6px; max-width: 840px; } +.start-kicker { color: #45758c; font-size: 11px; font-weight: 750; + text-transform: uppercase; letter-spacing: .12em; } +.start-hero h3 { margin: 4px 0 7px; font-size: 23px; font-weight: 680; + letter-spacing: -.025em; } +.start-hero p { font-size: 13px; max-width: 85ch; color: #597083; } +.start-status { border-radius: 8px; border: 1px solid #d7e3e9; + padding: 13px 16px; margin: 7px 0 15px; + max-width: 100%; } +.start-status.ready { background: #f0f8f7; border-color: #c6e1d9; } +.start-status.empty { background: #f4f7fa; } +.start-status strong { font-size: 14px; color: #254960; } +.start-status p { font-size: 12px; margin: 6px 0 0; color: #5d7584; } +.start-facts { display: flex; gap: 8px 18px; flex-wrap: wrap; margin-top: 9px; } +.start-facts span { font-size: 12px; line-height: 1.4; border-radius: 5px; + background: white; padding: 5px 9px; + border: 1px solid #e0e9e7; } +.question-grid { display: grid; grid-template-columns: repeat(2, minmax(250px, 1fr)); + gap: 12px; padding: 2px 1px 12px; max-width: 1140px; } +.question-card { border: 1px solid #dce6ec; border-radius: 9px; + background: #fff; padding: 14px 16px; + display: flex; flex-direction: column; min-width: 0; + transition: border-color .12s, box-shadow .12s; } +.question-card:hover { border-color: #a7c6d3; box-shadow: 0 2px 9px rgba(36, 79, 103, .08); } +.question-top { display: flex; flex-wrap: wrap; align-items: start; + justify-content: space-between; gap: 6px; } +.question-card h4 { font-size: 16px; font-weight: 650; margin: 0 0 8px; max-width: 33ch; } +.question-requirement { font-size: 10px; border-radius: 10px; + padding: 3px 7px; color: #466b7d; background: #edf4f8; + white-space: nowrap; } +.question-card p { font-size: 12px; color: #50697b; margin: 0 0 9px; } +.question-card .question-next { margin-top: auto; font-size: 11px; + color: #627e8f; padding: 5px 0; } +.question-card .btn { margin-top: 5px; margin-bottom: 0; + align-self: flex-start; font-size: 12px; } +.start-footer { border-top: 1px solid var(--manir-border); margin: 6px 0 20px; + padding: 14px 0 0; font-size: 12px; max-width: 850px; } +.start-footer p { margin: 5px 0 8px; color: #607b8e; } +.start-footer .btn { font-size: 12px; } +.research-context { display: flex; align-items: center; gap: 8px 16px; + flex-wrap: wrap; background: #eef7fa; + padding: 7px 18px; border-bottom: 1px solid #d4e8ed; + font-size: 12px; flex: 0 0 auto; } +.research-context strong { color: #315771; font-size: 12px; } +.research-context span { color: #5e798c; flex: 1 1 230px; } +.research-context .btn { margin: 0; padding: 2px 7px; } +.data-indicator { font-weight: 600; color: #37647e; font-size: 11px; } +.settings-warning { display: block; color: #975e13; font-size: 11px; } +.pair-focus { padding: 12px 15px; background: #f4f8fa; + border: 1px solid #d7e7ec; border-radius: 8px; margin: 12px 0; } +.pair-focus h4 { font-size: 15px; margin: 1px 0 6px; } +.pair-focus p { margin-bottom: 7px; } +.pair-focus .shiny-input-container { margin-bottom: 6px; } +.pair-selectors { display: flex; flex-wrap: wrap; gap: 8px 14px; + margin: 6px 0 9px; } +.pair-selectors > .form-group { flex: 1 1 180px; max-width: 310px; } +.pair-selectors > .form-group label { font-size: 11px; } +.pair-inspection-values { display: flex; align-items: center; flex-wrap: wrap; + gap: 8px 20px; padding-top: 7px; + border-top: 1px solid #d9e8ed; } +.pair-inspection-values > div { display: flex; flex-direction: column; } +.pair-inspection-values > div > span { color: #627d8f; font-size: 11px; } +.pair-inspection-values > div > strong { color: #1f536d; font-size: 19px; } +.pair-inspection-values p { flex-basis: 100%; font-size: 11px; margin: 0; } +.pair-inspection-values .pair-annotation { color: #385f78; } +@media (max-width: 1240px) { + .question-grid { grid-template-columns: repeat(2, minmax(210px, 1fr)); } + .question-card { padding: 12px; } +} +@media (max-width: 800px) { + .question-grid { grid-template-columns: 1fr; } + .pair-selectors > .form-group { max-width: none; } + .start-hero h3 { font-size: 20px; } +}