feat: prefix gene symbol for selectInput if feature is not symbol

Makefile

@@ -97,7 +97,7 @@ renv: FORCE
 FORCE: ;
 
 DATE = `date +%y%m%d|sed 's/\ //g'`
-VERSION = "v3.5.0-beta2"
+VERSION = "v3.5.0-beta3"
 BUILD := $(VERSION)"+"$(BRANCH)""$(DATE)
 
 version: FORCE

VERSION

@@ -1 +1 @@
-v3.5.0-beta2+master240726
+v3.5.0-beta3+master240730

components/app/R/.#server.R

@@ -0,0 +1 @@
+[email protected]:1721819251

components/board.clustering/R/clustering_plot_PCAplot.R

@@ -0,0 +1,279 @@
+##
+## This file is part of the Omics Playground project.
+## Copyright (c) 2018-2023 BigOmics Analytics SA. All rights reserved.
+##
+
+
+
+## Annotate clusters ############
+
+clustering_plot_clustpca_ui <- function(
+    id,
+    label = "",
+    height,
+    width,
+    title,
+    info.text,
+    caption,
+    parent) {
+  ns <- shiny::NS(id)
+
+  plot_opts <- shiny::tagList(
+    withTooltip(
+      shiny::selectInput(parent("hmpca.colvar"), "Color/label:", choices = NULL, width = "100%"),
+      "Set colors/labels according to a given phenotype."
+    ),
+    withTooltip(
+      shiny::selectInput(parent("hmpca.shapevar"), "Shape:", choices = NULL, width = "100%"),
+      "Set shapes according to a given phenotype."
+    ),
+    withTooltip(
+      shiny::selectInput(
+        ns("pca_label"),
+        label = "Label:",
+        choices = list("group", "bottom", "sample", "<none>")
+      ),
+      "Place group labels as legend at the bottom or in plot as group or sample labels."
+    ),
+    withTooltip(
+      shiny::checkboxInput(ns("all_clustmethods"), "show all methods"),
+      "Show an overview of all dimensionality reduction methods."
+    ),
+    withTooltip(
+      shiny::checkboxInput(ns("plot3d"), "plot 3D"),
+      "Show 3D plot."
+    )
+  )
+
+  quick_buttons <- tagList(
+    div(shiny::checkboxInput(ns("plot3d"), "3D"), class = "header-btn")
+  )
+
+  PlotModuleUI(
+    ns("pltmod"),
+    title = title,
+    label = label,
+    plotlib = "plotly",
+    info.text = info.text,
+    caption = caption,
+    options = plot_opts,
+    download.fmt = c("png", "pdf", "csv"),
+    width = width,
+    height = height
+  )
+}
+
+clustering_plot_clustpca_server <- function(id,
+                                            pgx,
+                                            selected_samples,
+                                            hmpca.colvar,
+                                            hmpca.shapevar,
+                                            clustmethod,
+                                            watermark = FALSE,
+                                            parent) {
+  moduleServer(id, function(input, output, session) {
+    ns <- session$ns
+
+    ## Plot ############
+    plot_data <- shiny::reactive({
+      samples <- selected_samples()
+      cluster.pos <- pgx$cluster$pos
+      for (m in names(cluster.pos)) {
+        colnames(cluster.pos[[m]]) <- paste0(m, ".", colnames(cluster.pos[[m]]))
+      }
+      all.pos <- do.call(cbind, cluster.pos)
+      all.pos <- all.pos[samples, ]
+      pd <- list(
+        pos = all.pos
+      )
+
+      return(pd)
+    })
+
+
+    create_plot <- function(pgx, pos, method, colvar, shapevar, label, cex) {
+      do3d <- (ncol(pos) == 3)
+      sel <- rownames(pos)
+      df <- cbind(pos, pgx$Y[sel, ])
+
+      textvar <- NULL
+      if (colvar %in% colnames(df)) colvar <- factor(df[, colvar])
+      if (shapevar %in% colnames(df)) shapevar <- factor(df[, shapevar])
+      ann.text <- rep(" ", nrow(df))
+
+      label.samples <- (label == "sample")
+
+      if (!do3d && label.samples) ann.text <- rownames(df)
+      if (!is.null(colvar)) {
+        textvar <- factor(colvar)
+      }
+      symbols <- c(
+        "circle", "square", "star", "triangle-up", "triangle-down", "pentagon",
+        "bowtie", "hexagon", "asterisk", "hash", "cross", "triangle-left",
+        "triangle-right", "+", c(15:0)
+      )
+
+      Y <- cbind("sample" = rownames(pos), pgx$Y[sel, ])
+      tt.info <- apply(Y, 1, function(y) paste0(colnames(Y), ": ", y, "</br>", collapse = ""))
+      tt.info <- as.character(tt.info)
+      cex1 <- c(1.0, 0.8, 0.6)[1 + 1 * (nrow(pos) > 30) + 1 * (nrow(pos) > 200)]
+
+      if (do3d) {
+        ## 3D plot
+        plt <- plotly::plot_ly(df, mode = "markers") %>%
+          plotly::add_markers(
+            x = df[, 1],
+            y = df[, 2],
+            z = df[, 3],
+            type = "scatter3d",
+            color = colvar,
+            marker = list(
+              size = 6 * cex1 * cex,
+              line = list(color = "grey10", width = 0.1)
+            ),
+            symbol = shapevar,
+            symbols = symbols,
+            text = tt.info
+          ) %>%
+          plotly::add_annotations(
+            x = pos[, 1],
+            y = pos[, 2],
+            z = pos[, 3],
+            text = ann.text,
+            showarrow = FALSE
+          )
+        ## add cluster annotation labels
+        if (0 && length(unique(colvar)) > 1) {
+          ## add cluster annotation labels
+          grp.pos <- apply(pos, 2, function(x) tapply(x, colvar, median))
+          cex2 <- ifelse(length(grp.pos) > 20, 0.8, 1)
+          plt <- plt %>% plotly::add_annotations(
+            x = grp.pos[, 1], y = grp.pos[, 2], z = grp.pos[, 3],
+            text = rownames(grp.pos),
+            font = list(size = 24 * cex2 * cex, color = "#555"),
+            showarrow = FALSE
+          )
+        }
+
+        if (label == "<none>") {
+          plt <- plt %>%
+            plotly::layout(showlegend = FALSE)
+        }
+      } else {
+        ## 2D plot
+        plt <- plotly::plot_ly(df, mode = "markers") %>%
+          plotly::add_markers(
+            x = df[, 1],
+            y = df[, 2],
+            type = "scattergl",
+            color = colvar, ## size = sizevar, sizes=c(80,140),
+            marker = list(
+              size = 16 * cex1 * cex,
+              line = list(color = "grey20", width = 0.6)
+            ),
+            symbol = shapevar,
+            symbols = symbols,
+            text = tt.info
+          ) %>%
+          plotly::add_annotations(
+            x = pos[, 1],
+            y = pos[, 2],
+            text = ann.text,
+            ## xref = "x", yref = "y",
+            showarrow = FALSE
+          )
+
+        ## add group/cluster annotation labels
+        if (label == "inside") {
+          plt <- plt %>%
+            plotly::layout(legend = list(x = 0.05, y = 0.95))
+        } else if (label == "bottom") {
+          plt <- plt %>%
+            plotly::layout(legend = list(orientation = "h"))
+        } else if (label == "group") {
+          if (!is.null(textvar) && length(unique(textvar)) > 1) {
+            grp.pos <- apply(pos, 2, function(x) tapply(x, as.character(textvar), median))
+            cex2 <- 1
+            if (length(grp.pos) > 20) cex2 <- 0.8
+            if (length(grp.pos) > 50) cex2 <- 0.6
+            plt <- plt %>% plotly::add_annotations(
+              x = grp.pos[, 1],
+              y = grp.pos[, 2],
+              text = paste0("<b>", rownames(grp.pos), "</b>"),
+              font = list(size = 24 * cex2 * cex, color = "#555"),
+              showarrow = FALSE
+            )
+          }
+          plt <- plt %>%
+            plotly::layout(showlegend = FALSE)
+        } else if (label == "sample") {
+          plt <- plt %>%
+            plotly::layout(showlegend = FALSE)
+        } else if (label == "<none>") {
+          plt <- plt %>%
+            plotly::layout(showlegend = FALSE)
+        }
+      }
+      return(plt)
+    }
+
+    create_plotlist <- function() {
+      samples <- selected_samples()
+      options <- input$hmpca_options
+      colvar <- hmpca.colvar()
+      shapevar <- hmpca.shapevar()
+      clustmethod <- clustmethod()
+      label <- input$pca_label
+
+      shiny::req(samples, colvar, shapevar, clustmethod, legend)
+
+      methods <- clustmethod()
+      if (input$all_clustmethods) {
+        cluster.names <- names(pgx$cluster$pos)
+        methods <- sub("2d", "", grep("2d", cluster.names, value = TRUE))
+      }
+      do3d <- (input$plot3d)
+      multiplot <- length(methods) > 1
+
+      plist <- list()
+      for (i in 1:length(methods)) {
+        m <- methods[i]
+        m1 <- paste0(m, "2d")
+        if (do3d) m1 <- paste0(m, "3d")
+        pos <- pgx$cluster$pos[[m1]]
+        pos <- pos[samples, ]
+        plist[[i]] <- create_plot(
+          pgx = pgx,
+          pos = pos,
+          method = m,
+          colvar = colvar,
+          shapevar = shapevar,
+          label = label,
+          cex = ifelse(length(methods) > 1, 0.6, 1)
+        )
+      }
+      plist
+    }
+
+    plot.RENDER <- reactive({
+      plist <- create_plotlist()
+      nc <- ceiling(sqrt(length(plist)))
+      plotly::subplot(
+        plist,
+        nrows = nc,
+        margin = 0.04
+      )
+    })
+
+    PlotModuleServer(
+      "pltmod",
+      plotlib = "plotly",
+      func = plot.RENDER,
+      csvFunc = plot_data, ##  *** downloadable data as CSV
+      res = c(90, 170), ## resolution of plots
+      pdf.width = 8,
+      pdf.height = 8,
+      add.watermark = watermark
+    )
+  })
+}

components/board.dataview/R/dataview_module_geneinfo.R

@@ -42,39 +42,41 @@ dataview_module_geneinfo_server <- function(id,
   moduleServer(id, function(input, output, session) {
     geneinfo_data <- shiny::reactive({
       gene <- r.gene()
-      req(gene)
-
-      jj <- which(pgx$genes$feature == gene)
-      if (pgx$genes$feature[jj] != pgx$genes$symbol[jj]) { ## Proteomics
-        gene <- pgx$genes$symbol[jj]
-      }
-
-      gene <- toupper(sub(".*:", "", gene))
-      eg <- AnnotationDbi::mget(gene,
-        envir = org.Hs.eg.db::org.Hs.egSYMBOL2EG,
-        ifnotfound = NA
-      )[[1]]
-      if (isTRUE(is.na(eg))) {
-        eg <- AnnotationDbi::mget(gene,
-          envir = org.Hs.eg.db::org.Hs.egALIAS2EG, ifnotfound = NA
-        )[[1]]
-      }
-      eg <- eg[1]
-      if (is.null(eg) || length(eg) == 0) {
-        return(NULL)
-      }
-
+      shiny::req(gene)
+
+      jj <- match(gene, rownames(pgx$genes))
+      symbol <- pgx$genes$symbol[jj]
+
+      dbg("[geneinfo] gene/feature = ", gene)
+      dbg("[geneinfo] jj = ", jj)      
+      dbg("[geneinfo] symbol = ", symbol)
+
+      ## eg <- AnnotationDbi::mget(symbol,
+      ##   envir = org.Hs.eg.db::org.Hs.egSYMBOL2EG,
+      ##   ifnotfound = NA
+      ## )[[1]]
+      ## if (isTRUE(is.na(eg))) {
+      ##   eg <- AnnotationDbi::mget(symbol,
+      ##     envir = org.Hs.eg.db::org.Hs.egALIAS2EG, ifnotfound = NA
+      ##   )[[1]]
+      ## }
+      ## eg <- eg[1]
+      ## if (is.null(eg) || length(eg) == 0) {
+      ##   return(NULL)
+      ## }
+
+      info <- playbase::getHSGeneInfo(symbol) ## defined in pgx-functions.R
       res <- "(gene info not available)"
-      if (length(eg) > 0 && !is.na(eg)) {
-        info <- playbase::getHSGeneInfo(eg) ## defined in pgx-functions.R
+      if (!is.null(info)) {
         info$summary <- "(no info available)"
-        if (gene %in% names(playdata::GENE_SUMMARY)) {
-          info$summary <- playdata::GENE_SUMMARY[gene]
+        if (symbol %in% names(playdata::GENE_SUMMARY)) {
+          info$summary <- playdata::GENE_SUMMARY[symbol]
           info$summary <- gsub("Publication Note.*|##.*", "", info$summary)
         }
 
         ## reorder
-        nn <- intersect(c("symbol", "name", "map_location", "summary", names(info)), names(info))
+        nn <- intersect(c("symbol", "name", "map_location", "summary", names(info)),
+                        names(info))
         info <- info[nn]
         info$symbol <- paste0(info$symbol, "<br>")