From 620914d4c827e1f94f881d753240eddfda863a8c Mon Sep 17 00:00:00 2001 From: Cvicnaire Date: Tue, 5 May 2026 14:56:39 -0400 Subject: [PATCH] PR to address collection page update. It now reflects the same functionalities as the signature page. Also, added a prototype "create signature from difexp" option. This will allow users to create a signature in the shiny app. --- shiny/modules/collection_module.R | 248 +++++++---- shiny/modules/signature_module.R | 689 +++++++++++++++++++++++++++++- 2 files changed, 827 insertions(+), 110 deletions(-) diff --git a/shiny/modules/collection_module.R b/shiny/modules/collection_module.R index 914b7c9..c89fc85 100644 --- a/shiny/modules/collection_module.R +++ b/shiny/modules/collection_module.R @@ -56,6 +56,13 @@ collection_module_ui <- function(id) { margin-bottom: 16px; } + ", page_selector, " .collection-toolbar-primary { + display: flex; + align-items: center; + gap: 10px; + flex-wrap: wrap; + } + ", page_selector, " .collection-actions { display: flex; gap: 10px; @@ -124,6 +131,10 @@ collection_module_ui <- function(id) { margin-bottom: 14px; color: #597189; } + + ", page_selector, " .collection-metadata-table .dataTables_wrapper { + margin-top: 8px; + } "))), div( @@ -133,7 +144,7 @@ collection_module_ui <- function(id) { class = "collection-hero", tags$h2("Browse Collections"), tags$p( - "Select a collection to review its metadata and included signatures without opening a separate dialog." + "Select a collection from the repository to review metadata, member signatures, and collection-level details in one place." ) ), @@ -141,14 +152,21 @@ collection_module_ui <- function(id) { class = "collection-card", div( class = "collection-toolbar", - actionButton( - ns("open_upload_modal"), - "Upload Collection", - icon = icon("upload"), - class = "btn-primary" + div( + class = "collection-toolbar-primary", + actionButton( + ns("open_upload_modal"), + "Upload Collection", + icon = icon("upload"), + class = "btn-primary" + ) ), uiOutput(ns("collection_actions")) ), + p( + class = "collection-helper", + "Select a collection row to make it active. Use View to load the full collection details when you want to inspect it below." + ), DT::DTOutput(ns("collection_tbl")) ), @@ -157,7 +175,7 @@ collection_module_ui <- function(id) { 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." + "The active collection summary appears immediately. Use View to fetch the collection details and member signatures on demand." ), uiOutput(ns("collection_detail_panel")) ) @@ -167,6 +185,7 @@ collection_module_ui <- function(id) { collection_module_server <- function(id, collection_db, user_conn_handler, collection_trigger) { moduleServer(id, function(input, output, session) { + ns <- session$ns selected_collection <- reactiveVal(NULL) collection_object <- reactiveVal(NULL) @@ -190,12 +209,10 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle ) } - df_grouped <- reactive({ + grouped_collections <- reactive({ req(user_conn_handler()) - df <- collection_db() - - df %>% + collection_db() %>% dplyr::group_by( collection_id, collection_name, @@ -206,42 +223,41 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle ) %>% dplyr::summarise( signature_count = dplyr::n(), - signatures = paste(signature_name, collapse = ", "), + signature_preview = paste(utils::head(signature_name, 5), collapse = ", "), .groups = "drop" ) }) + current_collection_signatures <- reactive({ + req(selected_collection(), collection_db()) + + collection_db()[ + collection_db()$collection_id == selected_collection()$collection_id[[1]], + , + drop = FALSE + ] + }) + output$collection_tbl <- renderDT({ DatatableFX( - df = df_grouped(), + df = grouped_collections(), + hidden_columns = c(0, 7), scrollY = "500px", row_selection = "single" ) }, server = TRUE) observeEvent(input$collection_tbl_rows_selected, { - row <- input$collection_tbl_rows_selected + rows <- input$collection_tbl_rows_selected - if (length(row) == 0) { + if (length(rows) == 0) { selected_collection(NULL) collection_object(NULL) return() } - df <- df_grouped() - collection_selected <- df[row, , drop = FALSE] - selected_collection(collection_selected) - - 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 - ) - }) + selected_collection(grouped_collections()[rows, , drop = FALSE]) + collection_object(NULL) }) output$collection_actions <- renderUI({ @@ -266,6 +282,7 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle ), div( class = "collection-actions", + actionButton(ns("view_btn"), "View", class = "btn-primary"), actionButton(ns("refresh_btn"), "Refresh"), actionButton(ns("update_btn"), "Update"), actionButton(ns("delete_btn"), "Delete"), @@ -282,7 +299,41 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle return( div( class = "collection-empty", - "Choose a collection from the table above to inspect its metadata and included signatures." + "Choose a collection from the table above to inspect it." + ) + ) + } + + if (is.null(collection_object())) { + return( + 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")) + ) + ), + div( + class = "collection-empty", + "The selected collection has not been loaded yet. Click View to fetch its metadata and member signatures." + ) ) ) } @@ -312,38 +363,68 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle ) ), tabsetPanel( - tabPanel("Metadata", uiOutput(session$ns("collection_metadata"))), - tabPanel("Signatures", DT::DTOutput(session$ns("collection_sig_tbl"))) + tabPanel( + "Metadata", + div(class = "collection-metadata-table", DT::DTOutput(ns("collection_metadata_table"))) + ), + tabPanel( + "Signatures", + DT::DTOutput(ns("collection_sig_tbl")) + ) ) ) }) - output$collection_metadata <- renderUI({ + output$collection_metadata_table <- DT::renderDataTable({ req(selected_collection()) - tagList( - 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")) + collection_selected <- selected_collection() + metadata_df <- data.frame( + Field = c("collection_id", names(collection_selected)[names(collection_selected) != "collection_id"]), + Value = c( + collection_selected$collection_id[[1]], + vapply( + names(collection_selected)[names(collection_selected) != "collection_id"], + function(field) collection_field_value(collection_selected, field), + character(1) + ) + ), + stringsAsFactors = FALSE ) - }) - output$collection_sig_tbl <- renderDataTable({ - req(selected_collection(), collection_db()) + DatatableFX( + metadata_df, + hidden_columns = integer(0), + scrollY = "360px" + ) + }, server = TRUE) - filtered_collection_tbl <- collection_db()[ - collection_db()$collection_name == selected_collection()$collection_name[[1]], - , - drop = FALSE - ] + output$collection_sig_tbl <- DT::renderDataTable({ + req(selected_collection(), collection_object()) DatatableFX( - filtered_collection_tbl, - hidden_columns = c(3, 4) + current_collection_signatures(), + hidden_columns = c(3, 4), + scrollY = "500px" ) }, server = TRUE) + observeEvent(input$view_btn, { + req(selected_collection()) + + tryCatch({ + collection_object(fetch_selected_collection(selected_collection()$collection_id[[1]])) + showNotification("Collection details loaded.", type = "message") + }, error = function(e) { + collection_object(NULL) + showNotification( + paste("Failed to load collection details:", e$message), + type = "error", + duration = 8 + ) + }) + }) + observeEvent(input$refresh_btn, { req(selected_collection()) @@ -374,7 +455,7 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle omic_collection = rds_object ) - showNotification("Collection uploaded and added successfully!") + showNotification("Collection uploaded and added successfully!", type = "message") collection_trigger(isolate(collection_trigger()) + 1) }, error = function(e) { showNotification( @@ -392,11 +473,11 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle showModal( modalDialog( title = "Confirm Delete", - paste( - "Are you sure you want to delete collection:", - selected_collection()$collection_name[[1]], - "?" + sprintf( + "Are you sure you want to delete collection %s?", + htmltools::htmlEscape(selected_collection()$collection_name[[1]]) ), + easyClose = TRUE, footer = tagList( modalButton("Cancel"), actionButton(ns("confirm_delete_collection"), "Delete", class = "btn-danger") @@ -420,9 +501,8 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle removeModal() selected_collection(NULL) collection_object(NULL) - collection_trigger(collection_trigger() + 1) + collection_trigger(isolate(collection_trigger()) + 1) }, error = function(e) { - message("Error deleting collection: ", e$message) showNotification( paste("Failed to delete collection:", e$message), type = "error", @@ -434,51 +514,33 @@ collection_module_server <- function(id, collection_db, user_conn_handler, colle observeEvent(input$update_btn, { req(selected_collection()) - collection_name <- selected_collection()$collection_name[[1]] - - showModal(modalDialog( - title = "Update collection", - paste("Collection to update:", collection_name), - 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") + showModal( + modalDialog( + title = "Update Collection", + paste("Collection to update:", selected_collection()$collection_name[[1]]), + 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") + ) ) - )) + ) }) observeEvent(input$access_btn, { req(selected_collection()) - user_tbl <- SigRepo::searchUser(conn_handler = user_conn_handler()) - - showModal(modalDialog( - 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, - multiple = TRUE - ) - ) - ), - uiOutput("access_type_ui"), - actionButton("add_users_confirm", "Add Users", class = "btn-primary") - ), - tabPanel( - "Delete from Collection", - p("Delete user functionality goes here.") + showModal( + modalDialog( + title = paste("Collection Access:", selected_collection()$collection_name[[1]]), + easyClose = TRUE, + footer = modalButton("Close"), + div( + class = "collection-helper", + "Collection access management is still collection-specific and has not been modernized yet in this refactor." ) - ), - easyClose = TRUE, - footer = modalButton("Close") - )) + ) + ) }) output$download_btn <- downloadHandler( diff --git a/shiny/modules/signature_module.R b/shiny/modules/signature_module.R index ebe03a2..3b07286 100644 --- a/shiny/modules/signature_module.R +++ b/shiny/modules/signature_module.R @@ -175,6 +175,33 @@ signature_module_ui <- function(id) { color: #597189; font-size: 12px; } + + ", page_selector, " .signature-create-grid { + display: grid; + grid-template-columns: repeat(2, minmax(0, 1fr)); + gap: 14px; + } + + ", page_selector, " .signature-create-grid .form-group { + margin-bottom: 0; + } + + ", page_selector, " .signature-create-section { + margin-top: 18px; + padding-top: 18px; + border-top: 1px solid #e1ebf2; + } + + ", page_selector, " .signature-create-section h4 { + margin-top: 0; + margin-bottom: 10px; + color: #17324d; + } + + ", page_selector, " .signature-create-help { + margin-bottom: 12px; + color: #597189; + } "))), div( @@ -194,6 +221,11 @@ signature_module_ui <- function(id) { class = "signature-toolbar", div( class = "signature-toolbar-primary", + actionButton( + ns("open_create_modal"), + "Create Signature", + icon = icon("plus-circle") + ), actionButton( ns("open_upload_modal"), "Upload Signature", @@ -229,14 +261,18 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu moduleServer(id, function(input, output, session) { ns <- session$ns selected_sig <- reactiveVal(NULL) - sig_object <- reactiveVal(NULL) + signature_feature_set <- reactiveVal(NULL) + signature_difexp <- reactiveVal(NULL) access_user_tbl <- reactiveVal(NULL) basket_signatures <- reactiveVal(data.frame()) last_clicked_row <- reactiveVal(NULL) + create_upload_df <- reactiveVal(NULL) + create_upload_error <- reactiveVal(NULL) + create_detected_columns <- reactiveVal(NULL) - current_sig <- reactive({ - req(sig_object()) - sig_object()[[1]] + current_signature_feature_set <- reactive({ + req(signature_feature_set()) + signature_feature_set() }) signature_field_value <- function(sig_df, field, default = "Not available") { @@ -259,6 +295,327 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu ) } + fetch_signature_feature_set <- function(sig_id) { + feature_set <- SigRepo::getSignatureFeatureSet( + conn_handler = user_conn_handler(), + signature_id = sig_id + ) + + if (is.list(feature_set) && length(feature_set) == 1 && is.data.frame(feature_set[[1]])) { + return(feature_set[[1]]) + } + + feature_set + } + + empty_string_to_null <- function(x) { + if (is.null(x)) { + return(NULL) + } + + x <- trimws(as.character(x)) + if (!nzchar(x)) { + return(NULL) + } + + x + } + + parse_optional_numeric <- function(x) { + x <- empty_string_to_null(x) + if (is.null(x)) { + return(NULL) + } + + suppressWarnings(as.numeric(x)) + } + + guess_column <- function(columns, candidates) { + if (length(columns) == 0) { + return("") + } + + normalized_columns <- tolower(gsub("[^a-z0-9]+", "", columns)) + normalized_candidates <- tolower(gsub("[^a-z0-9]+", "", candidates)) + match_idx <- match(normalized_candidates, normalized_columns, nomatch = 0) + match_idx <- match_idx[match_idx > 0] + + if (length(match_idx) == 0) { + return("") + } + + columns[[match_idx[[1]]]] + } + + normalize_column_name <- function(x) { + tolower(gsub("[^a-z0-9]+", "", x)) + } + + auto_detect_column_mapping <- function(df, source_type) { + columns <- names(df) + normalized_columns <- stats::setNames(columns, normalize_column_name(columns)) + + get_detected <- function(candidates) { + candidate_idx <- match(normalize_column_name(candidates), names(normalized_columns), nomatch = 0) + candidate_idx <- candidate_idx[candidate_idx > 0] + + if (length(candidate_idx) == 0) { + return(NULL) + } + + unname(normalized_columns[[candidate_idx[[1]]]]) + } + + mapping <- list( + feature_name = get_detected(c( + "feature_name", "gene", "gene_name", "genes", "symbol", "external_gene_name", + "hgnc_symbol", "mgi_symbol", "ensembl", "ensembl_gene_id", "entrez", "entrezgene" + )), + symbol = get_detected(c( + "symbol", "gene_symbol", "hgnc_symbol", "mgi_symbol", "gene", "gene_name", "external_gene_name" + )), + probe_id = get_detected(c( + "probe_id", "probe", "entrez_id", "gene_id", "ensembl", "ensembl_gene_id" + )), + score = get_detected(c( + "score", "stat", "t", "t_stat", "tstat", "waldstat", "wald", "zscore", "z", + "signedlogp", "signed_log_p", "rank_score", "logfc", "log2foldchange", "logfoldchange" + )), + logfc = get_detected(c( + "logfc", "log2foldchange", "logfoldchange", "avg_log2fc", "foldchange", "lfc" + )), + adj_p = get_detected(c( + "adj_p", "padj", "adjp", "adjpval", "adjpvalue", "adjpval", "adjpvalue", + "adjpvalfdr", "fdr", "qvalue", "adjpvalbh", "adjpvalbonf", "adjpvalholm", + "adj.P.Val" + )), + p_value = get_detected(c( + "p_value", "pvalue", "pval", "p", "P.Value" + )), + group_label = get_detected(c( + "group_label", "group", "label", "contrast", "comparison", "subset" + )), + direction = get_detected(c( + "direction", "sign", "regulation" + )) + ) + + replaced_names <- suppressWarnings(OmicSignature::replaceDifexpCol(columns)) + if (length(replaced_names) == length(columns)) { + for (i in seq_along(columns)) { + canonical_name <- replaced_names[[i]] + if (canonical_name %in% names(mapping) && is.null(mapping[[canonical_name]])) { + mapping[[canonical_name]] <- columns[[i]] + } + } + } + + if (identical(source_type, "signature")) { + if (is.null(mapping$feature_name) && !is.null(mapping$symbol)) { + mapping$feature_name <- mapping$symbol + } + } + + mapping + } + + parse_uploaded_csv <- function(file_info) { + req(file_info) + utils::read.csv( + file_info$datapath, + stringsAsFactors = FALSE, + check.names = FALSE + ) + } + + build_metadata_list <- function() { + keywords_value <- empty_string_to_null(input$create_keywords) + others_text <- empty_string_to_null(input$create_other_metadata) + others_list <- NULL + + if (!is.null(others_text)) { + parsed_pairs <- strsplit(others_text, "\n", fixed = TRUE)[[1]] + parsed_pairs <- trimws(parsed_pairs) + parsed_pairs <- parsed_pairs[nzchar(parsed_pairs)] + + if (length(parsed_pairs) > 0) { + pair_list <- lapply(parsed_pairs, function(line) { + parts <- strsplit(line, "=", fixed = TRUE)[[1]] + if (length(parts) < 2) { + stop("Additional metadata must use one key=value pair per line.") + } + + key <- trimws(parts[[1]]) + value <- trimws(paste(parts[-1], collapse = "=")) + + if (!nzchar(key) || !nzchar(value)) { + stop("Additional metadata keys and values cannot be blank.") + } + + stats::setNames(list(value), key) + }) + + others_list <- unlist(pair_list, recursive = FALSE, use.names = TRUE) + } + } + + metadata <- list( + signature_name = empty_string_to_null(input$create_signature_name), + organism = empty_string_to_null(input$create_organism), + direction_type = empty_string_to_null(input$create_direction_type), + assay_type = empty_string_to_null(input$create_assay_type), + phenotype = empty_string_to_null(input$create_phenotype), + covariates = empty_string_to_null(input$create_covariates), + description = empty_string_to_null(input$create_description), + platform = empty_string_to_null(input$create_platform), + sample_type = empty_string_to_null(input$create_sample_type), + logfc_cutoff = parse_optional_numeric(input$create_logfc_cutoff), + p_value_cutoff = parse_optional_numeric(input$create_p_value_cutoff), + adj_p_cutoff = parse_optional_numeric(input$create_adj_p_cutoff), + score_cutoff = parse_optional_numeric(input$create_score_cutoff), + keywords = if (!is.null(keywords_value)) trimws(strsplit(keywords_value, ",", fixed = TRUE)[[1]]) else NULL, + cutoff_description = empty_string_to_null(input$create_cutoff_description), + author = empty_string_to_null(input$create_author), + PMID = parse_optional_numeric(input$create_pmid), + year = parse_optional_numeric(input$create_year), + others = others_list + ) + + required_fields <- c("signature_name", "organism", "direction_type", "assay_type", "phenotype") + missing_fields <- required_fields[vapply(metadata[required_fields], is.null, logical(1))] + + if (length(missing_fields) > 0) { + stop(sprintf("Missing required metadata: %s", paste(missing_fields, collapse = ", "))) + } + + if (!is.null(metadata$keywords)) { + metadata$keywords <- metadata$keywords[nzchar(metadata$keywords)] + if (length(metadata$keywords) == 0) { + metadata$keywords <- NULL + } + } + + metadata + } + + standardize_uploaded_table <- function(df, source_type) { + col_mapping <- auto_detect_column_mapping(df, source_type = source_type) + create_detected_columns(col_mapping) + + renamed_df <- data.frame(stringsAsFactors = FALSE) + + for (target_name in names(col_mapping)) { + source_name <- col_mapping[[target_name]] + if (!is.null(source_name) && nzchar(source_name) && source_name %in% names(df)) { + renamed_df[[target_name]] <- df[[source_name]] + } + } + + if (!"feature_name" %in% names(renamed_df)) { + stop("Could not automatically detect a feature column. Expected something like gene, gene_name, symbol, or ensembl.") + } + + renamed_df$feature_name <- as.character(renamed_df$feature_name) + renamed_df <- renamed_df[!is.na(renamed_df$feature_name) & nzchar(renamed_df$feature_name), , drop = FALSE] + + if (nrow(renamed_df) == 0) { + stop("The uploaded file did not contain any valid feature rows after column mapping.") + } + + if ("symbol" %in% names(renamed_df)) { + renamed_df$symbol <- as.character(renamed_df$symbol) + } + + if ("group_label" %in% names(renamed_df)) { + renamed_df$group_label <- as.character(renamed_df$group_label) + } + + numeric_cols <- intersect(c("score", "logfc", "adj_p", "p_value"), names(renamed_df)) + for (col_name in numeric_cols) { + renamed_df[[col_name]] <- suppressWarnings(as.numeric(renamed_df[[col_name]])) + } + + if (identical(source_type, "difexp") && !"score" %in% names(renamed_df)) { + stop("Could not automatically detect a score or ranking column. Expected something like stat, t, score, or logFC.") + } + + if (identical(source_type, "signature")) { + if (!"score" %in% names(renamed_df) && !"direction" %in% names(renamed_df)) { + stop("Could not automatically detect score or direction columns for the signature CSV.") + } + + if (!"score" %in% names(renamed_df) && "direction" %in% names(renamed_df)) { + direction_values <- trimws(as.character(renamed_df$direction)) + renamed_df$score <- ifelse(direction_values %in% c("-", "down", "Down", "DOWN"), -1, 1) + } + } + + renamed_df + } + + build_signature_from_difexp <- function(difexp_df, metadata) { + working_df <- difexp_df + keep_rows <- rep(TRUE, nrow(working_df)) + + if (!is.null(metadata$score_cutoff) && "score" %in% names(working_df)) { + keep_rows <- keep_rows & !is.na(working_df$score) & abs(working_df$score) >= metadata$score_cutoff + } + + if (!is.null(metadata$adj_p_cutoff) && "adj_p" %in% names(working_df)) { + keep_rows <- keep_rows & !is.na(working_df$adj_p) & working_df$adj_p <= metadata$adj_p_cutoff + } + + if (!is.null(metadata$p_value_cutoff) && "p_value" %in% names(working_df)) { + keep_rows <- keep_rows & !is.na(working_df$p_value) & working_df$p_value <= metadata$p_value_cutoff + } + + if (!is.null(metadata$logfc_cutoff) && "logfc" %in% names(working_df)) { + keep_rows <- keep_rows & !is.na(working_df$logfc) & abs(working_df$logfc) >= metadata$logfc_cutoff + } + + signature_df <- working_df[keep_rows, , drop = FALSE] + + if (nrow(signature_df) == 0) { + stop("The selected cutoffs produced an empty signature. Relax the thresholds or verify the mapped columns.") + } + + signature_df$direction <- ifelse(signature_df$score >= 0, "+", "-") + signature_cols <- intersect(c("probe_id", "feature_name", "symbol", "score", "direction", "group_label"), names(signature_df)) + signature_df[, signature_cols, drop = FALSE] + } + + build_signature_object_from_modal <- function() { + metadata <- build_metadata_list() + source_type <- input$create_source_type + uploaded_df <- create_upload_df() + + if (is.null(uploaded_df) || !is.data.frame(uploaded_df) || nrow(uploaded_df) == 0) { + stop("Upload a CSV file before creating the signature.") + } + + standardized_df <- standardize_uploaded_table(uploaded_df, source_type = source_type) + + if (identical(source_type, "difexp")) { + difexp_df <- standardized_df + signature_df <- build_signature_from_difexp(difexp_df, metadata) + } else { + signature_df <- standardized_df + if ("score" %in% names(signature_df) && !"direction" %in% names(signature_df)) { + signature_df$direction <- ifelse(signature_df$score >= 0, "+", "-") + } + + signature_cols <- intersect(c("probe_id", "feature_name", "symbol", "score", "direction", "group_label"), names(signature_df)) + signature_df <- signature_df[, signature_cols, drop = FALSE] + difexp_df <- NULL + } + + OmicSignature::OmicSignature$new( + metadata = metadata, + signature = signature_df, + difexp = difexp_df + ) + } + output$signature_tbl <- renderDT({ df <- signature_db() @@ -282,7 +639,8 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu if (length(rows) == 0) { selected_sig(NULL) - sig_object(NULL) + signature_feature_set(NULL) + signature_difexp(NULL) last_clicked_row(NULL) return() } @@ -296,7 +654,8 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu df <- signature_db() sig <- df[detail_row, , drop = FALSE] selected_sig(sig) - sig_object(NULL) + signature_feature_set(NULL) + signature_difexp(NULL) }) output$signature_actions <- renderUI({ @@ -416,7 +775,7 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu ) } - if (is.null(sig_object())) { + if (is.null(signature_feature_set())) { return( tagList( div( @@ -444,7 +803,7 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu ), div( class = "signature-empty", - "The selected signature has not been loaded yet. Click View to fetch its metadata and data tables." + "The selected signature has not been loaded yet. Click View to fetch its signature feature set." ) ) ) @@ -480,7 +839,18 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu 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"))) + tabPanel( + "Differential Expression", + div( + class = "signature-helper", + "Differential expression is loaded separately to keep the signature view responsive." + ), + div( + class = "signature-actions", + actionButton(ns("load_difexp_btn"), "Get Difexp") + ), + uiOutput(ns("difexp_panel")) + ) ) ) }) @@ -503,20 +873,33 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu }, server = TRUE) output$signature_file_table <- DT::renderDataTable({ - req(current_sig()) + req(current_signature_feature_set()) DatatableFX( - current_sig()$signature, + current_signature_feature_set(), hidden_columns = integer(0), scrollY = "500px" ) }, server = TRUE) + output$difexp_panel <- renderUI({ + if (is.null(signature_difexp())) { + return( + div( + class = "signature-empty", + "Differential expression has not been loaded yet." + ) + ) + } + + DT::DTOutput(session$ns("difexp_file_table")) + }) + output$difexp_file_table <- DT::renderDataTable({ - req(current_sig()) + req(signature_difexp()) DatatableFX( - current_sig()$difexp, + signature_difexp(), hidden_columns = integer(0), scrollY = "500px" ) @@ -526,11 +909,36 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu req(selected_sig()) tryCatch({ - sig_object(fetch_selected_signature(selected_sig()$signature_id[[1]])) - showNotification("Signature details loaded.", type = "message") + signature_feature_set(fetch_signature_feature_set(selected_sig()$signature_id[[1]])) + signature_difexp(NULL) + showNotification("Signature feature set loaded.", type = "message") + }, error = function(e) { + showNotification( + paste("Failed to load signature feature set:", e$message), + type = "error", + duration = 8 + ) + }) + }) + + observeEvent(input$load_difexp_btn, { + req(selected_sig(), signature_feature_set()) + + tryCatch({ + sig_obj <- fetch_selected_signature(selected_sig()$signature_id[[1]]) + + if (is.list(sig_obj) && length(sig_obj) >= 1 && !is.null(sig_obj[[1]]$difexp)) { + signature_difexp(sig_obj[[1]]$difexp) + } else if (!is.null(sig_obj$difexp)) { + signature_difexp(sig_obj$difexp) + } else { + stop("No differential expression table was returned for this signature.") + } + + showNotification("Differential expression loaded.", type = "message") }, error = function(e) { showNotification( - paste("Failed to load signature details:", e$message), + paste("Failed to load differential expression:", e$message), type = "error", duration = 8 ) @@ -642,6 +1050,252 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu showModal(upload_modal_ui(session$ns, type = "Signature")) }) + output$create_column_mapping <- renderUI({ + detected <- create_detected_columns() + + if (is.null(detected)) { + return( + div( + class = "signature-empty", + "Upload a CSV file to let the app detect the relevant columns automatically." + ) + ) + } + + detected_df <- data.frame( + SigRepo_Field = names(detected), + Uploaded_Column = vapply(detected, function(x) if (is.null(x) || !nzchar(x)) "Not detected" else x, character(1)), + stringsAsFactors = FALSE + ) + + tagList( + p( + class = "signature-create-help", + "Detected the most likely columns from the uploaded file. Common DESeq2, limma, and generic differential expression outputs should work without manual mapping." + ), + DT::DTOutput(ns("create_detected_columns_table")) + ) + }) + + output$create_detected_columns_table <- DT::renderDataTable({ + detected <- create_detected_columns() + req(detected) + + detected_df <- data.frame( + SigRepo_Field = names(detected), + Uploaded_Column = vapply(detected, function(x) if (is.null(x) || !nzchar(x)) "Not detected" else x, character(1)), + stringsAsFactors = FALSE + ) + + DatatableFX( + detected_df, + hidden_columns = integer(0), + scrollY = "220px" + ) + }, server = TRUE) + + output$create_upload_preview <- DT::renderDataTable({ + df <- create_upload_df() + req(df) + + preview_df <- utils::head(df, 10) + DatatableFX( + preview_df, + hidden_columns = integer(0), + scrollY = "220px" + ) + }, server = TRUE) + + observeEvent(input$create_upload_file, { + create_upload_error(NULL) + + tryCatch({ + uploaded_df <- parse_uploaded_csv(input$create_upload_file) + create_upload_df(uploaded_df) + source_type <- input$create_source_type + if (is.null(source_type) || !nzchar(source_type)) { + source_type <- "difexp" + } + create_detected_columns(auto_detect_column_mapping(uploaded_df, source_type = source_type)) + }, error = function(e) { + create_upload_df(NULL) + create_detected_columns(NULL) + create_upload_error(e$message) + }) + }) + + observeEvent(input$create_source_type, { + df <- create_upload_df() + if (is.null(df)) { + return() + } + + source_type <- input$create_source_type + if (is.null(source_type) || !nzchar(source_type)) { + source_type <- "difexp" + } + + create_detected_columns(auto_detect_column_mapping(df, source_type = source_type)) + }, ignoreInit = TRUE) + + observeEvent(input$open_create_modal, { + create_upload_df(NULL) + create_upload_error(NULL) + create_detected_columns(NULL) + + showModal( + modalDialog( + title = "Create Signature", + size = "l", + easyClose = TRUE, + div( + class = "signature-create-help", + "Enter the signature metadata, upload a CSV, map the input columns, and the app will generate an OmicSignature object for you." + ), + div( + class = "signature-create-grid", + textInput(ns("create_signature_name"), "Signature Name"), + selectizeInput( + ns("create_organism"), + "Organism", + choices = c("Homo sapiens", "Mus musculus"), + selected = "Homo sapiens", + options = list(create = TRUE) + ), + selectizeInput( + ns("create_direction_type"), + "Direction Type", + choices = c("bi-directional", "up", "down"), + selected = "bi-directional", + options = list(create = TRUE) + ), + selectizeInput( + ns("create_assay_type"), + "Assay Type", + choices = c("transcriptomics", "proteomics", "metabolomics", "epigenomics"), + selected = "transcriptomics", + options = list(create = TRUE) + ), + textInput(ns("create_phenotype"), "Phenotype"), + textInput(ns("create_sample_type"), "Sample Type"), + textInput(ns("create_platform"), "Platform"), + textInput(ns("create_covariates"), "Covariates"), + textAreaInput(ns("create_description"), "Description", rows = 3), + textInput(ns("create_keywords"), "Keywords", placeholder = "comma,separated,keywords"), + textInput(ns("create_author"), "Author"), + textInput(ns("create_pmid"), "PMID"), + textInput(ns("create_year"), "Year"), + textInput(ns("create_cutoff_description"), "Cutoff Description"), + radioButtons( + ns("create_visibility"), + "Visibility", + choices = c("Private" = FALSE, "Public" = TRUE), + selected = FALSE, + inline = TRUE + ) + ), + div( + class = "signature-create-section", + tags$h4("Input File"), + p( + class = "signature-create-help", + "Choose whether you are uploading a differential expression table that should be converted into a signature, or a prebuilt signature CSV." + ), + radioButtons( + ns("create_source_type"), + "CSV Type", + choices = c("Differential Expression CSV" = "difexp", "Signature CSV" = "signature"), + selected = "difexp", + inline = TRUE + ), + fileInput( + ns("create_upload_file"), + "Choose CSV File", + accept = c(".csv", "text/csv", "text/comma-separated-values,text/plain") + ), + conditionalPanel( + condition = sprintf("input['%s'] === 'difexp'", ns("create_source_type")), + ns = ns, + div( + class = "signature-create-grid", + textInput(ns("create_score_cutoff"), "Score Cutoff", value = "0"), + textInput(ns("create_adj_p_cutoff"), "Adjusted P Cutoff", value = "0.05"), + textInput(ns("create_p_value_cutoff"), "P Value Cutoff"), + textInput(ns("create_logfc_cutoff"), "LogFC Cutoff"), + textAreaInput( + ns("create_other_metadata"), + "Additional Metadata", + rows = 3, + placeholder = "one key=value pair per line" + ) + ) + ), + conditionalPanel( + condition = sprintf("input['%s'] === 'signature'", ns("create_source_type")), + ns = ns, + textAreaInput( + ns("create_other_metadata"), + "Additional Metadata", + rows = 3, + placeholder = "one key=value pair per line" + ) + ) + ), + div( + class = "signature-create-section", + tags$h4("Column Mapping"), + uiOutput(ns("create_column_mapping")) + ), + div( + class = "signature-create-section", + tags$h4("File Preview"), + uiOutput(ns("create_upload_error_ui")), + DT::DTOutput(ns("create_upload_preview")) + ), + footer = tagList( + modalButton("Cancel"), + actionButton(ns("create_signature_btn"), "Create and Save Signature", class = "btn-primary") + ) + ) + ) + }) + + output$create_upload_error_ui <- renderUI({ + err <- create_upload_error() + if (is.null(err)) { + return(NULL) + } + + div(class = "signature-empty", paste("Could not read uploaded CSV:", err)) + }) + + observeEvent(input$create_signature_btn, { + tryCatch({ + omic_signature <- build_signature_object_from_modal() + visibility <- as.logical(input$create_visibility) + created_signature_name <- omic_signature$metadata$signature_name + + SigRepo::addSignature( + conn_handler = user_conn_handler(), + omic_signature = omic_signature, + visibility = visibility + ) + + showNotification( + sprintf("Signature '%s' created and uploaded successfully.", created_signature_name), + type = "message" + ) + signature_trigger(isolate(signature_trigger()) + 1) + removeModal() + }, error = function(e) { + showNotification( + paste("Failed to create signature:", e$message), + type = "error", + duration = 10 + ) + }) + }) + observeEvent(input$upload_btn, { req(input$upload_file) @@ -691,7 +1345,8 @@ signature_module_server <- function(id, signature_db, user_conn_handler, signatu showNotification("Signature deleted successfully.", type = "message") removeModal() selected_sig(NULL) - sig_object(NULL) + signature_feature_set(NULL) + signature_difexp(NULL) signature_trigger(signature_trigger() + 1) }, error = function(e) { message("Error deleting signature: ", e$message)