Improve annotation: custom ortholog species support

bin/pgxcreate_op.R

@@ -56,7 +56,9 @@ pgx <- playbase::pgx.createPGX(
   max.genesets = params$max.genesets,
   annot_table = params$annot_table,
   settings = params$settings,
-  sc_compute_settings = params$sc_compute_settings
+  sc_compute_settings = params$sc_compute_settings,
+  ortholog_species = params$ortholog_species,
+  include_default_gmt = params$include_default_gmt
 )
 
 message("[create PGX process] : PGX created successfully")

components/app/R/global.R

@@ -226,7 +226,6 @@ opt.default <- list(
   ENABLE_HEARTBEAT = TRUE,
   ENABLE_INACTIVITY = TRUE,
   INACTIVITY_TIMEOUT = 1800,
-  ENABLE_ANNOT = FALSE,
   DEV_AUTOLOAD = FALSE, ## dev/testing: skip sign-in, load example, open Dashboard
   ENABLE_PLOTLY_PURGE = TRUE, ## drop hidden boards' drawn Plotly/iheatmapr traces, redraw on return
   ENABLE_METADATA = FALSE,

components/app_copilot/R/CopilotBoardUI.R

@@ -16,7 +16,6 @@ CopilotBoardUI <- function(id) {
 
   ui <- bslib::layout_columns(
     col_widths = c(3, 5, 4),
-    #style = "height: calc(100vh - 80px);",
     height = "100%",
 
     # ---- Left column: new-chat button, on top of docs / reports ----
@@ -82,7 +81,7 @@ CopilotBoardUI <- function(id) {
     # the clickable-looking-button problem we just fixed on the left.
     bslib::layout_columns(
       col_widths = 12,
-      row_heights = c(4, 7),
+      row_heights = c(4, 8),
       height = "100%",
       bslib::card(
         bslib::as.card_item(shiny::fillRow(

components/board.compare/R/compare_server.R

@@ -219,7 +219,9 @@ CompareBoard <- function(id, pgx, pgx_dir = reactive(file.path(OPG, "data", "min
         # For same org. we ensure compare on symbol
         target_col <- "symbol"
       } else if (org1 != org2) {
-        # For different org. we ensure compare on human_ortholog
+        # For different org. we ensure compare on human_ortholog, the
+        # only bridge guaranteed to be comparable regardless of which
+        # ortholog_species each dataset happened to be computed with.
         # If it is not present, use gene_name
         target_col <- "human_ortholog"
       }

components/board.correlation/R/correlation_table_corr.R

@@ -52,10 +52,10 @@ correlation_table_corr_server <- function(id,
       P <- getPartialCorrelation()
       pcor <- P[match(rownames(R), rownames(P)), "pcor"]
       gene_table <- pgx$genes
-      if (all(gene_table$human_ortholog == rownames(gene_table)) | all(is.na(gene_table$human_ortholog))) {
+      if (all(gene_table$ortholog == rownames(gene_table)) | all(is.na(gene_table$ortholog))) {
         gene_table_cols <- c("feature", "symbol", "gene_title")
       } else {
-        gene_table_cols <- c("feature", "symbol", "human_ortholog", "gene_title")
+        gene_table_cols <- c("feature", "symbol", "ortholog", "gene_title")
       }
 
       tt <- gene_table[rownames(R), gene_table_cols]
@@ -70,15 +70,12 @@ correlation_table_corr_server <- function(id,
 
       df <- plot_data()
       # Table aesthetics
-      char_cols <- c("feature", "gene", "symbol", "human_ortholog", "gene_title")
-      if (pgx$organism %in% c("Human", "human")) {
-        char_cols <- c("feature", "gene", "symbol", "human_ortholog", "gene_title")
-      }
+      char_cols <- c("feature", "gene", "symbol", "ortholog", "gene_title")
       if (sum(df$feature %in% df$symbol) > nrow(df) * .8) {
         df$feature <- NULL
       }
 
-      if ("human_ortholog" %in% colnames(df)) df$human_ortholog <- NULL
+      if ("ortholog" %in% colnames(df)) df$ortholog <- NULL
       numeric.cols <- which(!colnames(df) %in% char_cols)
 
       DT::datatable(

components/board.dataview/R/dataview_module_geneinfo.R

@@ -67,7 +67,7 @@ dataview_module_geneinfo_server <- function(id,
         c(
           "feature", "gene_symbol", "symbol",
           "name", "gene_name",
-          "organism", "human_ortholog", "ortholog",
+          "organism", "ortholog",
           "datatype", "data_type",
           "uniprot", "protein",
           "map_location", "map", "genome location",

components/board.dataview/R/dataview_plot_tissue.R

@@ -58,7 +58,8 @@ dataview_plot_tissue_server <- function(id, pgx, r.gene, r.data_type, watermark
       gene <- r.gene()
       data_type <- r.data_type()
 
-      # Find ortholog proportion
+      # Find ortholog proportion. GTEx tissue data is human-keyed, so
+      # bridge via human_ortholog specifically.
       n <- length(pgx$genes$human_ortholog)
       ortho <- sum(pgx$genes$human_ortholog != "")
 

components/board.dataview/R/dataview_table_rawdata.R

@@ -116,10 +116,6 @@ dataview_table_rawdata_server <- function(id,
       cl <- c("feature", "symbol", "gene_title")
       if (!input$show_full_table) annot <- annot[, cl]
 
-      if ("human_ortholog" %in% colnames(annot)) {
-        colnames(annot)[colnames(annot) == "human_ortholog"] <- "ortholog"
-      }
-
       # hide symbol column if symbol is feature
       if (mean(head(annot$feature, 1000) == head(annot$symbol, 1000), na.rm = TRUE) > 0.8) {
         annot$symbol <- NULL

components/board.enrichment/R/enrichment_server.R

@@ -411,7 +411,7 @@ EnrichmentBoard <- function(id, pgx,
       gmt1 <- pgx$GMT[, gs, drop = FALSE]
       genes <- rownames(gmt1)[which(Matrix::rowSums(gmt1 != 0) == ns)]
       # check which columns are in pgx$genes
-      cols_in_pgx <- c("feature", "symbol", "human_ortholog", "gene_title")
+      cols_in_pgx <- c("feature", "symbol", "ortholog", "gene_title")
       cols_in_pgx <- cols_in_pgx[which(cols_in_pgx %in% colnames(pgx$genes))]
 
       genes_user <- pgx$genes[rownames(limma1), cols_in_pgx]

components/board.enrichment/R/enrichment_table_genes_in_geneset.R

@@ -39,7 +39,7 @@ enrichment_table_genes_in_geneset_server <- function(id,
       }
 
       if (organism %in% c("Human", "human")) {
-        rpt$human_ortholog <- NULL
+        rpt$ortholog <- NULL
       }
       if (sum(rpt$feature %in% rpt$symbol) > nrow(rpt) * .8) {
         rpt$feature <- NULL

components/board.expression/R/expression_server.R

@@ -258,14 +258,14 @@ ExpressionBoard <- function(id, pgx, labeltype = shiny::reactive("feature")) {
 
 
       # TODO the annot could be moved to geDEGtable function!!!
-      sel <- setdiff(c("feature", "symbol", "human_ortholog"), colnames(res))
+      sel <- setdiff(c("feature", "symbol", "ortholog"), colnames(res))
       annot <- pgx$genes[rownames(res), sel, drop = FALSE]
       # res$gene_name <- NULL, better remove before showing the plot
 
       res <- cbind(annot, res)
 
-      if (all(is.na(res$human_ortholog))) {
-        res$human_ortholog <- NULL
+      if (all(is.na(res$ortholog))) {
+        res$ortholog <- NULL
       }
       return(res)
     })
@@ -586,10 +586,12 @@ ExpressionBoard <- function(id, pgx, labeltype = shiny::reactive("feature")) {
         return(NULL)
       }
 
-      ## determine which column to match with pgx$GMT
+      ## determine which column to match with pgx$GMT. Default genesets
+      ## are human-keyed, so human_ortholog is a candidate alongside symbol.
+      cand.cols <- intersect(c("symbol", "human_ortholog", "ortholog"), colnames(res))
       gene1 <- res[sel.row, ]
       match.res <- apply(
-        res[, c("symbol", "human_ortholog")], 2,
+        res[, cand.cols, drop = FALSE], 2,
         function(x) sum(x %in% rownames(pgx$GMT))
       )
       match.col <- names(which.max(match.res))

components/board.expression/R/expression_table_genetable.R

@@ -104,7 +104,7 @@ expression_table_genetable_server <- function(id,
       df <- table_data()
       df$gene_name <- NULL
 
-      if (organism %in% c("Human", "human")) df$human_ortholog <- NULL
+      if (organism %in% c("Human", "human")) df$ortholog <- NULL
 
       if (sum(df$feature %in% df$symbol) > nrow(df) * .8) df$feature <- NULL
 

components/board.featuremap/R/featuremap_plot_table_gene_map.R

@@ -253,7 +253,7 @@ featuremap_plot_gene_map_server <- function(id,
       annot <- pgx$genes
 
       ## Retrieve gene table with rownames (symbols)
-      annot_cols <- c("feature", "symbol", "human_ortholog", "gene_title")
+      annot_cols <- c("feature", "symbol", "ortholog", "gene_title")
       annot_cols <- intersect(annot_cols, colnames(annot))
       rowids <- match(rownames(F), rownames(annot))
       annot <- annot[rowids, annot_cols, drop = FALSE]
@@ -269,8 +269,8 @@ featuremap_plot_gene_map_server <- function(id,
       if (mean(df$feature %in% df$symbol, na.rm = TRUE) > 0.9) {
         df$feature <- NULL
       }
-      if (mean(df$symbol == df$human_ortholog, na.rm = TRUE) > 0.9 || all(is.na(df$human_ortholog))) {
-        df$human_ortholog <- NULL
+      if (mean(df$symbol == df$ortholog, na.rm = TRUE) > 0.9 || all(is.na(df$ortholog))) {
+        df$ortholog <- NULL
       }
 
       ## detect brush

components/board.pathway/R/pathway_plot_reactome_graph.R

@@ -91,6 +91,7 @@ functional_plot_reactome_graph_server <- function(id,
         pp <- rownames(pgx$gx.meta$meta[[comparison]])
 
         if (pgx$organism != "Human") {
+          # Reactome node ids are human gene symbols
           names(fc) <- pgx$genes[pp, "human_ortholog"]
         } else {
           names(fc) <- pgx$genes[pp, "symbol"]

components/board.signature/R/signature_server.R

@@ -178,7 +178,8 @@ SignatureBoard <- function(id, pgx,
           length(genes) > 0,
           "Custom feature selection not found in the data. Please check your custom feature list."
         ))
-        ## map to probes
+        ## map to probes. Custom gene lists are typed as human-style
+        ## symbols, so bridge via human_ortholog specifically.
         features1 <- playbase::map_probes(pgx$genes, genes,
           column = "human_ortholog", ignore.case = TRUE
         )

components/board.signature/R/signature_table_genes_in_signature.R

@@ -36,7 +36,7 @@ signature_table_genes_in_signature_server <- function(id,
       }
 
       if (organism %in% c("Human", "human")) {
-        df$human_ortholog <- NULL
+        df$ortholog <- NULL
       }
       if (sum(df$feature %in% df$symbol) > nrow(df) * .8) {
         df$feature <- NULL

components/board.upload/R/upload_module_computepgx.R

@@ -228,8 +228,20 @@ upload_module_computepgx_server <- function(
         return(DEFAULTS$computation_options$probe_filtering)
       }
 
-      readthedocs_url <- "https://omicsplayground.readthedocs.io/en/latest/dataprep/geneset"
-
+      READTHEDOCS_URL <- "https://omicsplayground.readthedocs.io/en/latest/dataprep/geneset"
+
+      ## E. coli is intentionally excluded: it is not in g:Profiler's
+      ## organism list and HomoloGene/babelgene (the other ortholog
+      ## backends) are eukaryote-only, so there is no backend that can
+      ## resolve it.
+      ORTHOLOG_SPECIES <- c(
+        "Human",
+        "Drosophila melanogaster",
+        "Arabidopsis thaliana",
+        "Caenorhabditis elegans",
+        "Saccharomyces cerevisiae"
+      )
+
       ## Helper function to generate UI input based on metadata field config
       ## Only supports select and multiselect types for easier filtering
       generate_metadata_input <- function(field, ns) {
@@ -304,16 +316,6 @@ upload_module_computepgx_server <- function(
       }
 
       output$UI <- shiny::renderUI({
-        upload_annot_table_ui <- NULL
-
-        if (auth$options$ENABLE_ANNOT) {
-          upload_annot_table_ui <- fileInput2(
-            ns("upload_annot_table"),
-            shiny::tags$h4("Probe annotation (alpha):"),
-            multiple = FALSE,
-            accept = c(".csv")
-          )
-        }
 
         ui <- div(
           style = "overflow: auto;",
@@ -405,6 +407,8 @@ upload_module_computepgx_server <- function(
             ns = ns,
             bslib::layout_columns(
               width = 12,
+              height = "100%",
+              class = "p-2",
               bslib::card(
                 shiny::checkboxGroupInput(
                   ns("filter_methods"),
@@ -580,7 +584,7 @@ upload_module_computepgx_server <- function(
                   "input.create_ai_reports == true",
                   ns = ns,
                   div(
-                    style = "margin-top:-20px;margin-left:12px;margin-bottom:-20px;",
+                    style = "margin-top:-25px;margin-left:12px;margin-bottom:-20px;",
                     shiny::checkboxInput(
                       ns("create_ai_infographics"),
                       label = withTooltip(
@@ -593,27 +597,45 @@ upload_module_computepgx_server <- function(
                 )
               ),
               bslib::card(
-                fileInput2(
-                  ns("upload_gmt"),
-                  shiny::tagList(
-                    shiny::tags$h4("Custom genesets:"),
-                    shiny::p(
-                      "Upload a custom GMT file (.gmt) as described",
-                      tags$a(
+                shiny::tags$h4("Custom genesets:"),
+                shiny::span(
+                  style = "margin-top: -22px;",
+                  "Upload a custom GMT file (.gmt) as described",
+                  tags$a(
                         "here.",
-                        href = readthedocs_url,
+                        href = READTHEDOCS_URL,
                         target = "_blank",
                         style = "text-decoration: underline;"
-                      ),
-                      "or download an",
-                      downloadLink(ns("download_gmt"), shiny::HTML("<u>example GMT</u>")),
-                      " (gene targets of the EGFR transcription factor)."
-                    )
-                  ),
-                  multiple = FALSE,
-                  accept = c(".txt", ".gmt")
+                  )
                 ),
-                upload_annot_table_ui
+                div(
+                  style = "margin-top: -8px;",
+                  shiny::selectInput(ns("ortholog_species"),
+                    withTooltip(
+                      shiny::span("Ortholog species:"),
+                      "Genes are mapped to their ortholog in this species, used to match against human-based gene sets and pathways."
+                    ),
+                    choices = ORTHOLOG_SPECIES ),
+                  fileInput2(
+                    ns("upload_gmt"),
+                    label = NULL,
+                    multiple = FALSE,
+                    accept = c(".txt", ".gmt")
+                  ),
+                  div( style = "margin-top: -3px;",
+                    shiny::checkboxInput(ns("include_default_gmt"),"Include default genesets",
+                      TRUE)
+                  ),
+                  shiny::conditionalPanel(
+                    "!input.include_default_gmt && !output.has_upload_gmt",
+                    ns = ns,
+                    shiny::tags$p(
+                      "Warning: no default genesets and no custom GMT file uploaded ",
+                      "-- this dataset will have no gene sets.",
+                      style = "color: #a94442; margin-top: -3px; font-size: 90%;"
+                    )
+                  )
+                )
               )
             ), ## end of fillRow
             tags$style(HTML("#upload-compute-gset_methods-label { width: -webkit-fill-available; }")),
@@ -934,6 +956,13 @@ upload_module_computepgx_server <- function(
       custom_fc <- NULL
       processx_error <- list(user_email = NULL, pgx_name = NULL, pgx_path = NULL, error = NULL)
 
+      ## drives the "no genesets at all" warning next to the
+      ## include_default_gmt checkbox
+      output$has_upload_gmt <- shiny::reactive({
+        !is.null(input$upload_gmt)
+      })
+      shiny::outputOptions(output, "has_upload_gmt", suspendWhenHidden = FALSE)
+
       ## react on custom GMT upload
       shiny::observeEvent(input$upload_gmt, {
         filePath <- input$upload_gmt$datapath
@@ -1248,6 +1277,8 @@ upload_module_computepgx_server <- function(
           azimuth_ref = azimuth_ref(),
           contrasts = contrasts,
           probe_type = probetype(),
+          ortholog_species = input$ortholog_species,
+          include_default_gmt = input$include_default_gmt,
           # ------- extra tables ---------
           annot_table = pgx_annot,
           custom.geneset = custom_geneset,
@@ -1616,18 +1647,6 @@ upload_module_computepgx_server <- function(
         )
       })
 
-      output$download_gmt <- downloadHandler(
-        filename = function() {
-          # Set the filename for the downloaded file
-          "EGFR_TARGET_GENES.v2023.1.Hs.gmt"
-        },
-        content = function(file) {
-          gmt_path <- file.path(FILES, "/gmt/EGFR_TARGET_GENES.v2023.1.Hs.gmt")
-          gmt <- readBin(gmt_path, what = raw(), n = file.info(gmt_path)$size)
-          writeBin(gmt, file)
-        }
-      )
-
       session$onSessionEnded(
         function() {
           # Clean up raw_dir if it exists

dev/board.launch/global.R

@@ -168,7 +168,6 @@ opt.default <- list(
   ENABLE_HEARTBEAT = TRUE,
   ENABLE_INACTIVITY = TRUE,
   INACTIVITY_TIMEOUT = 1800,
-  ENABLE_ANNOT = FALSE,
   ENABLE_METADATA = FALSE,
   ENABLE_UPGRADE = FALSE,
   ENCRYPTED_EMAIL = FALSE,