diff --git a/.github/workflows/docker-image.yml b/.github/workflows/docker-image.yml index d1fed02..df5d6e0 100644 --- a/.github/workflows/docker-image.yml +++ b/.github/workflows/docker-image.yml @@ -7,27 +7,58 @@ on: branches: [ "main", "master" ] jobs: - build: + build-and-push: runs-on: ubuntu-latest + strategy: + fail-fast: false + matrix: + include: + - image_repo: sigrepo-mysql + context: mysql + dockerfile: mysql/Dockerfile + build_args: | + mysql_image=mysql:8.0-bookworm + tags_extra: "" + - image_repo: sigrepo-api + context: . + dockerfile: Dockerfile + build_args: | + R_VERSION=4.4.3 + SIGREPO_BRANCH=master + tags_extra: | + ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo-shiny:latest + ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo-shiny:${{ github.sha }} + ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo:latest + ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo:${{ github.sha }} steps: - name: Checkout repository uses: actions/checkout@v4 + - name: Set up QEMU + uses: docker/setup-qemu-action@v3 + - name: Set up Docker Buildx uses: docker/setup-buildx-action@v3 - name: Log in to Docker Hub + if: github.event_name == 'push' uses: docker/login-action@v3 with: username: ${{ secrets.DOCKERHUB_USERNAME }} password: ${{ secrets.DOCKERHUB_TOKEN }} - - name: Build and push Docker image + - name: Build and push ${{ matrix.image_repo }} uses: docker/build-push-action@v5 with: - context: . - push: true + context: ${{ matrix.context }} + file: ${{ matrix.dockerfile }} + build-args: ${{ matrix.build_args }} + platforms: linux/amd64,linux/arm64 + push: ${{ github.event_name == 'push' }} tags: | - ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo:latest - ${{ secrets.DOCKERHUB_USERNAME }}/sigrepo:${{ github.sha }} + ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.image_repo }}:latest + ${{ secrets.DOCKERHUB_USERNAME }}/${{ matrix.image_repo }}:${{ github.sha }} + ${{ matrix.tags_extra }} + cache-from: type=gha + cache-to: type=gha,mode=max diff --git a/Dockerfile b/Dockerfile index e7d7648..346579f 100755 --- a/Dockerfile +++ b/Dockerfile @@ -1,11 +1,11 @@ # Build according to a specified version of R ARG R_VERSION -ARG R_VERSION=${R_VERSION:-4.5.0} +ARG R_VERSION=${R_VERSION:-4.4.3} ############# Build Stage ################## -# Get shiny+tidyverse+devtools packages from rocker image -FROM rocker/shiny-verse:${R_VERSION} AS base +# Use a multi-arch Rocker base. +FROM rocker/r-ver:${R_VERSION} AS base # Build according to a specified version of R ARG SIGREPO_BRANCH @@ -22,6 +22,12 @@ ARG DEBIAN_FRONTEND=noninteractive # Install system libraries of general use RUN apt-get update --allow-releaseinfo-change --fix-missing \ && apt-get -y --no-install-recommends install \ + build-essential \ + pkg-config \ + libcurl4-openssl-dev \ + libssl-dev \ + libxml2-dev \ + default-libmysqlclient-dev \ librsvg2-dev \ libudunits2-dev \ libv8-dev \ @@ -90,16 +96,16 @@ RUN Rscript "${SIGREPO_SERVER_DIR}/install_r_packages.R" RUN R -e "BiocManager::install('limma')" # Install OmicSignature -RUN R -e "devtools::install_github(repo = 'montilab/OmicSignature', dependencies = TRUE)" +RUN R -e "remotes::install_github(repo = 'montilab/OmicSignature', dependencies = c('Depends','Imports','LinkingTo'))" # Install dependencies for OmicSignature RUN R -e "BiocManager::install('biomaRt')" # Install SigRepo -RUN R -e "branch <- base::Sys.getenv('SIGREPO_BRANCH'); devtools::install_github(repo = 'montilab/SigRepo', ref = branch, dependencies = TRUE)" +RUN R -e "branch <- base::Sys.getenv('SIGREPO_BRANCH'); remotes::install_github(repo = 'montilab/SigRepo', ref = branch, dependencies = c('Depends','Imports','LinkingTo'))" # Install hypeR -RUN R -e "devtools::install_github(repo = 'montilab/hypeR', dependencies = TRUE)" +RUN R -e "remotes::install_github(repo = 'montilab/hypeR', dependencies = c('Depends','Imports','LinkingTo'))" # Expose app at port 3838 EXPOSE 3838 @@ -121,5 +127,3 @@ RUN dos2unix ${SIGREPO_SERVER_DIR}/api/api-server.sh # Allow permissions to execute the bash script RUN chmod a+x ${SIGREPO_SERVER_DIR}/api/api-server.sh - - diff --git a/docker-compose-build-version.yml b/docker-compose-build-version.yml index adb09ce..71d466b 100644 --- a/docker-compose-build-version.yml +++ b/docker-compose-build-version.yml @@ -1,37 +1,37 @@ x-sql-volume: &sql-volume type: bind - source: /Users/reinachau/mysql/database + source: /Users/cameronvicnaire/mysql/database target: /var/lib/mysql x-difexp-volume: &difexp-volume type: bind - source: /Users/reinachau/mysql/difexp + source: /Users/cameronvicnaire/mysql/difexp target: /difexp x-omic-signature-volume: &omic-signature-volume type: bind - source: /Users/reinachau/OmicSignature + source: /Users/cameronvicnaire/Documents/GitHub/OmicSignature target: /OmicSignature x-hyper-volume: &hyper-volume type: bind - source: /Users/reinachau/hypeR + source: /Users/cameronvicnaire/Documents/GitHub/hypeR target: /hypeR x-sigrepo-volume: &sigrepo-volume type: bind - source: /Users/reinachau/SigRepo + source: /Users/cameronvicnaire/Documents/GitHub/SigRepo target: /SigRepo x-sigrepo-server-volume: &sigrepo-server-volume type: bind - source: /Users/reinachau/SigRepo_Server + source: /Users/cameronvicnaire/Documents/GitHub/SigRepo_Server target: /SigRepo_Server services: diff --git a/install_r_packages.R b/install_r_packages.R old mode 100755 new mode 100644 index 1e792eb..0c1edf8 --- a/install_r_packages.R +++ b/install_r_packages.R @@ -1,49 +1,55 @@ - -# Create a list of start-up packages -startup_packages <- c("BiocManager", "dplyr", "rvest", "xml2", "yaml") - -# Select only the packages that aren't currently installed in the system -install_startup_packages <- startup_packages[base::which(!startup_packages %in% utils::installed.packages())] - -# And finally we install the required packages -for(pkg in install_startup_packages) utils::install.packages(pkg, dependencies=TRUE, repos='http://cran.rstudio.com/') - -# Load packages -library(BiocManager) -library(dplyr) -library(rvest) -library(xml2) -library(yaml) - -# Get all available Bioconductor packages -url <- 'https://www.bioconductor.org/packages/release/bioc/' -biocPackages <- url |> - xml2::read_html() |> - rvest::html_table() |> - base::lapply(`[[`, "Package") |> - base::unlist() - -# Read in package dependencies in DESCRIPTION -DESCRIPTION <- yaml::read_yaml("DESCRIPTION") - -# Extract all imports packages -required_pkgs <- base::trimws(base::strsplit(DESCRIPTION$Imports, ",", fixed=TRUE)[[1]]) - -# Extract all required bioconductor packages -bioconductor_pkgs <- required_pkgs[base::which(required_pkgs %in% biocPackages)] - -# Select only the packages that aren't currently installed in the system -install_bioconductor_pkgs <- bioconductor_pkgs[base::which(!bioconductor_pkgs %in% utils::installed.packages())] - -# And finally we install the required Bioconductor packages -for(pkg in install_bioconductor_pkgs) BiocManager::install(pkg) - -# Extract all required CRAN packages -cran_pkgs <- required_pkgs[base::which(!required_pkgs %in% bioconductor_pkgs)] - -# Select only the packages that aren't currently installed in the system -install_cran_pkgs <- cran_pkgs[base::which(!cran_pkgs %in% utils::installed.packages())] - -# And finally we install the required packages including their dependencies -for(pkg in install_cran_pkgs) utils::install.packages(pkg, dependencies = TRUE, repos='http://cran.rstudio.com/') - +repos <- "https://cloud.r-project.org" +options(repos = c(CRAN = repos)) + +install_if_missing <- function(pkgs) { + installed <- rownames(utils::installed.packages()) + to_install <- setdiff(pkgs, installed) + if (length(to_install) > 0) { + utils::install.packages( + to_install, + dependencies = c("Depends", "Imports", "LinkingTo"), + repos = repos + ) + } +} + +# Minimal bootstrap only. +bootstrap_pkgs <- c("BiocManager", "remotes", "yaml") +install_if_missing(bootstrap_pkgs) + +# Parse DESCRIPTION (DCF format) +desc <- read.dcf("DESCRIPTION") +imports_field <- if ("Imports" %in% colnames(desc)) desc[1, "Imports"] else "" + +parse_pkg_names <- function(field) { + if (!nzchar(field)) return(character(0)) + x <- unlist(strsplit(field, ",", fixed = TRUE), use.names = FALSE) + x <- trimws(gsub("\\s*\\(.*\\)", "", x)) + x[x != ""] +} + +required_pkgs <- unique(parse_pkg_names(imports_field)) + +bioc_available <- tryCatch(BiocManager::available(), error = function(e) character(0)) +bioc_pkgs <- intersect(required_pkgs, bioc_available) +cran_pkgs <- setdiff(required_pkgs, bioc_pkgs) + +if (length(cran_pkgs) > 0) { + install_if_missing(cran_pkgs) +} + +if (length(bioc_pkgs) > 0) { + installed <- rownames(utils::installed.packages()) + bioc_to_install <- setdiff(bioc_pkgs, installed) + if (length(bioc_to_install) > 0) { + BiocManager::install(bioc_to_install, ask = FALSE, update = FALSE) + } +} + +installed <- rownames(utils::installed.packages()) +missing <- setdiff(required_pkgs, installed) +if (length(missing) > 0) { + stop(sprintf("Failed to install required packages: %s", paste(missing, collapse = ", "))) +} + +cat("Dependency install complete.\n") diff --git a/mysql/Dockerfile b/mysql/Dockerfile index e04a7c6..a6ee530 100644 --- a/mysql/Dockerfile +++ b/mysql/Dockerfile @@ -5,14 +5,23 @@ ARG mysql_image=${mysql_image:-mysql:8.0-bookworm} ############# Build Stage ################## FROM ${mysql_image} AS base -# Install system libraries of general use -RUN apt-get update --allow-releaseinfo-change --fix-missing \ - && apt-get -y --no-install-recommends install \ - vim \ - curl \ - && apt clean autoclean \ - && apt autoremove --yes \ - && rm -rf /var/lib/{apt,dpkg,cache,log}/ +# Install small debug tools across distro variants used by mysql base images. +RUN set -eux; \ + if command -v apt-get >/dev/null 2>&1; then \ + apt-get update --allow-releaseinfo-change --fix-missing; \ + apt-get -y --no-install-recommends install vim curl; \ + apt-get clean; \ + rm -rf /var/lib/apt/lists/*; \ + elif command -v microdnf >/dev/null 2>&1; then \ + microdnf install -y vim-minimal curl; \ + microdnf clean all; \ + elif command -v yum >/dev/null 2>&1; then \ + yum install -y vim-minimal curl; \ + yum clean all; \ + else \ + echo "No supported package manager found in base image"; \ + exit 1; \ + fi # Expose mysql to host -EXPOSE 3306 33060 \ No newline at end of file +EXPOSE 3306 33060 diff --git a/shiny/modules/annotate_module.R b/shiny/modules/annotate_module.R index d1e1bb8..d4037b8 100644 --- a/shiny/modules/annotate_module.R +++ b/shiny/modules/annotate_module.R @@ -1,350 +1,819 @@ annotate_module_ui <- function(id) { ns <- NS(id) - - div( - style = "padding-top: 70px;", - - tabsetPanel( - id = ns("annotate_tabs"), - type = "tabs", - - ## ========================= - ## TAB 1: Test Parameters - ## ========================= - tabPanel( - title = "Test Parameters", - - ## ---- General parameters ---- - fluidRow( - column( - width = 6, - - textInput( - ns("experiment_label"), - "Experiment Label", - placeholder = "E.g. Knockout Experiment" - ), - - shiny::radioButtons( - ns("enrichment_type"), - "Enrichment Type:", - choices = c( - "Hypergeometric" = "hypergeo", - "Kstest" = "kstest", - "Gsea" = "gsea" - ), - inline = TRUE + page_selector <- paste0("#", ns("annotate_page")) + + tagList( + tags$style(HTML(paste0(" + ", page_selector, " { + padding-top: 28px; + padding-bottom: 32px; + } + + ", page_selector, " .annotate-hero { + margin-bottom: 18px; + padding: 24px 28px; + border-radius: 14px; + background: linear-gradient(135deg, #0f3b63 0%, #1b5d8f 100%); + color: #ffffff; + box-shadow: 0 10px 24px rgba(15, 59, 99, 0.18); + } + + ", page_selector, " .annotate-hero h2 { + margin-top: 0; + margin-bottom: 8px; + font-weight: 700; + } + + ", page_selector, " .annotate-hero p { + margin-bottom: 0; + color: rgba(255, 255, 255, 0.88); + } + + ", page_selector, " .annotate-card { + margin-bottom: 18px; + padding: 20px 22px; + border: 1px solid #d9e3ec; + border-radius: 12px; + background: #ffffff; + box-shadow: 0 6px 18px rgba(15, 32, 56, 0.06); + } + + ", page_selector, " .annotate-card h3, + ", page_selector, " .annotate-card h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .annotate-step-label { + display: inline-block; + margin-bottom: 10px; + padding: 4px 10px; + border-radius: 999px; + background: #e9f2f9; + color: #0f4d7c; + font-size: 12px; + font-weight: 700; + letter-spacing: 0.04em; + text-transform: uppercase; + } + + ", page_selector, " .annotate-summary-grid { + display: grid; + grid-template-columns: repeat(2, minmax(0, 1fr)); + gap: 12px; + } + + ", page_selector, " .annotate-summary-item { + padding: 12px 14px; + border-radius: 10px; + background: #f6f9fc; + border: 1px solid #e1ebf2; + } + + ", page_selector, " .annotate-summary-item strong { + display: block; + margin-bottom: 4px; + color: #0f3b63; + font-size: 12px; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .annotate-summary-item span { + color: #17324d; + font-size: 15px; + font-weight: 600; + } + + ", page_selector, " .annotate-feedback { + margin-top: 10px; + } + + ", page_selector, " .annotate-actions { + display: flex; + gap: 10px; + flex-wrap: wrap; + margin-top: 14px; + } + + ", page_selector, " .annotate-empty { + padding: 18px; + border: 1px dashed #c5d5e3; + border-radius: 10px; + background: #f8fbfd; + color: #4b647e; + } + + ", page_selector, " .annotate-results-header { + display: flex; + justify-content: space-between; + align-items: center; + gap: 12px; + flex-wrap: wrap; + margin-bottom: 16px; + } + + ", page_selector, " .annotate-results-actions .btn { + margin-left: 8px; + } + + ", page_selector, " .annotate-results-body { + display: grid; + grid-template-columns: minmax(0, 1fr); + gap: 22px; + } + + ", page_selector, " .annotate-results-section h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .annotate-signature-key { + margin-top: 14px; + } + + ", page_selector, " .annotate-signature-key .dataTables_wrapper { + font-size: 12px; + } + + ", page_selector, " .geneset-filter-group { + padding: 16px; + border: 1px solid #d9e3ec; + border-radius: 10px; + background: #f8fbfd; + } + + ", page_selector, " .geneset-filter-heading h4 { + margin-top: 0; + margin-bottom: 6px; + } + + ", page_selector, " .geneset-filter-heading p { + margin-bottom: 14px; + color: #597189; + } + + ", page_selector, " .geneset-filter-actions { + display: flex; + align-items: center; + justify-content: space-between; + gap: 12px; + flex-wrap: wrap; + margin-bottom: 12px; + } + + ", page_selector, " .geneset-status { + display: inline-flex; + align-items: center; + gap: 8px; + padding: 8px 12px; + border-radius: 999px; + font-size: 13px; + font-weight: 600; + } + + ", page_selector, " .geneset-status-pending { + background: #eef3f7; + color: #4b647e; + } + + ", page_selector, " .geneset-status-ready { + background: #e7f5ec; + color: #21663c; + } + + ", page_selector, " .geneset-summary-text { + margin-top: 10px; + margin-bottom: 0; + color: #3f5873; + font-size: 13px; + } + "))), + + div( + id = ns("annotate_page"), + + div( + class = "annotate-hero", + tags$h2("Annotate Signatures"), + tags$p( + "Configure an enrichment analysis, choose a geneset collection, review your selections, and run hypeR from a single workflow." + ) + ), + + fluidRow( + column( + width = 4, + + div( + class = "annotate-card", + span(class = "annotate-step-label", "Step 1"), + tags$h3("Analysis Setup"), + textInput( + ns("experiment_label"), + "Experiment Label", + placeholder = "Example: Knockout Experiment" + ), + radioButtons( + ns("enrichment_type"), + "Enrichment Method", + choices = c( + "Hypergeometric" = "hypergeo", + "KS Test" = "kstest", + "GSEA" = "gsea" ), - - helpText( - "Signature format depends on enrichment type: Hypergeometric uses a list of features, KStest uses ranked features, and GSEA requires ranked features with numeric weights." - ) + inline = FALSE + ), + helpText( + "Hypergeometric uses feature lists. KS Test and GSEA expect ranked signatures." ), - - column( - width = 6, - numericInput(ns("enrichment_thresh"), "Threshold", 0.05), - numericInput(ns("enrichment_bg"), "Background", 36000) + numericInput( + ns("enrichment_thresh"), + "FDR Threshold", + value = 0.05, + min = 0, + max = 1, + step = 0.01 + ), + numericInput( + ns("enrichment_bg"), + "Background Gene Count", + value = 36000, + min = 1, + step = 100 ) ), - - hr(), - - ## ---- Nested tabs: Signature / Genesets ---- - tabsetPanel( - id = ns("parameter_tabs"), - - ## --- Signatures tab --- - tabPanel( - title = "Signatures", - - h4("[1] Signatures"), - - DT::DTOutput(ns("signature_hypeR")), - - actionButton( - ns("signature_add"), - "Add Signature(s)" - ), - uiOutput(ns("signature_feedback")) + + div( + class = "annotate-card", + span(class = "annotate-step-label", "Step 2"), + tags$h3("Geneset Selection"), + tags$p( + "Use the filter set below to define the genesets included in this enrichment run." ), - - ## --- Genesets tab --- - tabPanel( - title = "Genesets", - - h4("[2] Genesets"), - selectInput( - ns("species"), - "Species", - choices = msigdbr::msigdbr_species()$species_name, - selected = "Homo Sapiens" - ), - genesets_hypeR_UI(ns("genesets")), - - + selectInput( + ns("species"), + "Species", + choices = msigdbr::msigdbr_species()$species_name, + selected = "Homo sapiens" ), - tabPanel( - title = "Preview", + genesets_hypeR_UI(ns("genesets")) + ) + ), + + column( + width = 8, + + div( + class = "annotate-card", + span(class = "annotate-step-label", "Step 3"), + tags$h3("Select Signatures"), + tags$p( + "Choose up to 10 signatures from the repository, then add them to the analysis." + ), + DT::DTOutput(ns("signature_hypeR")), + div( + class = "annotate-actions", actionButton( - ns("enrichment_do"), - "Run hypeR" - ), - uiOutput(ns("signature_preview")) + ns("signature_add"), + "Add Selected Signatures", + class = "btn-primary" + ) + ), + div( + class = "annotate-feedback", + uiOutput(ns("signature_feedback")) ) ), - - - - - ), - - ## ========================= - ## TAB 2: Experiment Results - ## ========================= - tabPanel( - title = "Experiment Results", - - fluidRow( - column( - width = 12, - + + div( + class = "annotate-card", + span(class = "annotate-step-label", "Step 4"), + tags$h3("Review and Run"), + uiOutput(ns("analysis_summary")), + div( + class = "annotate-actions", actionButton( - ns("generate_report"), - "HTML Report" + ns("enrichment_do"), + "Run Enrichment", + class = "btn-primary" ), actionButton( - ns("export_hyp"), - "Export" - ), - - uiOutput(ns("enrichment")), - plotOutput("dotplot", height = "400px", width = "100%") - - - + ns("experiment_reset"), + "New Experiment", + class = "btn-default" + ) ) + ), + + div( + class = "annotate-card", + tags$h3("Current Selection"), + uiOutput(ns("signature_preview")) ) ) + ), + + div( + class = "annotate-card", + div( + class = "annotate-results-header", + div( + tagList( + span(class = "annotate-step-label", "Results"), + tags$h3("Experiment Results") + ) + ), + div( + class = "annotate-results-actions", + actionButton(ns("generate_report"), "HTML Report"), + downloadButton(ns("export_hyp"), "Export Hype Object") + ) + ), + uiOutput(ns("enrichment")) + ) ) ) } +hype_dotplot_data <- function(hyp, fdr_threshold, top = 30, abrv = 50) { + if (is.null(fdr_threshold) || length(fdr_threshold) == 0 || is.na(fdr_threshold)) { + fdr_threshold <- 1 + } + + empty_df <- data.frame( + signature = character(), + label = character(), + fdr = numeric(), + geneset_size = numeric(), + stringsAsFactors = FALSE + ) + + hyp_entries <- if (methods::is(hyp, "multihyp")) { + hyp$data + } else { + list(Enrichment = hyp) + } + + if (is.null(names(hyp_entries)) || any(!nzchar(names(hyp_entries)))) { + names(hyp_entries) <- paste("Signature", seq_along(hyp_entries)) + } -#annotate server logic + plot_dfs <- lapply(seq_along(hyp_entries), function(i) { + hyp_entry <- hyp_entries[[i]] + hyp_df <- if (is.data.frame(hyp_entry)) hyp_entry else hyp_entry$data + + if (is.null(hyp_df) || !is.data.frame(hyp_df) || nrow(hyp_df) == 0) { + return(NULL) + } + + if (!all(c("label", "fdr") %in% names(hyp_df))) { + return(NULL) + } + + hyp_df$fdr <- suppressWarnings(as.numeric(hyp_df$fdr)) + hyp_df <- hyp_df[!is.na(hyp_df$fdr) & hyp_df$fdr <= fdr_threshold, , drop = FALSE] + + if (nrow(hyp_df) == 0) { + return(NULL) + } + + geneset_size <- rep(1, nrow(hyp_df)) + if ("geneset" %in% names(hyp_df)) { + geneset_size <- suppressWarnings(as.numeric(hyp_df$geneset)) + geneset_size[is.na(geneset_size) | geneset_size <= 0] <- 1 + } + + data.frame( + signature = names(hyp_entries)[[i]], + label = substr(as.character(hyp_df$label), 1, abrv), + fdr = hyp_df$fdr, + geneset_size = geneset_size, + stringsAsFactors = FALSE + ) + }) + + plot_dfs <- plot_dfs[!vapply(plot_dfs, is.null, logical(1))] + + if (length(plot_dfs) == 0) { + return(empty_df) + } + + plot_df <- do.call(rbind, plot_dfs) + label_rank <- stats::aggregate(fdr ~ label, data = plot_df, FUN = min) + label_rank <- label_rank[order(label_rank$fdr), , drop = FALSE] + top_labels <- head(label_rank$label, top) + plot_df <- plot_df[plot_df$label %in% top_labels, , drop = FALSE] + plot_df[order(plot_df$fdr), , drop = FALSE] +} annotate_module_server <- function(id, signature_db, user_conn_handler) { moduleServer(id, function(input, output, session) { - ns <- session$ns - - # selected signatures + max_signature_count <- 10 active_signatures <- reactiveVal(list()) - - - # list of signature choices in the database + run_feedback <- reactiveVal(NULL) + hyp_result <- reactiveVal(NULL) + output$signature_hypeR <- renderDT({ df <- signature_db() - - # util function for datatable - + DatatableFX( df = df, - hidden_columns = c(0, 6, 7, 8, 9, 11,12, 14, 15, 16,18, 19,21,22, 24, 25, 26), + hidden_columns = c(0, 6, 7, 8, 9, 11, 12, 14, 15, 16, 18, 19, 21, 22, 24, 25, 26), scrollY = "300px", row_selection = "multiple" - - ) }, server = TRUE) - + + genesets <- genesets_hypeR_Server( + id = "genesets", + species = reactive(input$species), + clean = TRUE + ) + observeEvent(input$signature_add, { - # Get selected rows from the DT selected_rows <- input$signature_hypeR_rows_selected - req(selected_rows) - + + if (length(selected_rows) == 0) { + run_feedback(list( + type = "warning", + text = "Select at least one signature before adding it to the analysis." + )) + return() + } + df <- signature_db() req(!is.null(df)) - + sig_rows <- df[selected_rows, , drop = FALSE] - current <- active_signatures() - + added_count <- 0 + skipped_limit_count <- 0 + for (i in seq_len(nrow(sig_rows))) { sig_row <- sig_rows[i, ] key <- sig_row$signature_name + if (!key %in% names(current)) { + if (length(current) >= max_signature_count) { + skipped_limit_count <- skipped_limit_count + 1 + next + } + current[[key]] <- list( - experiment = input$experiment_label, - signature_name = sig_row$signature_name, - signature_id = sig_row$signature_id + experiment = input$experiment_label, + signature_name = sig_row$signature_name, + signature_id = sig_row$signature_id ) + added_count <- added_count + 1 } } - + active_signatures(current) - # Feedback message - output$signature_feedback <- renderUI({ - tags$div( - style = "color: green; font-weight: bold; margin-top: 5px;", - paste(length(sig_rows), "signature(s) added successfully!") + hyp_result(NULL) + + run_feedback(list( + type = if (skipped_limit_count > 0) "warning" else if (added_count > 0) "success" else "info", + text = if (skipped_limit_count > 0) { + sprintf( + "%s signature(s) added. The analysis is limited to %s signatures, so %s selection(s) were skipped.", + added_count, + max_signature_count, + skipped_limit_count + ) + } else if (added_count > 0) { + sprintf("%s signature(s) added to the analysis.", added_count) + } else { + "All selected signatures are already in the current analysis." + } + )) + }) + + observeEvent(input$experiment_reset, { + active_signatures(list()) + hyp_result(NULL) + run_feedback(NULL) + + updateTextInput(session, "experiment_label", value = "") + updateRadioButtons(session, "enrichment_type", selected = "hypergeo") + updateNumericInput(session, "enrichment_thresh", value = 0.05) + updateNumericInput(session, "enrichment_bg", value = 36000) + + DT::selectRows(DT::dataTableProxy("signature_hypeR", session = session), NULL) + showNotification("Experiment selections and results were reset.", type = "message") + }) + + output$signature_feedback <- renderUI({ + feedback <- run_feedback() + if (is.null(feedback)) { + return(NULL) + } + + class_name <- switch( + feedback$type, + success = "alert alert-success", + warning = "alert alert-warning", + info = "alert alert-info", + "alert alert-info" + ) + + tags$div(class = class_name, feedback$text) + }) + + output$analysis_summary <- renderUI({ + sig_list <- active_signatures() + gsets <- genesets() + + summary_value <- function(value, empty = "Not set") { + if (is.null(value) || identical(value, "") || (length(value) == 0)) empty else as.character(value) + } + + div( + class = "annotate-summary-grid", + div( + class = "annotate-summary-item", + tags$strong("Experiment"), + tags$span(summary_value(input$experiment_label, "Untitled analysis")) + ), + div( + class = "annotate-summary-item", + tags$strong("Method"), + tags$span( + dplyr::recode( + input$enrichment_type, + hypergeo = "Hypergeometric", + kstest = "KS Test", + gsea = "GSEA" + ) + ) + ), + div( + class = "annotate-summary-item", + tags$strong("Selected Signatures"), + tags$span(sprintf("%s / %s", length(sig_list), max_signature_count)) + ), + div( + class = "annotate-summary-item", + tags$strong("Selected Genesets"), + tags$span(length(gsets)) + ), + div( + class = "annotate-summary-item", + tags$strong("FDR Threshold"), + tags$span(summary_value(input$enrichment_thresh)) + ), + div( + class = "annotate-summary-item", + tags$strong("Background"), + tags$span(summary_value(input$enrichment_bg)) ) - }) + ) }) - - + output$signature_preview <- renderUI({ - sig_list <- active_signatures() - + gsets <- genesets() + if (length(sig_list) == 0) { - return(tags$em("No signatures added yet.")) + return( + div( + class = "annotate-empty", + "No signatures have been added yet. Select signatures from the table above to start the analysis." + ) + ) } - - # Extract selected signature names + sig_names <- vapply(sig_list, `[[`, character(1), "signature_name") - - # Filter original signature_db df <- signature_db() req(df) - + selected_df <- df[df$signature_name %in% sig_names, , drop = FALSE] - - gs_names <- names(genesets()) - + preview_df <- selected_df[, intersect(c("signature_name", "signature_id", "perturbation"), names(selected_df)), drop = FALSE] + geneset_names <- names(gsets) + tagList( - tags$h5(paste("Experiment:", input$experiment_label)), - tags$h5(paste("Enrichment Type:", input$enrichment_type)), - tags$h6(paste("Enrichment Threshold:", input$enrichment_thresh)), - tags$h6(paste("Background:", input$enrichment_bg)), - tags$hr(), - - tags$h5("Selected Signatures:"), + tags$p( + "Review the selected signatures and genesets before running enrichment." + ), DT::datatable( - selected_df, + preview_df, + rownames = FALSE, options = list( scrollX = TRUE, - columnDefs = list( - list(visible = FALSE, targets = 0) # hide first column - ) + pageLength = 5, + dom = "tip" ), - class = "nowrap", # <- prevent wrapping - escape = FALSE - ) %>% - DT::formatStyle( - columns = names(selected_df), - `white-space` = "nowrap" - ) - , - + class = "compact stripe hover" + ), tags$hr(), - - tags$h5("Selected Genesets:"), - if (length(gs_names) > 0) { - tags$ul(lapply(gs_names, tags$li)) + tags$h4("Geneset Collections"), + if (length(geneset_names) > 0) { + tags$ul(lapply(head(geneset_names, 10), tags$li)) } else { - tags$em("No genesets selected yet.") + div( + class = "annotate-empty", + "No genesets have been fetched yet. Choose a collection and subcategory, then fetch genesets." + ) + }, + if (length(geneset_names) > 10) { + tags$p(sprintf("Showing 10 of %s genesets selected.", length(geneset_names))) + } + ) + }) + + observeEvent(input$enrichment_do, { + sig_list <- active_signatures() + gsets <- genesets() + + if (length(sig_list) == 0) { + showNotification("Add at least one signature before running enrichment.", type = "error") + return() + } + + if (length(gsets) == 0) { + showNotification("Fetch at least one geneset collection before running enrichment.", type = "error") + return() + } + + sig_ids <- vapply(sig_list, function(sig) as.numeric(sig$signature_id), numeric(1)) + + sig_objs <- SigRepo::getSignature( + conn_handler = user_conn_handler(), + signature_id = sig_ids + ) + + signature_vectors <- lapply(sig_objs, function(x) { + if (is.null(x$signature)) { + return(NULL) } + + symbols <- as.character(x$difexp$symbol) + symbols <- symbols[!is.na(symbols)] + + if (length(symbols) == 0) { + return(NULL) + } + + symbols + }) + + signature_vectors <- signature_vectors[!vapply(signature_vectors, is.null, logical(1))] + + if (length(signature_vectors) == 0) { + showNotification("No valid signatures were available to run enrichment.", type = "error") + return() + } + + hyp <- hypeR::hypeR( + signature = signature_vectors, + genesets = gsets, + test = input$enrichment_type, + background = input$enrichment_bg, + fdr = input$enrichment_thresh, + plotting = FALSE, + quiet = TRUE + ) + + hyp_result(hyp) + showNotification("Enrichment analysis completed.", type = "message") + }) + + dotplot_data <- reactive({ + hyp <- hyp_result() + req(hyp) + + plot_df <- hype_dotplot_data(hyp, fdr_threshold = input$enrichment_thresh) + validate(need(nrow(plot_df) > 0, "No enriched genesets passed the selected FDR threshold.")) + + signature_lookup <- unique(plot_df["signature"]) + signature_lookup$signature_label <- paste0("S", seq_len(nrow(signature_lookup))) + + plot_df <- merge(plot_df, signature_lookup, by = "signature", all.x = TRUE, sort = FALSE) + plot_df$signature_label <- factor(plot_df$signature_label, levels = signature_lookup$signature_label) + plot_df$label <- factor(plot_df$label, levels = rev(unique(plot_df$label))) + + positive_fdr <- plot_df$fdr[plot_df$fdr > 0] + min_positive_fdr <- if (length(positive_fdr) > 0) min(positive_fdr, na.rm = TRUE) else .Machine$double.xmin + plot_df$fdr_plot <- pmax(plot_df$fdr, min_positive_fdr / 10) + + list( + plot_df = plot_df, + signature_lookup = signature_lookup[, c("signature_label", "signature"), drop = FALSE] ) }) - - - - - # genesets logic - - genesets <- genesets_hypeR_Server( - id = "genesets", - species = reactive(input$species), - clean = TRUE - ) - - - - observeEvent(input$enrichment_do, { - sig_list <- active_signatures() - req(length(sig_list) > 0) - - gsets <- genesets() - req(length(gsets) > 0) - - # Collect all selected signature IDs - sig_ids <- sapply(sig_list, function(sig) sig$signature_id) - - # Fetch all signatures at once - sig_objs <- SigRepo::getSignature( - conn_handler = user_conn_handler(), - signature_id = sig_ids - ) - - # sig_objs is a named list where names are signature_name - # Each element is a vector of genes (e.g., difexp$symbol) - - signature_vectors <- lapply(sig_objs, function(x) { - # Skip if x$signature is NULL - if (is.null(x$signature)) return(NULL) - - # Convert symbols to character and remove NAs - symbols <- as.character(x$difexp$symbol) - symbols <- symbols[!is.na(symbols)] - - # Skip empty vectors - if (length(symbols) == 0) return(NULL) - - symbols - }) - - # Remove any NULL entries - signature_vectors <- signature_vectors[!sapply(signature_vectors, is.null)] - - if (length(signature_vectors) == 0) { - showNotification("No valid signatures to run enrichment", type = "error") - return() - } - - # Run hypeR - hyp <- hypeR::hypeR( - signature = signature_vectors, # named list of multiple signatures - genesets = gsets, - test = input$enrichment_type, - background = input$enrichment_bg, - fdr = input$enrichment_thresh, - plotting = FALSE, - quiet = TRUE - ) - print(hyp) - - - # generate html report - - observeEvent(input$generate_report, { - - - - }) - - # Render results table - - output$dotplot <- renderPlot({ - hypeR::hyp_dots(hyp, merge = TRUE, fdr = input$enrichment_thresh, title = input$experiment_label) - }) - output$enrichment <- renderUI({ - tagList( - tags$h5("Enrichment Results"), - hypeR::rctbl_build(hyp) - ) - }) - - - - - - - }) - - - - + + output$dotplot <- renderPlot({ + plot_df <- dotplot_data()$plot_df + + ggplot2::ggplot( + plot_df, + ggplot2::aes( + x = signature_label, + y = label, + color = fdr_plot, + size = geneset_size + ) + ) + + ggplot2::geom_point(alpha = 0.86) + + ggplot2::scale_color_continuous( + low = "#E53935", + high = "#114357", + trans = "log10", + guide = ggplot2::guide_colorbar(reverse = TRUE) + ) + + ggplot2::scale_size_continuous(trans = "log10") + + ggplot2::labs( + title = input$experiment_label, + x = NULL, + y = NULL, + color = "FDR", + size = "Geneset Size" + ) + + ggplot2::theme_minimal(base_size = 12) + + ggplot2::theme( + plot.title = ggplot2::element_text(hjust = 0.5, face = "bold"), + axis.text.x = ggplot2::element_text(face = "bold"), + panel.grid.major.y = ggplot2::element_line(color = "#e6edf3"), + panel.grid.minor = ggplot2::element_blank() + ) + }) + + output$dotplot_signature_key <- DT::renderDT({ + key_df <- dotplot_data()$signature_lookup + names(key_df) <- c("Plot ID", "Signature") + + DT::datatable( + key_df, + rownames = FALSE, + options = list( + pageLength = 10, + dom = "tip", + scrollX = TRUE + ), + class = "compact stripe hover" + ) + }) + + output$enrichment <- renderUI({ + hyp <- hyp_result() + + if (is.null(hyp)) { + return( + div( + class = "annotate-empty", + "Results will appear here after you run an enrichment analysis." + ) + ) + } + + div( + class = "annotate-results-body", + div( + class = "annotate-results-section", + tags$h4("Results Table"), + hypeR::rctbl_build(hyp) + ), + div( + class = "annotate-results-section", + tags$h4("Dotplot"), + plotOutput(session$ns("dotplot"), height = "400px", width = "100%"), + div( + class = "annotate-signature-key", + tags$h4("Signature Key"), + DT::DTOutput(session$ns("dotplot_signature_key")) + ) + ) + ) + }) + + observeEvent(input$generate_report, { + hyp <- hyp_result() + if (is.null(hyp)) { + showNotification("Run an enrichment analysis before generating a report.", type = "warning") + } + }) + + output$export_hyp <- downloadHandler( + filename = function() { + label <- input$experiment_label + if (is.null(label) || !nzchar(label)) { + label <- "sigrepo_enrichment" + } + + safe_label <- gsub("[^A-Za-z0-9_-]+", "_", label) + sprintf("%s_hype_%s.rds", safe_label, format(Sys.time(), "%Y%m%d_%H%M%S")) + }, + content = function(file) { + hyp <- hyp_result() + req(hyp) + saveRDS(hyp, file) + } + ) }) } diff --git a/shiny/modules/collection_module.R b/shiny/modules/collection_module.R index 5c4c12c..914b7c9 100644 --- a/shiny/modules/collection_module.R +++ b/shiny/modules/collection_module.R @@ -1,254 +1,428 @@ # Collection page module - -# Collection UI collection_module_ui <- function(id) { ns <- NS(id) + page_selector <- paste0("#", ns("collection_page")) + tagList( + tags$style(HTML(paste0(" + ", page_selector, " { + padding-top: 28px; + padding-bottom: 32px; + } + + ", page_selector, " .collection-hero { + margin-bottom: 18px; + padding: 22px 26px; + border-radius: 14px; + background: linear-gradient(135deg, #184766 0%, #2d6f8f 100%); + color: #ffffff; + box-shadow: 0 10px 24px rgba(24, 71, 102, 0.16); + } + + ", page_selector, " .collection-hero h2 { + margin: 0 0 8px 0; + font-weight: 700; + } + + ", page_selector, " .collection-hero p { + margin: 0; + color: rgba(255, 255, 255, 0.88); + } + + ", page_selector, " .collection-card { + margin-bottom: 18px; + padding: 20px 22px; + border: 1px solid #d9e3ec; + border-radius: 12px; + background: #ffffff; + box-shadow: 0 6px 18px rgba(15, 32, 56, 0.06); + } + + ", page_selector, " .collection-card h3, + ", page_selector, " .collection-card h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .collection-toolbar { + display: flex; + justify-content: space-between; + align-items: center; + gap: 16px; + flex-wrap: wrap; + margin-bottom: 16px; + } + + ", page_selector, " .collection-actions { + display: flex; + gap: 10px; + flex-wrap: wrap; + align-items: center; + } + + ", page_selector, " .collection-selected { + display: flex; + flex-direction: column; + gap: 4px; + } + + ", page_selector, " .collection-selected .collection-label { + font-size: 12px; + font-weight: 700; + color: #4e6782; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .collection-selected .collection-name { + font-size: 20px; + font-weight: 700; + color: #17324d; + } + + ", page_selector, " .collection-summary-grid { + display: grid; + grid-template-columns: repeat(4, minmax(0, 1fr)); + gap: 12px; + margin-bottom: 18px; + } + + ", page_selector, " .collection-summary-item { + padding: 12px 14px; + border-radius: 10px; + background: #f6f9fc; + border: 1px solid #e1ebf2; + } + + ", page_selector, " .collection-summary-item strong { + display: block; + margin-bottom: 4px; + color: #0f3b63; + font-size: 12px; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .collection-summary-item span { + color: #17324d; + font-size: 15px; + font-weight: 600; + } + + ", page_selector, " .collection-empty { + padding: 20px; + border: 1px dashed #c5d5e3; + border-radius: 10px; + background: #f8fbfd; + color: #4b647e; + } + + ", page_selector, " .collection-helper { + margin-bottom: 14px; + color: #597189; + } + "))), + div( - style = "margin-top: 70px;", - actionButton( - ns("open_upload_modal"), - "Upload collection", - icon = icon("upload"), - class = "btn-primary" + id = ns("collection_page"), + + div( + class = "collection-hero", + tags$h2("Browse Collections"), + tags$p( + "Select a collection to review its metadata and included signatures without opening a separate dialog." + ) ), - br(), - - uiOutput(ns("action_buttons")), - DTOutput(ns("collection_tbl")), - - + + div( + class = "collection-card", + div( + class = "collection-toolbar", + actionButton( + ns("open_upload_modal"), + "Upload Collection", + icon = icon("upload"), + class = "btn-primary" + ), + uiOutput(ns("collection_actions")) + ), + DT::DTOutput(ns("collection_tbl")) + ), + + div( + class = "collection-card", + tags$h3("Selected Collection"), + p( + class = "collection-helper", + "Selecting a row loads the collection details below so you can inspect metadata and member signatures in one place." + ), + uiOutput(ns("collection_detail_panel")) + ) ) ) } collection_module_server <- function(id, collection_db, user_conn_handler, collection_trigger) { moduleServer(id, function(input, output, session) { - ns <- session$ns - - # Reactive Vals - selected_collection <- reactiveVal(NULL) collection_object <- reactiveVal(NULL) - - current_collection <- reactive({ - req(collection_object()) - collection_object()[[1]] # extract the first and only Omic Collection object - }) - - - # grouped collection DF - + + collection_field_value <- function(collection_df, field, default = "Not available") { + if (is.null(collection_df) || !field %in% names(collection_df)) { + return(default) + } + + value <- collection_df[[field]][1] + if (is.null(value) || is.na(value) || identical(as.character(value), "")) { + return(default) + } + + as.character(value) + } + + fetch_selected_collection <- function(collection_id) { + SigRepo::getCollection( + conn_handler = user_conn_handler(), + collection_id = collection_id + ) + } + df_grouped <- reactive({ - req(user_conn_handler()) - + df <- collection_db() - + df %>% - group_by( + dplyr::group_by( collection_id, collection_name, description, - user_name, + user_name, date_created, visibility ) %>% - summarise(signatures = paste(signature_name, collapse = ", "), - .groups = "drop") - - - - + dplyr::summarise( + signature_count = dplyr::n(), + signatures = paste(signature_name, collapse = ", "), + .groups = "drop" + ) }) - - - # collection_tbl output + output$collection_tbl <- renderDT({ DatatableFX( df = df_grouped(), scrollY = "500px", row_selection = "single" ) - }, server = TRUE) - - - - - # Action Buttons UI #### - output$action_buttons <- renderUI({ - req(input$collection_tbl_rows_selected) + }, server = TRUE) + + observeEvent(input$collection_tbl_rows_selected, { row <- input$collection_tbl_rows_selected + + if (length(row) == 0) { + selected_collection(NULL) + collection_object(NULL) + return() + } + df <- df_grouped() - - collection_selected <- df[row, ] - - # updating the reactive val + collection_selected <- df[row, , drop = FALSE] selected_collection(collection_selected) - - - # action buttons - tagList( - h4( - paste("Actions for Collection:", selected_collection()$collection_name) + + tryCatch({ + collection_object(fetch_selected_collection(collection_selected$collection_id[[1]])) + }, error = function(e) { + collection_object(NULL) + showNotification( + paste("Failed to load collection details:", e$message), + type = "error", + duration = 8 + ) + }) + }) + + output$collection_actions <- renderUI({ + collection_selected <- selected_collection() + + if (is.null(collection_selected)) { + return( + div( + class = "collection-selected", + tags$span(class = "collection-label", "Selection"), + tags$span(class = "collection-name", "No collection selected") + ) + ) + } + + div( + class = "collection-toolbar", + div( + class = "collection-selected", + tags$span(class = "collection-label", "Selected Collection"), + tags$span(class = "collection-name", collection_field_value(collection_selected, "collection_name")) ), - actionButton(ns("view_btn"), "View"), - actionButton(ns("update_btn"), "Update"), - actionButton(ns("delete_btn"), "Delete"), - actionButton(ns("access_btn"), "Access"), - downloadButton(ns("download_btn"), "Download") + div( + class = "collection-actions", + actionButton(ns("refresh_btn"), "Refresh"), + actionButton(ns("update_btn"), "Update"), + actionButton(ns("delete_btn"), "Delete"), + actionButton(ns("access_btn"), "Access"), + downloadButton(ns("download_btn"), "Download") + ) ) }) - - - - # === View Button Clicked === - observeEvent(input$download_btn, { - req(selected_collection()) - - collection_id <- selected_collection()$collection_id - - - - - }) - - #### Show Modal when collection is selected, different from signatures #### - observeEvent(input$view_btn, { - - - showModal( - modalDialog( - title = paste("Collection:", selected_collection()$collection_name), - size = "l", - easyClose = TRUE, - footer = modalButton("Close"), - tabsetPanel( - tabPanel("Metadata", - uiOutput(ns("collection_metadata")) - ), - tabPanel("Signatures", - actionButton(ns("add_to_collection"), "Add to collection"), - DTOutput(ns("collection_sig_tbl")) - ), - + + output$collection_detail_panel <- renderUI({ + collection_selected <- selected_collection() + + if (is.null(collection_selected)) { + return( + div( + class = "collection-empty", + "Choose a collection from the table above to inspect its metadata and included signatures." ) ) + } + + tagList( + div( + class = "collection-summary-grid", + div( + class = "collection-summary-item", + tags$strong("Collection"), + tags$span(collection_field_value(collection_selected, "collection_name")) + ), + div( + class = "collection-summary-item", + tags$strong("Owner"), + tags$span(collection_field_value(collection_selected, "user_name")) + ), + div( + class = "collection-summary-item", + tags$strong("Visibility"), + tags$span(collection_field_value(collection_selected, "visibility")) + ), + div( + class = "collection-summary-item", + tags$strong("Signatures"), + tags$span(collection_field_value(collection_selected, "signature_count", "0")) + ) + ), + tabsetPanel( + tabPanel("Metadata", uiOutput(session$ns("collection_metadata"))), + tabPanel("Signatures", DT::DTOutput(session$ns("collection_sig_tbl"))) + ) ) }) - - - # Metadata UI + output$collection_metadata <- renderUI({ req(selected_collection()) - + tagList( - p(strong("Description"), selected_collection()$description), - p(strong("Date Created:"), selected_collection()$date_created), - p(strong("User:"), selected_collection()$user_name), - p(strong("Total Number of signatures:"), selected_collection()$signature_count) - + p(tags$strong("Description:"), collection_field_value(selected_collection(), "description")), + p(tags$strong("Date Created:"), collection_field_value(selected_collection(), "date_created")), + p(tags$strong("User:"), collection_field_value(selected_collection(), "user_name")), + p(tags$strong("Total Signatures:"), collection_field_value(selected_collection(), "signature_count", "0")) ) }) - - + output$collection_sig_tbl <- renderDataTable({ req(selected_collection(), collection_db()) - - selected <- selected_collection() - + filtered_collection_tbl <- collection_db()[ - collection_db()$collection_name == selected$collection_name, + collection_db()$collection_name == selected_collection()$collection_name[[1]], + , + drop = FALSE ] - + DatatableFX( filtered_collection_tbl, - hidden_columns = c(3,4) - + hidden_columns = c(3, 4) ) + }, server = TRUE) + + observeEvent(input$refresh_btn, { + req(selected_collection()) + + tryCatch({ + collection_object(fetch_selected_collection(selected_collection()$collection_id[[1]])) + showNotification("Collection details refreshed.", type = "message") + }, error = function(e) { + showNotification( + paste("Failed to refresh collection details:", e$message), + type = "error", + duration = 8 + ) + }) }) - - - - ### upload collection logic + observeEvent(input$open_upload_modal, { - showModal(upload_modal_ui(ns, "Collection")) + showModal(upload_modal_ui(session$ns, "Collection")) }) - - + observeEvent(input$upload_btn, { req(input$upload_file) - + tryCatch({ rds_object <- readRDS(input$upload_file$datapath) - - SigRepo::addCollection(conn_handler = user_conn_handler(), omic_collection = rds_object) - + + SigRepo::addCollection( + conn_handler = user_conn_handler(), + omic_collection = rds_object + ) + showNotification("Collection uploaded and added successfully!") - - - # Trigger reactive update after upload collection_trigger(isolate(collection_trigger()) + 1) - }, error = function(e) { - showNotification(paste( - "Error reading or uploading collection rds object", - ":", - e$message - ), - type = "error") + showNotification( + paste("Error reading or uploading collection rds object:", e$message), + type = "error" + ) }) - + removeModal() }) - - # delete signature logic #### - - observeEvent(input$delete_btn,{ - - collection_id <- selected_collection()$collection_id - - showModal(modalDialog( - title = "Confirm Delete", - paste("Are you sure you want to delete Collection: ID", collection_id, "?"), - footer = tagList( - modalButton("Cancel"), - actionButton(ns("confirm_delete_collection"), "Delete", class = "btn-danger") - + + observeEvent(input$delete_btn, { + req(selected_collection()) + + showModal( + modalDialog( + title = "Confirm Delete", + paste( + "Are you sure you want to delete collection:", + selected_collection()$collection_name[[1]], + "?" + ), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("confirm_delete_collection"), "Delete", class = "btn-danger") + ) ) - )) - - + ) }) - - # delete collection logic - + observeEvent(input$confirm_delete_collection, { - req(selected_collection()) # ensure selection exists - - collection_id <- selected_collection()$collection_id - + req(selected_collection()) + + collection_id <- selected_collection()$collection_id[[1]] + tryCatch({ - result <- SigRepo::deleteCollection( + SigRepo::deleteCollection( conn_handler = user_conn_handler(), collection_id = collection_id ) - + showNotification("Collection deleted successfully.", type = "message") - - # close the modal removeModal() - - # Trigger table refresh + selected_collection(NULL) + collection_object(NULL) collection_trigger(collection_trigger() + 1) - }, error = function(e) { - - # Print to console for developer message("Error deleting collection: ", e$message) - - # Keep modal open on error and show error notification showNotification( paste("Failed to delete collection:", e$message), type = "error", @@ -256,85 +430,68 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle ) }) }) - - - # update collection logic ### - + observeEvent(input$update_btn, { - - collection_id <- selected_collection()$collection_id - collection_name <- selected_collection()$collection_name - + req(selected_collection()) + + collection_name <- selected_collection()$collection_name[[1]] + showModal(modalDialog( title = "Update collection", paste("Collection to update:", collection_name), - fileInput(ns("update_file_upload"), paste("Choose an RDS file"), accept = ".rds"), - p("How it works: the selected collection will be updated with the new collection object you added to the file input"), + fileInput(session$ns("update_file_upload"), "Choose an RDS file", accept = ".rds"), + p("The selected collection will be updated with the new collection object you upload."), footer = tagList( modalButton("Cancel") ) )) }) - - # add user logic - + observeEvent(input$access_btn, { - - collection_id <- selected_collection()$collection_id - collection_name <- selected_collection()$collection_name - + req(selected_collection()) + user_tbl <- SigRepo::searchUser(conn_handler = user_conn_handler()) - + showModal(modalDialog( - title = paste("Manage Users for Collection:", collection_name), + title = paste("Manage Users for Collection:", selected_collection()$collection_name[[1]]), tabsetPanel( - tabPanel("Add to Collection", - fluidRow( - column(6, - selectInput( - inputId = "user_selector", - label = "Select users to add:", - choices = user_tbl$user_name , # Replace with your actual function or vector - multiple = TRUE - ) - ) - ), - uiOutput("access_type_ui"), # Dynamic access dropdowns - actionButton("add_users_confirm", "Add Users", class = "btn-primary") + tabPanel( + "Add to Collection", + fluidRow( + column( + 6, + selectInput( + inputId = "user_selector", + label = "Select users to add:", + choices = user_tbl$user_name, + multiple = TRUE + ) + ) + ), + uiOutput("access_type_ui"), + actionButton("add_users_confirm", "Add Users", class = "btn-primary") ), - tabPanel("Delete from Collection", - # Placeholder for delete logic - p("Delete user functionality goes here.") + tabPanel( + "Delete from Collection", + p("Delete user functionality goes here.") ) ), easyClose = TRUE, footer = modalButton("Close") )) }) - - # download handler - + output$download_btn <- downloadHandler( filename = function() { - paste0("collection_", selected_collection()$collection_name, ".rds") + req(selected_collection()) + paste0("collection_", selected_collection()$collection_name[[1]], ".rds") }, content = function(file) { req(selected_collection()) - - collection_object <- getCollection( - conn_handler = user_conn_handler(), - collection_id = selected_collection()$collection_id - ) - - saveRDS(collection_object, file) + + collection_download <- fetch_selected_collection(selected_collection()$collection_id[[1]]) + saveRDS(collection_download, file) } ) - - - - - }) ## ending bracket - - - + }) } diff --git a/shiny/modules/home_module.R b/shiny/modules/home_module.R index 41115fd..7cc29ac 100644 --- a/shiny/modules/home_module.R +++ b/shiny/modules/home_module.R @@ -2,187 +2,368 @@ home_module_ui <- function(id) { ns <- NS(id) - + page_selector <- paste0("#", ns("home_page")) + tagList( - div(style = "margin-top: 15px;", - tags$head(tags$style(HTML(" - .homepage-title { - text-align: center; + tags$style(HTML(paste0(" + ", page_selector, " { + padding-top: 28px; + padding-bottom: 32px; + } + + ", page_selector, " .home-hero { + margin-bottom: 18px; + padding: 26px 30px; + border-radius: 16px; + background: linear-gradient(135deg, #153b59 0%, #28658d 100%); + color: #ffffff; + box-shadow: 0 12px 28px rgba(21, 59, 89, 0.18); + } + + ", page_selector, " .home-hero h1 { + margin: 0 0 10px 0; font-size: 36px; - font-weight: bold; - margin-top: 30px; - } - .homepage-subtitle { - text-align: center; - font-size: 20px; - color: #666; - margin-bottom: 30px; - } - .homepage-section { - background-color: #f8f9fa; - padding: 20px; - border-radius: 10px; - margin-bottom: 20px; - } - .homepage-icon { - font-size: 40px; - color: #007bff; - margin-bottom: 10px; + font-weight: 700; + } + + ", page_selector, " .home-hero p { + margin: 0; + max-width: 760px; + color: rgba(255, 255, 255, 0.9); + font-size: 16px; + line-height: 1.6; + } + + ", page_selector, " .home-hero-actions { + display: flex; + gap: 12px; + flex-wrap: wrap; + margin-top: 18px; + } + + ", page_selector, " .home-card { + margin-bottom: 18px; + padding: 20px 22px; + border: 1px solid #d9e3ec; + border-radius: 12px; + background: #ffffff; + box-shadow: 0 6px 18px rgba(15, 32, 56, 0.06); + } + + ", page_selector, " .home-card h3, + ", page_selector, " .home-card h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .home-stat-grid { + display: grid; + grid-template-columns: repeat(4, minmax(0, 1fr)); + gap: 12px; + } + + ", page_selector, " .home-stat-card { + padding: 16px 18px; + border-radius: 12px; + background: #f6f9fc; + border: 1px solid #e1ebf2; + } + + ", page_selector, " .home-stat-label { + display: block; + margin-bottom: 6px; + color: #58708a; + font-size: 12px; + font-weight: 700; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .home-stat-value { + color: #17324d; + font-size: 28px; + font-weight: 700; + line-height: 1.1; + } + + ", page_selector, " .home-section-copy { + margin-bottom: 14px; + color: #5a728a; + } + + ", page_selector, " .home-action-grid { + display: grid; + grid-template-columns: repeat(3, minmax(0, 1fr)); + gap: 14px; + } + + ", page_selector, " .home-action-card { + padding: 18px; + border-radius: 12px; + border: 1px solid #dbe5ee; + background: linear-gradient(180deg, #ffffff 0%, #f7fafc 100%); + } + + ", page_selector, " .home-action-icon { + display: inline-flex; + align-items: center; + justify-content: center; + width: 52px; + height: 52px; + margin-bottom: 14px; + border-radius: 14px; + background: #e7f1f9; + color: #1c5d87; + font-size: 22px; + } + + ", page_selector, " .home-action-card h4 { + margin-bottom: 8px; + } + + ", page_selector, " .home-action-card p { + min-height: 54px; + color: #5a728a; + } + + ", page_selector, " .home-footer { + display: flex; + justify-content: center; + align-items: center; + gap: 10px; + flex-wrap: wrap; + margin-top: 8px; + color: #6b7f92; + font-size: 13px; } "))), - - fluidRow( - column( - width = 4, + + div( + id = ns("home_page"), + + div( + class = "home-hero", + tags$h1("Welcome to SigRepo"), + tags$p( + "SigRepo is a collaborative signature repository for browsing, organizing, and annotating biological signatures. Use the workspace below to move quickly between repository exploration, collection management, and downstream enrichment analysis." + ), div( - class = "homepage-section text-intro", - HTML( - " -
-

- Welcome to the Signature Repository (SigRepo)! -

-

- The Signature Repository is a collaborative platform designed for storing and managing biological signatures and their associated data. -

-

- This R Shiny application provides a user-friendly interface to: -

- -

- You can explore both public signatures and the ones you've contributed. -

-
- " + class = "home-hero-actions", + actionButton(ns("go_signatures"), "Browse Signatures", class = "btn-primary"), + actionButton(ns("go_collections"), "Explore Collections", class = "btn-default"), + tags$a( + class = "btn btn-default", + href = "https://github.com/montilab/SigRepo", + target = "_blank", + rel = "noopener noreferrer", + "R Client Docs" ) ) ), - column( - width = 8, - div( - class = "homepage-section", - h4("Signature Overview"), - tabsetPanel( - tabPanel("By Organism", plotOutput(ns("organism_plot"), height = "450px")), - tabPanel("By Assay", plotOutput(ns("assay_plot"), height = "450px")), - tabPanel("Top Users", plotOutput(ns("top_users_plot"), height = "450px")) - ) - ) - ) - ), - - fluidRow( - column( - width = 4, - div( - class = "homepage-section text-center", - span(class = "homepage-icon", icon("dna")), - h4("Signatures"), - p("Browse, filter, and manage gene expression signatures."), - actionButton(ns("go_signatures"), "Go to Signatures", class = "btn-primary") - ) + + div( + class = "home-card", + tags$h3("Repository Snapshot"), + p( + class = "home-section-copy", + "A quick view of the current repository footprint based on the signatures available to your account." + ), + uiOutput(ns("home_stats")) ), - column( - width = 4, - div( - class = "homepage-section text-center", - span(class = "homepage-icon", icon("layer-group")), - h4("Collections"), - p("Explore curated collections of signatures."), - actionButton(ns("go_collections"), "Go to Collections", class = "btn-primary") + + fluidRow( + column( + width = 4, + div( + class = "home-card", + tags$h3("By Organism"), + p(class = "home-section-copy", "Distribution of signatures across supported organisms."), + plotOutput(ns("organism_plot"), height = "320px") + ) + ), + column( + width = 4, + div( + class = "home-card", + tags$h3("By Assay"), + p(class = "home-section-copy", "Breakdown of signatures by assay type."), + plotOutput(ns("assay_plot"), height = "320px") + ) + ), + column( + width = 4, + div( + class = "home-card", + tags$h3("Top Contributors"), + p(class = "home-section-copy", "Most active users based on visible signatures."), + plotOutput(ns("top_users_plot"), height = "320px") + ) ) ), - column( - width = 4, - div( - class = "homepage-section text-center", - span(class = "homepage-icon", icon("upload")), - h4("R-Client"), - p("View our R-Client Documentation to use SigRepo in R."), - actionButton(ns("go_upload"), "Github Docs", class = "btn-success") - ) - ) - ), - - br(), - - fluidRow( - column( - 12, + + div( + class = "home-card", + tags$h3("Quick Actions"), + p( + class = "home-section-copy", + "Jump directly into the areas of the platform you are most likely to use next." + ), div( - class = "text-center text-muted", - - # Add logo image - img( - src = "images/LC_logo.png", - style = "height: 30px; vertical-align: middle; margin-right: 10px;" + class = "home-action-grid", + div( + class = "home-action-card", + span(class = "home-action-icon", icon("dna")), + tags$h4("Signatures"), + tags$p("Browse, inspect, download, and manage repository signatures."), + actionButton(ns("go_signatures_secondary"), "Open Signatures", class = "btn-primary") + ), + div( + class = "home-action-card", + span(class = "home-action-icon", icon("layer-group")), + tags$h4("Collections"), + tags$p("Review grouped signatures and manage reusable collection sets."), + actionButton(ns("go_collections_secondary"), "Open Collections", class = "btn-primary") ), - - # Footer text - span("Created by SigRepo Team · Version 1.0 · © 2025") + div( + class = "home-action-card", + span(class = "home-action-icon", icon("flask")), + tags$h4("Annotate"), + tags$p("Launch enrichment and annotation workflows using repository signatures."), + actionButton(ns("go_annotate"), "Open Annotate", class = "btn-primary") + ) ) + ), + + div( + class = "home-footer", + img( + src = "images/LC_logo.png", + style = "height: 30px; vertical-align: middle;" + ), + span("Created by the SigRepo Team"), + span("·"), + span("Version 1.0"), + span("·"), + span("© 2025") ) ) - - ) ) } home_module_server <- function(id, signature_db, parent_session) { moduleServer(id, function(input, output, session) { - - # Top users plot + + signature_summary <- reactive({ + df <- signature_db() + req(nrow(df) > 0) + + list( + total_signatures = nrow(df), + total_users = dplyr::n_distinct(df$user_name), + total_organisms = if ("organism" %in% names(df)) dplyr::n_distinct(df$organism) else 0, + total_assays = if ("assay_type" %in% names(df)) dplyr::n_distinct(df$assay_type) else 0 + ) + }) + + plot_theme <- function() { + ggplot2::theme_minimal(base_size = 12) + + ggplot2::theme( + plot.title = ggplot2::element_text(face = "bold", size = 13, color = "#17324d"), + axis.title = ggplot2::element_text(color = "#4f657b"), + axis.text = ggplot2::element_text(color = "#3f556b"), + panel.grid.minor = ggplot2::element_blank(), + legend.position = "none" + ) + } + + output$home_stats <- renderUI({ + stats <- signature_summary() + + div( + class = "home-stat-grid", + div( + class = "home-stat-card", + tags$span(class = "home-stat-label", "Total Signatures"), + tags$span(class = "home-stat-value", stats$total_signatures) + ), + div( + class = "home-stat-card", + tags$span(class = "home-stat-label", "Active Users"), + tags$span(class = "home-stat-value", stats$total_users) + ), + div( + class = "home-stat-card", + tags$span(class = "home-stat-label", "Organisms"), + tags$span(class = "home-stat-value", stats$total_organisms) + ), + div( + class = "home-stat-card", + tags$span(class = "home-stat-label", "Assay Types"), + tags$span(class = "home-stat-value", stats$total_assays) + ) + ) + }) + output$top_users_plot <- renderPlot({ df <- signature_db() req(nrow(df) > 0) - + user_counts <- df %>% dplyr::count(user_name, name = "num_signatures") %>% dplyr::arrange(desc(num_signatures)) %>% dplyr::slice_head(n = 10) - + ggplot(user_counts, aes(x = reorder(user_name, num_signatures), y = num_signatures)) + - geom_bar(stat = "identity", fill = "#2c7fb8") + + geom_col(fill = "#2d6f8f", width = 0.75) + coord_flip() + - labs(title = "Top 10 Most Active Users", x = "User", y = "Number of Signatures") + - theme_minimal() + labs(x = "User", y = "Signatures") + + plot_theme() }) - - # Organism plot + output$organism_plot <- renderPlot({ df <- signature_db() req(nrow(df) > 0, "organism" %in% names(df)) - + ggplot(df, aes(x = organism, fill = organism)) + - geom_bar() + - labs(x = "Organism", y = "Signature Count") + - theme_minimal() + - theme(legend.position = "right") + geom_bar(width = 0.72) + + labs(x = "Organism", y = "Signatures") + + scale_fill_brewer(palette = "Blues") + + plot_theme() + + theme(axis.text.x = element_text(angle = 20, hjust = 1)) }) - - # Assay type plot + output$assay_plot <- renderPlot({ df <- signature_db() req(nrow(df) > 0, "assay_type" %in% names(df)) - + ggplot(df, aes(x = assay_type, fill = assay_type)) + - geom_bar() + - labs(x = "Assay Type", y = "Signature Count") + - theme_minimal() + - theme(legend.position = "right") + geom_bar(width = 0.72) + + labs(x = "Assay Type", y = "Signatures") + + scale_fill_brewer(palette = "PuBu") + + plot_theme() + + theme(axis.text.x = element_text(angle = 20, hjust = 1)) }) - - # Redirect buttons + observeEvent(input$go_signatures, { updateNavbarPage(parent_session, "main_navbar", selected = "Signatures") }) + observeEvent(input$go_signatures_secondary, { + updateNavbarPage(parent_session, "main_navbar", selected = "Signatures") + }) + observeEvent(input$go_collections, { updateNavbarPage(parent_session, "main_navbar", selected = "Collections") }) + + observeEvent(input$go_collections_secondary, { + updateNavbarPage(parent_session, "main_navbar", selected = "Collections") + }) + + observeEvent(input$go_annotate, { + updateNavbarPage(parent_session, "main_navbar", selected = "Annotate") + }) }) } diff --git a/shiny/modules/hypeR_module.R b/shiny/modules/hypeR_module.R index b8a2dc2..3355305 100644 --- a/shiny/modules/hypeR_module.R +++ b/shiny/modules/hypeR_module.R @@ -15,25 +15,42 @@ #' @return Shiny UI elements #' #' @importFrom shiny NS tagList selectInput uiOutput actionButton -#' @importFrom DT DTOutput #' @export genesets_hypeR_UI <- function(id) { ns <- NS(id) tagList( - selectInput( - ns("collection"), - "MSigDB Collection", - choices = c("H", "C1", "C2", "C3", "C4", "C5", "C6", "C7", "C8") + div( + class = "geneset-filter-group", + tags$div( + class = "geneset-filter-heading", + tags$h4("Geneset Filters"), + tags$p("Choose a species, collection, and subcollection before fetching genesets.") + ), + selectInput( + ns("collection"), + "Collection", + choices = c( + "Hallmark (H)" = "H", + "Positional (C1)" = "C1", + "Curated (C2)" = "C2", + "Regulatory Target (C3)" = "C3", + "Computational (C4)" = "C4", + "Ontology (C5)" = "C5", + "Oncogenic Signature (C6)" = "C6", + "Immunologic Signature (C7)" = "C7", + "Cell Type Signature (C8)" = "C8" + ), + selected = "H" + ), + uiOutput(ns("subcategory_ui")), + div( + class = "geneset-filter-actions", + actionButton(ns("fetch_genesets"), "Fetch Genesets", class = "btn-primary"), + uiOutput(ns("status")) + ) ), - - uiOutput(ns("subcategory_ui")), - - actionButton(ns("fetch_genesets"), "Fetch Genesets"), - - DT::DTOutput(ns("genesets_table")), - - uiOutput(ns("status")) + uiOutput(ns("geneset_summary")) ) } @@ -48,7 +65,6 @@ genesets_hypeR_UI <- function(id) { #' @return Reactive named list of genesets #' #' @importFrom shiny moduleServer renderUI observeEvent reactive req icon -#' @importFrom DT renderDT datatable #' @export genesets_hypeR_Server <- function(id, species, clean = FALSE) { moduleServer(id, function(input, output, session) { @@ -72,27 +88,49 @@ genesets_hypeR_Server <- function(id, species, clean = FALSE) { dplyr::filter(gs_collection == input$collection) |> dplyr::distinct(gs_subcollection) |> dplyr::pull(gs_subcollection) |> - na.omit() - - if (length(subcats) == 0) return(NULL) - + as.character() |> + (\(x) x[!is.na(x) & nzchar(x)])() |> + stats::na.omit() |> + unique() + + if (length(subcats) == 0) { + return( + selectInput( + session$ns("subcategory"), + "Subcollection", + choices = c("No subcollection available" = ""), + selected = "" + ) + ) + } + selectInput( session$ns("subcategory"), - "Subcategory", - choices = subcats + "Subcollection", + choices = subcats, + selected = subcats[[1]] ) }) # Reactive genesets list (updated on button press) reactive.genesets <- eventReactive(input$fetch_genesets, { req(input$collection) - req(input$subcategory) - - gs <- msigdb_tbl() |> - dplyr::filter( - gs_collection == input$collection, - gs_subcollection == input$subcategory - ) |> + req(!is.null(input$subcategory)) + + filtered_tbl <- msigdb_tbl() |> + dplyr::filter(gs_collection == input$collection) + + if (!identical(input$subcategory, "")) { + filtered_tbl <- filtered_tbl |> + dplyr::filter(gs_subcollection == input$subcategory) + } + + if (nrow(filtered_tbl) == 0) { + showNotification("No genesets matched the selected filters.", type = "warning") + return(list()) + } + + gs <- filtered_tbl |> (\(df) split(df, df$gs_name))() |> (\(lst) lapply(lst, function(x) unique(x$gene_symbol)))() @@ -103,42 +141,45 @@ genesets_hypeR_Server <- function(id, species, clean = FALSE) { gs }) - # Show genesets in a DT table - output$genesets_table <- DT::renderDT({ - gs <- reactive.genesets() - req(gs) - - # Convert named list to a data.frame - df <- data.frame( - Geneset = names(gs), - Genes = sapply(gs, function(x) paste(x, collapse = ", ")), - stringsAsFactors = FALSE - ) - - DT::datatable( - df, - options = list( - scrollX = TRUE, - scrollY = "500px", - pageLength = 5, - columnDefs = list( - list(visible = FALSE, targets = 0) - ) - ) - ) - - }) - - # Status icon + # Status message output$status <- renderUI({ if (is.null(reactive.genesets()) || length(reactive.genesets()) == 0) { - icon("times-circle", lib = "font-awesome") + tags$div( + class = "geneset-status geneset-status-pending", + icon("circle-o", lib = "font-awesome"), + tags$span("No genesets fetched") + ) } else { - icon("check-circle", lib = "font-awesome") + tags$div( + class = "geneset-status geneset-status-ready", + icon("check-circle", lib = "font-awesome"), + tags$span(sprintf("%s genesets ready", length(reactive.genesets()))) + ) + } + }) + + output$geneset_summary <- renderUI({ + if (is.null(reactive.genesets()) || length(reactive.genesets()) == 0) { + return(NULL) } + + tagList( + tags$p( + class = "geneset-summary-text", + sprintf( + "Loaded %s genesets for collection %s%s.", + length(reactive.genesets()), + input$collection, + if (!identical(input$subcategory, "")) { + sprintf(" / %s", input$subcategory) + } else { + "" + } + ) + ) + ) }) return(reactive.genesets) }) } - diff --git a/shiny/modules/reference_module.R b/shiny/modules/reference_module.R index 4e441f0..fde2e29 100644 --- a/shiny/modules/reference_module.R +++ b/shiny/modules/reference_module.R @@ -1,96 +1,383 @@ reference_module_ui <- function(id) { ns <- NS(id) - - div( - style = "padding-top: 70px;", - - sidebarLayout( - sidebarPanel( - width = 4, - - tabsetPanel( - id = ns("sidebar_tabs"), - type = "tabs", - - tabPanel( - title = "References", - h4("Reference Features"), - + page_selector <- paste0("#", ns("reference_page")) + + tagList( + tags$style(HTML(paste0(" + ", page_selector, " { + padding-top: 28px; + padding-bottom: 32px; + } + + ", page_selector, " .reference-hero { + margin-bottom: 18px; + padding: 22px 26px; + border-radius: 14px; + background: linear-gradient(135deg, #17485f 0%, #2d758d 100%); + color: #ffffff; + box-shadow: 0 10px 24px rgba(23, 72, 95, 0.16); + } + + ", page_selector, " .reference-hero h2 { + margin: 0 0 8px 0; + font-weight: 700; + } + + ", page_selector, " .reference-hero p { + margin: 0; + color: rgba(255, 255, 255, 0.88); + } + + ", page_selector, " .reference-card { + margin-bottom: 18px; + padding: 20px 22px; + border: 1px solid #d9e3ec; + border-radius: 12px; + background: #ffffff; + box-shadow: 0 6px 18px rgba(15, 32, 56, 0.06); + } + + ", page_selector, " .reference-card h3, + ", page_selector, " .reference-card h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .reference-filter-grid { + display: grid; + grid-template-columns: repeat(2, minmax(0, 1fr)); + gap: 12px; + } + + ", page_selector, " .reference-toolbar { + display: flex; + justify-content: space-between; + align-items: center; + gap: 16px; + flex-wrap: wrap; + margin-bottom: 14px; + } + + ", page_selector, " .reference-summary-grid { + display: grid; + grid-template-columns: repeat(4, minmax(0, 1fr)); + gap: 12px; + margin-bottom: 18px; + } + + ", page_selector, " .reference-summary-item { + padding: 12px 14px; + border-radius: 10px; + background: #f6f9fc; + border: 1px solid #e1ebf2; + } + + ", page_selector, " .reference-summary-item strong { + display: block; + margin-bottom: 4px; + color: #0f3b63; + font-size: 12px; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .reference-summary-item span { + color: #17324d; + font-size: 15px; + font-weight: 600; + } + + ", page_selector, " .reference-empty { + padding: 20px; + border: 1px dashed #c5d5e3; + border-radius: 10px; + background: #f8fbfd; + color: #4b647e; + } + + ", page_selector, " .reference-helper { + margin-bottom: 14px; + color: #597189; + } + "))), + + div( + id = ns("reference_page"), + + div( + class = "reference-hero", + tags$h2("Reference Browser"), + tags$p( + "Search transcriptomic or proteomic reference features, review the result set, and inspect individual feature records inline." + ) + ), + + fluidRow( + column( + width = 4, + div( + class = "reference-card", + tags$h3("Search Filters"), + p( + class = "reference-helper", + "Choose an assay and organism, then optionally narrow the results to a specific feature name." + ), + div( + class = "reference-filter-grid", selectInput( inputId = ns("ref_organism"), - label = "Select an organism", - choices = c("Homo sapiens", "Mus musculus") + label = "Organism", + choices = c("Homo sapiens", "Mus musculus"), + selected = "Homo sapiens" ), - selectInput( inputId = ns("ref_assay"), - label = "Select an assay type", - choices = c("transcriptomics", "proteomics") - ), - - actionButton(ns("search_ref_btn"), "Search") + label = "Assay", + choices = c( + "Transcriptomics" = "transcriptomics", + "Proteomics" = "proteomics" + ), + selected = "transcriptomics" + ) + ), + textInput( + inputId = ns("feature_name"), + label = "Feature Name", + placeholder = "Optional: filter to a specific feature" + ), + actionButton( + ns("search_ref_btn"), + "Search Features", + class = "btn-primary" ) - - - ) ), - - mainPanel( - width = 8, - DTOutput(ns("ref_feature_tbl")) + column( + width = 8, + div( + class = "reference-card", + div( + class = "reference-toolbar", + tags$h3("Search Results"), + uiOutput(ns("results_status")) + ), + uiOutput(ns("results_summary")), + DT::DTOutput(ns("ref_feature_tbl")) + ), + div( + class = "reference-card", + tags$h3("Selected Feature"), + p( + class = "reference-helper", + "Selecting a row loads the feature details below so you can inspect the full record without scanning every column in the table." + ), + uiOutput(ns("feature_detail_panel")) + ) + ) ) ) ) } -# reference server logic - reference_module_server <- function(id, user_conn_handler) { moduleServer(id, function(input, output, session) { - + selected_feature <- reactiveVal(NULL) + + reference_field_value <- function(feature_df, field, default = "Not available") { + if (is.null(feature_df) || !field %in% names(feature_df)) { + return(default) + } + + value <- feature_df[[field]][1] + if (is.null(value) || is.na(value) || identical(as.character(value), "")) { + return(default) + } + + as.character(value) + } + ref_features <- eventReactive(input$search_ref_btn, { + selected_feature(NULL) + tryCatch({ - # Select the correct function based on assay type - features <- switch(input$ref_assay, - "transcriptomics" = SigRepo::searchTranscriptomicsFeatureSet(conn_handler = user_conn_handler()), - "proteomics" = SigRepo::searchProteomicsFeatureSet(conn_handler = user_conn_handler()), - NULL) - + features <- switch( + input$ref_assay, + transcriptomics = SigRepo::searchTranscriptomicsFeatureSet( + conn_handler = user_conn_handler(), + feature_name = input$feature_name, + organism = input$ref_organism + ), + proteomics = SigRepo::searchProteomicsFeatureSet( + conn_handler = user_conn_handler(), + feature_name = input$feature_name, + organism = input$ref_organism + ), + NULL + ) + if (is.null(features)) { - showNotification("Invalid assay type or no data returned", type = "error") + showNotification("Invalid assay type or no data returned.", type = "error") return(NULL) } - - # Filter by organism if available - if ("organism" %in% colnames(features)) { - features <- subset(features, organism == input$ref_organism) - } else { - showNotification("Warning: no `organism` column found in returned data", - type = "warning") + + if (nrow(features) == 0) { + return(NULL) } - - return(features) - + + features }, error = function(e) { showNotification(paste("Error:", e$message), type = "error") return(NULL) }) }) - - - - # table Rendering - + + observeEvent(input$ref_feature_tbl_rows_selected, { + features <- ref_features() + row <- input$ref_feature_tbl_rows_selected + + if (is.null(features) || length(row) == 0) { + selected_feature(NULL) + return() + } + + selected_feature(features[row, , drop = FALSE]) + }) + + output$results_status <- renderUI({ + features <- ref_features() + + if (is.null(features) || nrow(features) == 0) { + return( + tags$span( + class = "label label-default", + "No results loaded" + ) + ) + } + + tags$span( + class = "label label-info", + sprintf("%s results", nrow(features)) + ) + }) + + output$results_summary <- renderUI({ + features <- ref_features() + + if (is.null(features) || nrow(features) == 0) { + return( + div( + class = "reference-empty", + "Run a search to browse reference features." + ) + ) + } + + div( + class = "reference-summary-grid", + div( + class = "reference-summary-item", + tags$strong("Assay"), + tags$span(tools::toTitleCase(input$ref_assay)) + ), + div( + class = "reference-summary-item", + tags$strong("Organism"), + tags$span(input$ref_organism) + ), + div( + class = "reference-summary-item", + tags$strong("Results"), + tags$span(nrow(features)) + ), + div( + class = "reference-summary-item", + tags$strong("Feature Filter"), + tags$span(if (nzchar(input$feature_name)) input$feature_name else "All features") + ) + ) + }) + output$ref_feature_tbl <- renderDT({ - req(ref_features()) - - DatatableFX(ref_features(), - hidden_columns = 5) - + features <- ref_features() + + if (is.null(features) || nrow(features) == 0) { + return( + DatatableFX( + data.frame(Message = "No reference features available for the selected search."), + hidden_columns = integer(0), + row_selection = "none" + ) + ) + } + + DatatableFX( + features, + hidden_columns = integer(0), + row_selection = "single" + ) }) - - + + output$feature_detail_panel <- renderUI({ + feature <- selected_feature() + + if (is.null(feature)) { + return( + div( + class = "reference-empty", + "Select a feature from the results table to inspect its full record." + ) + ) + } + + key_fields <- intersect( + c("feature_name", "organism", "assay", "feature_type", "description"), + names(feature) + ) + + summary_cards <- lapply(key_fields, function(field) { + div( + class = "reference-summary-item", + tags$strong(gsub("_", " ", tools::toTitleCase(field))), + tags$span(reference_field_value(feature, field)) + ) + }) + + if (length(summary_cards) == 0) { + summary_cards <- list( + div( + class = "reference-summary-item", + tags$strong("Feature"), + tags$span("Record loaded") + ) + ) + } + + tagList( + div(class = "reference-summary-grid", summary_cards), + DT::DTOutput(session$ns("feature_detail_tbl")) + ) + }) + + output$feature_detail_tbl <- DT::renderDataTable({ + feature <- selected_feature() + req(feature) + + detail_df <- data.frame( + Field = names(feature), + Value = unlist(feature[1, ], use.names = FALSE), + stringsAsFactors = FALSE + ) + + DatatableFX( + detail_df, + hidden_columns = integer(0), + scrollY = "360px", + row_selection = "none" + ) + }, server = TRUE) }) } diff --git a/shiny/modules/signature_module.R b/shiny/modules/signature_module.R index 3383e05..ebe03a2 100644 --- a/shiny/modules/signature_module.R +++ b/shiny/modules/signature_module.R @@ -1,274 +1,700 @@ # Signature page module - -# Signatures UI signature_module_ui <- function(id) { ns <- NS(id) - + page_selector <- paste0("#", ns("signature_page")) tagList( - + tags$style(HTML(paste0(" + ", page_selector, " { + padding-top: 28px; + padding-bottom: 32px; + } + + ", page_selector, " .signature-hero { + margin-bottom: 18px; + padding: 22px 26px; + border-radius: 14px; + background: linear-gradient(135deg, #143a5a 0%, #245f86 100%); + color: #ffffff; + box-shadow: 0 10px 24px rgba(20, 58, 90, 0.16); + } + + ", page_selector, " .signature-hero h2 { + margin: 0 0 8px 0; + font-weight: 700; + } + + ", page_selector, " .signature-hero p { + margin: 0; + color: rgba(255, 255, 255, 0.88); + } + + ", page_selector, " .signature-card { + margin-bottom: 18px; + padding: 20px 22px; + border: 1px solid #d9e3ec; + border-radius: 12px; + background: #ffffff; + box-shadow: 0 6px 18px rgba(15, 32, 56, 0.06); + } + + ", page_selector, " .signature-card h3, + ", page_selector, " .signature-card h4 { + margin-top: 0; + margin-bottom: 12px; + color: #17324d; + font-weight: 600; + } + + ", page_selector, " .signature-toolbar { + display: flex; + justify-content: space-between; + align-items: center; + gap: 16px; + flex-wrap: wrap; + margin-bottom: 16px; + } + + ", page_selector, " .signature-actions { + display: flex; + gap: 10px; + flex-wrap: wrap; + align-items: center; + } + + ", page_selector, " .signature-selected { + display: flex; + flex-direction: column; + gap: 4px; + } + + ", page_selector, " .signature-selected .signature-label { + font-size: 12px; + font-weight: 700; + color: #4e6782; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .signature-selected .signature-name { + font-size: 20px; + font-weight: 700; + color: #17324d; + } + + ", page_selector, " .signature-summary-grid { + display: grid; + grid-template-columns: repeat(4, minmax(0, 1fr)); + gap: 12px; + margin-bottom: 18px; + } + + ", page_selector, " .signature-summary-item { + padding: 12px 14px; + border-radius: 10px; + background: #f6f9fc; + border: 1px solid #e1ebf2; + } + + ", page_selector, " .signature-summary-item strong { + display: block; + margin-bottom: 4px; + color: #0f3b63; + font-size: 12px; + text-transform: uppercase; + letter-spacing: 0.04em; + } + + ", page_selector, " .signature-summary-item span { + color: #17324d; + font-size: 15px; + font-weight: 600; + } + + ", page_selector, " .signature-empty { + padding: 20px; + border: 1px dashed #c5d5e3; + border-radius: 10px; + background: #f8fbfd; + color: #4b647e; + } + + ", page_selector, " .signature-helper { + margin-bottom: 14px; + color: #597189; + } + + ", page_selector, " .signature-metadata-table .dataTables_wrapper { + margin-top: 8px; + } + + ", page_selector, " .signature-basket-actions { + display: flex; + gap: 10px; + flex-wrap: wrap; + align-items: center; + } + + ", page_selector, " .signature-toolbar-primary { + display: flex; + align-items: center; + gap: 10px; + flex-wrap: wrap; + } + + ", page_selector, " .signature-basket-list { + display: flex; + flex-direction: column; + gap: 10px; + } + + ", page_selector, " .signature-basket-item { + display: flex; + justify-content: space-between; + align-items: center; + gap: 12px; + padding: 12px 14px; + border: 1px solid #e1ebf2; + border-radius: 10px; + background: #f6f9fc; + } + + ", page_selector, " .signature-basket-item-main { + display: flex; + flex-direction: column; + gap: 4px; + } + + ", page_selector, " .signature-basket-item-title { + font-weight: 600; + color: #17324d; + } + + ", page_selector, " .signature-basket-item-meta { + color: #597189; + font-size: 12px; + } + "))), + div( - style = "margin-top: 70px;", - shiny::actionButton( - ns("open_upload_modal"), - "Upload Signature", - icon = icon("upload"), - class = "btn-primary" + id = ns("signature_page"), + + div( + class = "signature-hero", + tags$h2("Browse Signatures"), + tags$p( + "Select a signature from the repository to review metadata, raw signature values, and differential expression in one place." + ) ), - br(), - h4(shiny::textOutput(ns("selected_signature_label"))), - - - shiny::div( - id = ns("action_buttons_group_toggle"), - style = "display: block;", # Initial state is hidden - shiny::actionButton(ns("view_btn"), "View"), - shiny::actionButton(ns("update_btn"), "Update"), - shiny::actionButton(ns("delete_btn"), "Delete"), - shiny::actionButton(ns("access_btn"), "Access"), - shiny::downloadButton(ns("download_btn"), "Download") + + div( + class = "signature-card", + div( + class = "signature-toolbar", + div( + class = "signature-toolbar-primary", + actionButton( + ns("open_upload_modal"), + "Upload Signature", + icon = icon("upload"), + class = "btn-primary" + ), + uiOutput(ns("basket_toggle")) + ), + uiOutput(ns("signature_actions")) + ), + p( + class = "signature-helper", + "Highlight one or more rows to add them to the basket. The most recently clicked row becomes the active selection, and View will load its full contents on demand." + ), + DT::DTOutput(ns("signature_tbl")) ), - - DT::DTOutput(ns("signature_tbl")) + + div( + class = "signature-card", + tags$h3("Selected Signature"), + p( + class = "signature-helper", + "Selecting a row updates the active signature. Use View to load the full metadata and data tables below." + ), + uiOutput(ns("signature_detail_panel")) + ) ) ) } - signature_module_server <- function(id, signature_db, user_conn_handler, signature_trigger) { moduleServer(id, function(input, output, session) { ns <- session$ns - - # Reactive Vals for signature - selected_sig <- reactiveVal(NULL) sig_object <- reactiveVal(NULL) - signature_update_trigger <- reactiveVal(NULL) - - # reactive vales for user acces and perms - - users_to_add <- reactiveVal(NULL) - user_perms <- reactiveVal(NULL) - - + access_user_tbl <- reactiveVal(NULL) + basket_signatures <- reactiveVal(data.frame()) + last_clicked_row <- reactiveVal(NULL) + current_sig <- reactive({ req(sig_object()) - sig_object()[[1]] # extract the first and only OmicSignature object + sig_object()[[1]] }) - - - - - # main signature_tbl + signature_field_value <- function(sig_df, field, default = "Not available") { + if (is.null(sig_df) || !field %in% names(sig_df)) { + return(default) + } + + value <- sig_df[[field]][1] + if (is.null(value) || is.na(value) || identical(as.character(value), "")) { + return(default) + } + + as.character(value) + } + + fetch_selected_signature <- function(sig_id) { + SigRepo::getSignature( + conn_handler = user_conn_handler(), + signature_id = sig_id + ) + } + output$signature_tbl <- renderDT({ df <- signature_db() - - # util function for datatable - + DatatableFX( df = df, - hidden_columns = c(0, 6, 7, 8, 9, 11,12, 14, 15, 16,18, 19,21,22, 24, 25, 26), + hidden_columns = c(0, 6, 7, 8, 9, 11, 12, 14, 15, 16, 18, 19, 21, 22, 24, 25, 26), scrollY = "500px", - row_selection = "single" - + row_selection = "multiple" ) }, server = TRUE) - - # signature_tbl - - output$signature_file_table <- DT::renderDataTable({ - - DatatableFX(current_sig()$signature, - scrollY = "500px") - }, server = TRUE) - - # difexp_tbl - - output$difexp_file_table <- DT::renderDataTable({ - - DatatableFX(current_sig()$difexp, - scrollY = "500px" - - ) - }, server = TRUE) - - # deugging - observeEvent(input$signature_tbl_rows_selected, { - print("Row selected") - + + observeEvent(input$signature_tbl_row_last_clicked, { + row <- input$signature_tbl_row_last_clicked + if (!is.null(row) && length(row) == 1) { + last_clicked_row(row) + } }) - - # using _rows_selected in shiny DT package + observeEvent(input$signature_tbl_rows_selected, { - shinyjs::show(ns(id = "action_buttons_group_toggle")) - print("toggle block") + rows <- input$signature_tbl_rows_selected + + if (length(rows) == 0) { + selected_sig(NULL) + sig_object(NULL) + last_clicked_row(NULL) + return() + } + + detail_row <- last_clicked_row() + if (is.null(detail_row) || !detail_row %in% rows) { + detail_row <- rows[[length(rows)]] + last_clicked_row(detail_row) + } + + df <- signature_db() + sig <- df[detail_row, , drop = FALSE] + selected_sig(sig) + sig_object(NULL) }) - - observeEvent(input$signature_tbl_rows_selected, { - - - df <- signature_db() - row <- input$signature_tbl_rows_selected - sig <- df[row,] - selected_sig(sig) - - # shinyjs::toggle(ns("action_buttons_group")) - - output$selected_signature_label <- renderText({ - sprintf("Actions for: %s", sig$signature_name) + + output$signature_actions <- renderUI({ + sig <- selected_sig() + + if (is.null(sig)) { + return( + div( + class = "signature-selected", + tags$span(class = "signature-label", "Selection"), + tags$span(class = "signature-name", "No signature selected") + ) + ) + } + + div( + class = "signature-toolbar", + div( + class = "signature-selected", + tags$span(class = "signature-label", "Selected Signature"), + tags$span(class = "signature-name", signature_field_value(sig, "signature_name")) + ), + div( + class = "signature-actions", + actionButton(ns("view_btn"), "View", class = "btn-primary"), + actionButton(ns("add_selected_to_basket_btn"), "Add Selected Rows"), + actionButton(ns("add_to_basket_btn"), "Add to Basket"), + actionButton(ns("update_btn"), "Update"), + actionButton(ns("delete_btn"), "Delete"), + actionButton(ns("access_btn"), "Access"), + downloadButton(ns("download_btn"), "Download") + ) + ) }) - - }) - - # === View Button Clicked === - observeEvent(input$view_btn, { - req(selected_sig()) - - sig_id <- selected_sig()$signature_id - - # Fetch the signature - sig <- SigRepo::getSignature( - conn_handler = user_conn_handler(), - signature_id = sig_id + output$basket_toggle <- renderUI({ + basket_df <- basket_signatures() + + div( + actionButton( + ns("open_basket_btn"), + label = sprintf( + "Basket (%s)", + nrow(basket_df) + ), + icon = icon("shopping-basket") + ) ) - str(sig) - - # Store in reactiveVal - sig_object(sig) - - - }) - - #### Show Modal when sig_object is ready #### - observeEvent(sig_object(), { - req(current_sig()) - - showModal( - modalDialog( - title = paste("Signature:", selected_sig()$signature_name), - size = "l", - easyClose = TRUE, - footer = modalButton("Close"), - tabsetPanel( - tabPanel("Metadata", - uiOutput(ns("signature_metadata")) + + output$basket_actions <- renderUI({ + div( + class = "signature-basket-actions", + actionButton(ns("remove_from_basket_btn"), "Remove Last"), + actionButton(ns("clear_basket_btn"), "Clear Basket"), + downloadButton(ns("download_basket_btn"), "Download Basket") + ) + }) + + output$basket_list <- renderUI({ + basket_df <- basket_signatures() + + if (is.null(basket_df) || nrow(basket_df) == 0) { + return( + div( + class = "signature-empty", + "No signatures in the basket yet." + ) + ) + } + + basket_items <- lapply(seq_len(nrow(basket_df)), function(i) { + sig <- basket_df[i, , drop = FALSE] + + div( + class = "signature-basket-item", + div( + class = "signature-basket-item-main", + tags$span( + class = "signature-basket-item-title", + signature_field_value(sig, "signature_name") ), - tabPanel("Signature", - DTOutput(ns("signature_file_table")) + tags$span( + class = "signature-basket-item-meta", + paste( + signature_field_value(sig, "user_name", "Unknown owner"), + "|", + signature_field_value(sig, "visibility", "Unknown visibility"), + "|", + signature_field_value(sig, "date_created", "Unknown date") + ) + ) + ), + actionButton( + ns(paste0("remove_basket_item_", i)), + "Remove", + class = "btn-default btn-sm" + ) + ) + }) + + div( + class = "signature-basket-list", + basket_items + ) + }) + + output$signature_detail_panel <- renderUI({ + sig <- selected_sig() + + if (is.null(sig)) { + return( + div( + class = "signature-empty", + "Choose a signature from the table above to inspect it." + ) + ) + } + + if (is.null(sig_object())) { + return( + tagList( + div( + class = "signature-summary-grid", + div( + class = "signature-summary-item", + tags$strong("Signature"), + tags$span(signature_field_value(sig, "signature_name")) + ), + div( + class = "signature-summary-item", + tags$strong("Owner"), + tags$span(signature_field_value(sig, "user_name")) + ), + div( + class = "signature-summary-item", + tags$strong("Visibility"), + tags$span(signature_field_value(sig, "visibility")) + ), + div( + class = "signature-summary-item", + tags$strong("Created"), + tags$span(signature_field_value(sig, "date_created")) + ) ), - tabPanel("Differential Expression", - DTOutput(ns("difexp_file_table")) + div( + class = "signature-empty", + "The selected signature has not been loaded yet. Click View to fetch its metadata and data tables." ) ) ) + } + + tagList( + div( + class = "signature-summary-grid", + div( + class = "signature-summary-item", + tags$strong("Signature"), + tags$span(signature_field_value(sig, "signature_name")) + ), + div( + class = "signature-summary-item", + tags$strong("Owner"), + tags$span(signature_field_value(sig, "user_name")) + ), + div( + class = "signature-summary-item", + tags$strong("Visibility"), + tags$span(signature_field_value(sig, "visibility")) + ), + div( + class = "signature-summary-item", + tags$strong("Created"), + tags$span(signature_field_value(sig, "date_created")) + ) + ), + tabsetPanel( + tabPanel( + "Metadata", + div(class = "signature-metadata-table", DT::DTOutput(session$ns("signature_metadata_table"))) + ), + tabPanel("Signature", DT::DTOutput(session$ns("signature_file_table"))), + tabPanel("Differential Expression", DT::DTOutput(session$ns("difexp_file_table"))) + ) ) }) - - - # Metadata UI - output$signature_metadata <- renderUI({ + + output$signature_metadata_table <- DT::renderDataTable({ req(selected_sig()) - - + sig <- selected_sig() - - # transpose row df <- data.frame( Field = names(sig), - Value = unlist(sig[1,], use.names = FALSE), + Value = unlist(sig[1, ], use.names = FALSE), stringsAsFactors = FALSE ) - - - - - # rendering to a datatable - - DatatableFX(df, - rownames = TRUE) - + + DatatableFX( + df, + hidden_columns = integer(0), + scrollY = "360px" + ) + }, server = TRUE) + + output$signature_file_table <- DT::renderDataTable({ + req(current_sig()) + + DatatableFX( + current_sig()$signature, + hidden_columns = integer(0), + scrollY = "500px" + ) + }, server = TRUE) + + output$difexp_file_table <- DT::renderDataTable({ + req(current_sig()) + + DatatableFX( + current_sig()$difexp, + hidden_columns = integer(0), + scrollY = "500px" + ) + }, server = TRUE) + + observeEvent(input$view_btn, { + req(selected_sig()) + + tryCatch({ + sig_object(fetch_selected_signature(selected_sig()$signature_id[[1]])) + showNotification("Signature details loaded.", type = "message") + }, error = function(e) { + showNotification( + paste("Failed to load signature details:", e$message), + type = "error", + duration = 8 + ) + }) + }) + + observeEvent(input$add_to_basket_btn, { + req(selected_sig()) + + basket_df <- basket_signatures() + sig <- selected_sig() + + if (is.null(basket_df) || nrow(basket_df) == 0) { + basket_signatures(sig) + showNotification("Signature added to basket.", type = "message") + return() + } + + if (sig$signature_id[[1]] %in% basket_df$signature_id) { + showNotification("That signature is already in the basket.", type = "warning") + return() + } + + basket_signatures(rbind(basket_df, sig)) + showNotification("Signature added to basket.", type = "message") + }) + + observeEvent(input$add_selected_to_basket_btn, { + selected_rows <- input$signature_tbl_rows_selected + df <- signature_db() + + if (length(selected_rows) == 0) { + showNotification("Highlight one or more signature rows first.", type = "warning") + return() + } + + selected_df <- df[selected_rows, , drop = FALSE] + basket_df <- basket_signatures() + + if (is.null(basket_df) || nrow(basket_df) == 0) { + basket_signatures(selected_df) + showNotification(sprintf("%s signature(s) added to basket.", nrow(selected_df)), type = "message") + return() + } + + new_rows <- selected_df[!selected_df$signature_id %in% basket_df$signature_id, , drop = FALSE] + + if (nrow(new_rows) == 0) { + showNotification("All highlighted signatures are already in the basket.", type = "warning") + return() + } + + basket_signatures(rbind(basket_df, new_rows)) + showNotification(sprintf("%s signature(s) added to basket.", nrow(new_rows)), type = "message") + }) + + observeEvent(input$open_basket_btn, { + showModal( + modalDialog( + title = "Download Basket", + size = "l", + easyClose = TRUE, + footer = modalButton("Close"), + p( + class = "signature-helper", + "Review the current basket, remove items if needed, or download everything together as a zip archive." + ), + uiOutput(ns("basket_actions")), + uiOutput(ns("basket_list")) + ) + ) + }) + + observeEvent(input$remove_from_basket_btn, { + basket_df <- basket_signatures() + + if (is.null(basket_df) || nrow(basket_df) == 0) { + showNotification("The basket is already empty.", type = "warning") + return() + } + + basket_signatures(basket_df[-nrow(basket_df), , drop = FALSE]) + showNotification("Removed the most recent signature from the basket.", type = "message") + }) + + observeEvent(input$clear_basket_btn, { + basket_signatures(data.frame()) + showNotification("Basket cleared.", type = "message") + }) + + observe({ + basket_df <- basket_signatures() + if (is.null(basket_df) || nrow(basket_df) == 0) { + return() + } + + lapply(seq_len(nrow(basket_df)), function(i) { + observeEvent(input[[paste0("remove_basket_item_", i)]], { + current_basket <- basket_signatures() + if (!is.null(current_basket) && nrow(current_basket) >= i) { + basket_signatures(current_basket[-i, , drop = FALSE]) + showNotification("Signature removed from basket.", type = "message") + } + }, ignoreInit = TRUE) + }) }) - - - - - - ### upload signature logic observeEvent(input$open_upload_modal, { - showModal(upload_modal_ui(ns, type = "Signature")) + showModal(upload_modal_ui(session$ns, type = "Signature")) }) - - + observeEvent(input$upload_btn, { req(input$upload_file) - + tryCatch({ rds_object <- readRDS(input$upload_file$datapath) - - SigRepo::addSignature(conn_handler = user_conn_handler(), omic_signature = rds_object) - + + SigRepo::addSignature( + conn_handler = user_conn_handler(), + omic_signature = rds_object + ) + showNotification("Signature uploaded and added successfully!") - - - # Trigger reactive update after upload signature_trigger(isolate(signature_trigger()) + 1) - }, error = function(e) { - showNotification(paste( - "Error reading or uploading signature rds object", - ":", - e$message - ), - type = "error") + showNotification( + paste("Error reading or uploading signature rds object:", e$message), + type = "error" + ) }) - + removeModal() }) - - # delete signature logic #### - observeEvent(input$delete_btn,{ - - sig_name <- selected_sig()$signature_name - - # delete signature modal + + observeEvent(input$delete_btn, { + req(selected_sig()) + showModal( - delete_modal_ui(ns, type = "Signature", name = sig_name) + delete_modal_ui( + session$ns, + type = "Signature", + name = selected_sig()$signature_name[[1]] + ) ) - }) - - # delete signature logic + observeEvent(input$confirm_delete_signature, { - req(selected_sig()) # ensure selection exists - - sig_id <- selected_sig()$signature_id - + req(selected_sig()) + + sig_id <- selected_sig()$signature_id[[1]] + tryCatch({ - result <- SigRepo::deleteSignature( + SigRepo::deleteSignature( conn_handler = user_conn_handler(), signature_id = sig_id ) - + showNotification("Signature deleted successfully.", type = "message") - - # close the modal removeModal() - - # Trigger table refresh + selected_sig(NULL) + sig_object(NULL) signature_trigger(signature_trigger() + 1) - }, error = function(e) { - - # Print to console for developer message("Error deleting signature: ", e$message) - - # Keep modal open on error and show error notification showNotification( paste("Failed to delete signature:", e$message), type = "error", @@ -276,73 +702,92 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu ) }) }) - - - # update signature logic ### - + observeEvent(input$update_btn, { - - sig_id <- selected_sig()$signature_id - sig_name <- selected_sig()$signature_name - + req(selected_sig()) + + sig_name <- selected_sig()$signature_name[[1]] + showModal(modalDialog( title = "Update signature", paste("Signature to update:", sig_name), - fileInput(ns("update_file_upload"), paste("Choose an RDS file"), accept = ".rds"), - p("How it works: the selected signature will be updated with the new signature object you added to the file input"), + fileInput(session$ns("update_file_upload"), "Choose an RDS file", accept = ".rds"), + p("The selected signature will be updated with the new signature object you upload."), footer = tagList( modalButton("Cancel") ) )) }) - - # manage user modal - + observeEvent(input$access_btn, { - - sig_id <- selected_sig()$signature_id - sig_name <- selected_sig()$signature_name + req(selected_sig()) + user_tbl <- SigRepo::searchUser(conn_handler = user_conn_handler()) - - # manage user modal for signature - showModal(manage_users_modal_ui(ns, name = sig_name, user_tbl = user_tbl)) - + access_user_tbl(user_tbl) + + showModal( + manage_users_modal_ui( + session$ns, + name = selected_sig()$signature_name[[1]], + user_tbl = user_tbl + ) + ) }) - - # add users to signature with their perms - + observeEvent(input$confirm_add_users, { - - # name, user_tbl, type, selected, user_conn_handler - - manage_users_modal_server(ns, input, output, session, name = sig_name, type = "Signature", user_tbl = user_tbl, user_conn_handler = user_conn_handler ) + req(selected_sig(), access_user_tbl()) + + manage_users_modal_server( + input = input, + output = output, + session = session, + name = selected_sig()$signature_name[[1]], + user_tbl = access_user_tbl(), + type = "Signature", + selected = reactive(selected_sig()), + user_conn_handler = user_conn_handler + ) }) - - - # download omic signature object - + output$download_btn <- downloadHandler( filename = function() { - paste0("signature_", selected_sig()$signature_name, ".rds") + req(selected_sig()) + paste0("signature_", selected_sig()$signature_name[[1]], ".rds") }, content = function(file) { req(selected_sig()) - - sig_object <- getSignature( - conn_handler = user_conn_handler(), - signature_id = selected_sig()$signature_id - ) - - saveRDS(sig_object, file) + + sig_download <- fetch_selected_signature(selected_sig()$signature_id[[1]]) + saveRDS(sig_download, file) + } + ) + + output$download_basket_btn <- downloadHandler( + filename = function() { + paste0("signature_basket_", format(Sys.Date(), "%Y%m%d"), ".zip") + }, + content = function(file) { + basket_df <- basket_signatures() + req(!is.null(basket_df), nrow(basket_df) > 0) + + export_dir <- file.path(tempdir(), paste0("signature_basket_", as.integer(Sys.time()))) + dir.create(export_dir, recursive = TRUE, showWarnings = FALSE) + + exported_files <- character(0) + + for (i in seq_len(nrow(basket_df))) { + sig_id <- basket_df$signature_id[[i]] + sig_name <- basket_df$signature_name[[i]] + sig_download <- fetch_selected_signature(sig_id) + + safe_name <- gsub("[^A-Za-z0-9_-]", "_", sig_name) + out_file <- file.path(export_dir, paste0("signature_", safe_name, ".rds")) + saveRDS(sig_download, out_file) + exported_files <- c(exported_files, out_file) + } + + utils::zip(zipfile = file, files = exported_files, flags = "-j") } ) - - - - - - }) ## ending bracket - - - + }) }