Merge pull request #646 from bigomics/fix-#621

Fix #621: Add a separate column in tables that has link to genes/proteins
bigomics · Aug 29, 2023 · 611a18b · 611a18b
2 parents 94adc29 + 11704a4
commit 611a18b
Show file tree

Hide file tree

Showing 12 changed files with 117 additions and 33 deletions.
diff --git a/components/app/R/www/styles.min.css b/components/app/R/www/styles.min.css
diff --git a/components/board.clustering/R/clustering_table_clustannot.R b/components/board.clustering/R/clustering_table_clustannot.R
@@ -46,25 +46,38 @@ clustering_table_clustannot_server <- function(
   moduleServer(id, function(input, output, session) {
     ns <- session$ns
 
+    table_data <- reactive({
+      rho <- getClustAnnotCorrelation()
+      rho.name <- playbase::shortstring(sub(".*:", "", rownames(rho)), 60)
+      df <- data.frame(feature = rho.name, round(as.matrix(rho), digits = 3))
+      rownames(df) <- rownames(rho)
+      return(df)
+    })
+
     clustannot_table.RENDER <- shiny::reactive({
+      df <- table_data()
       rho <- getClustAnnotCorrelation()
       xann_level <- xann_level()
       if (is.null(rho)) {
         return(NULL)
       }
 
-      #
-      rho.name <- playbase::shortstring(sub(".*:", "", rownames(rho)), 60)
-      #
-      df <- data.frame(feature = rho.name, round(as.matrix(rho), digits = 3))
-      rownames(df) <- rownames(rho)
       if (xann_level == "geneset") {
-        df$feature <- playbase::wrapHyperLink(df$feature, rownames(df))
+        feature_link <- playbase::wrapHyperLink(
+          rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+          rownames(df)
+        ) |> HandleNoLinkFound(
+          NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+          SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+        )
+      } else {
+        feature_link <- FALSE
       }
 
       DT::datatable(
         df,
-        rownames = FALSE, escape = c(-1, -2),
+        rownames = feature_link,
+        escape = c(-1, -2),
         extensions = c("Buttons", "Scroller"),
         plugins = "scrollResize",
         selection = list(mode = "single", target = "row", selected = c(1)),
@@ -92,6 +105,7 @@ clustering_table_clustannot_server <- function(
       "datasets",
       func = clustannot_table.RENDER,
       func2 = clustannot_table.RENDER_modal,
+      csvFunc = table_data,
       selector = "none"
     )
   }) # end module server

diff --git a/components/board.enrichment/R/enrichment_table_enrichment_analysis.R b/components/board.enrichment/R/enrichment_table_enrichment_analysis.R
@@ -68,7 +68,13 @@ enrichment_table_enrichment_analysis_server <- function(id,
       }
 
       ## wrap genesets names with known links.
-      rpt$GS <- playbase::wrapHyperLink(rpt$GS, rownames(rpt))
+      GS_link <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(rpt)),
+        rownames(rpt)
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
       selectmode <- "single"
 
       is.numcol <- sapply(rpt, is.numeric)
@@ -79,7 +85,7 @@ enrichment_table_enrichment_analysis_server <- function(id,
 
       DT::datatable(rpt,
         class = "compact cell-border stripe hover",
-        rownames = FALSE,
+        rownames = GS_link,
         escape = c(-1, -5),
         extensions = c("Scroller"),
         plugins = "scrollResize",

diff --git a/components/board.enrichment/R/enrichment_table_gset_enrich_all_contrasts.R b/components/board.enrichment/R/enrichment_table_gset_enrich_all_contrasts.R
@@ -99,11 +99,18 @@ enrichment_table_gset_enrich_all_contrasts_server <- function(id,
       F <- td$F
 
       ## wrap with hyperlink
-      df$geneset <- playbase::wrapHyperLink(df$geneset, rownames(df))
+      # browser()
+      geneset_link <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        rownames(df)
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
 
       dt <- DT::datatable(
         df,
-        rownames = FALSE,
+        rownames = geneset_link,
         escape = -1,
         class = "compact cell-border stripe hover",
         extensions = c("Scroller"),

diff --git a/components/board.expression/R/expression_table_gsettable.R b/components/board.expression/R/expression_table_gsettable.R
@@ -13,7 +13,7 @@
 #' @export
 expression_table_gsettable_ui <- function(
     id,
-    title,
+    title, 
     caption,
     info.text,
     width,
@@ -55,11 +55,17 @@ expression_table_gsettable_server <- function(id,
         "Please select a gene in the table."
       ))
 
-      df$geneset <- playbase::wrapHyperLink(df$geneset, rownames(df))
-
+      external_links <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        rownames(df)
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
       DT::datatable(df,
         #        class = "compact",  ## not good!
-        rownames = FALSE, escape = c(-1, -2),
+        rownames = external_links, 
+        escape = c(-1, -2),
         extensions = c("Scroller"),
         plugins = "scrollResize",
         fillContainer = TRUE,
@@ -91,6 +97,7 @@ expression_table_gsettable_server <- function(id,
       "datasets",
       func = gsettable.RENDER,
       func2 = gsettable.RENDER_modal,
+      csvFunc = gx_related_genesets,
       selector = "single"
     )
 

diff --git a/components/board.pathway/R/functional_table_go_table.R b/components/board.pathway/R/functional_table_go_table.R
@@ -79,12 +79,18 @@ functional_table_go_table_server <- function(id,
       dt1 <- round(cbind(score = scores, logFC = fx, meta.q = qv), digits = 4)
       dt <- data.frame(id = names(scores), term = go.term1, dt1, stringsAsFactors = FALSE)
       id2 <- paste0("abc(", sub(":", "_", dt$id), ")") ## to match with wrapHyperLink
-      dt$id <- playbase::wrapHyperLink(as.character(dt$id), id2) ## add link
-
+      id_link <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(dt)),
+        id2
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
+
       numeric.cols <- colnames(dt)[which(sapply(dt, is.numeric))]
 
       DT::datatable(dt,
-        rownames = FALSE,
+        rownames = id_link,
         escape = c(-1, -2),
         #
         extensions = c("Scroller"),
@@ -133,6 +139,7 @@ functional_table_go_table_server <- function(id,
       "datasets",
       func = table_RENDER,
       func2 = table_RENDER_modal,
+      csvFunc = function(){table_RENDER()$x$data[,-1]},
       selector = "none"
     )
   }) ## end of moduleServer

diff --git a/components/board.pathway/R/functional_table_reactome.R b/components/board.pathway/R/functional_table_reactome.R
@@ -49,17 +49,17 @@ functional_table_reactome_server <- function(id,
 
       ## add hyperlink
       url <- paste0("https://reactome.org/content/detail/", df$reactome.id)
-      df[["reactome.id"]] <- paste0(
+      reactome.id_link <- paste0(
         "<a href='", url, "' target='_blank'>",
-        df[["reactome.id"]], "</a>"
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        "</a>"
       )
 
       numeric.cols <- colnames(df)[which(sapply(df, is.numeric))]
 
       DT::datatable(df,
-        rownames = FALSE,
+        rownames = reactome.id_link,
         escape = c(-1, -2),
-        #
         extensions = c("Scroller"),
         selection = list(
           mode = "single",
@@ -118,6 +118,7 @@ functional_table_reactome_server <- function(id,
       "tablemodule",
       func = table_RENDER,
       func2 = table_RENDER_modal,
+      csvFunc = table_data,
       selector = "single"
     )
 

diff --git a/components/board.pathway/R/functional_table_wikipathway.R b/components/board.pathway/R/functional_table_wikipathway.R
@@ -65,16 +65,18 @@ functional_table_wikipathway_server <- function(id,
       url <- paste0(
         "https://www.wikipathways.org/pathways/", df$pathway.id, ".html"
       )
-      df$pathway.id <- paste0(
-        "<a href='", url, "' target='_blank'>", df$pathway.id, "</a>"
+
+      pathway.id_link <- paste0(
+        "<a href='", url, "' target='_blank'>",
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        "</a>"
       )
 
       numeric.cols <- colnames(df)[which(sapply(df, is.numeric))]
 
       DT::datatable(df,
-        rownames = FALSE,
+        rownames = pathway.id_link,
         escape = c(-1, -2),
-        #
         extensions = c("Scroller"),
         selection = list(
           mode = "single",
@@ -135,6 +137,7 @@ functional_table_wikipathway_server <- function(id,
       "tablemodule",
       func = table_RENDER,
       func2 = table_RENDER_modal,
+      csvFunc = function() {table_data()$df},
       selector = "single"
     )
 

diff --git a/components/board.signature/R/signature_table_overlap.R b/components/board.signature/R/signature_table_overlap.R
@@ -28,18 +28,30 @@ signature_table_overlap_server <- function(id,
                                            fullH,
                                            tabH) {
   moduleServer(id, function(input, output, session) {
-    overlapTable.RENDER <- shiny::reactive({
+
+    table_data <- shiny::reactive({
       df <- getOverlapTable()
       shiny::req(df)
+      return(df)
+    })
 
-      df$geneset <- playbase::wrapHyperLink(df$geneset, df$geneset)
+    overlapTable.RENDER <- shiny::reactive({
+      df <- table_data()
 
       numeric.cols <- which(sapply(df, is.numeric))
       numeric.cols <- intersect(c("p.fisher", "q.fisher"), colnames(df))
 
+      geneset_link <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        df$geneset
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
+
       DT::datatable(df,
-        #
-        rownames = FALSE, escape = c(-1, -2),
+        rownames = geneset_link,
+        escape = c(-1, -2),
         extensions = c("Scroller"),
         plugins = "scrollResize",
         selection = "none",
@@ -72,6 +84,7 @@ signature_table_overlap_server <- function(id,
       "datasets",
       func = overlapTable.RENDER,
       func2 = overlapTable.RENDER_modal,
+      csvFunc = table_data,
       selector = "none"
     )
     return(overlapTable)

diff --git a/components/board.wordcloud/R/wordcloud_table_leading_edge.R b/components/board.wordcloud/R/wordcloud_table_leading_edge.R
@@ -46,10 +46,17 @@ wordcloud_table_leading_edge_server <- function(id,
       rownames(df) <- ee
 
       numeric.cols <- colnames(df)[which(sapply(df, is.numeric))]
-      df$leading.edge <- playbase::wrapHyperLink(df$leading.edge, df$leading.edge) ## add link
+      leading.edge_link <- playbase::wrapHyperLink(
+        rep_len("<i class='fa-solid fa-circle-info'></i>", nrow(df)),
+        df$leading.edge
+      ) |> HandleNoLinkFound(
+        NoLinkString = "<i class='fa-solid fa-circle-info'></i>",
+        SubstituteString = "<i class='fa-solid fa-circle-info icon_container'></i><i class='fa fa-ban icon_nested'></i>"
+      )
 
       tbl <- DT::datatable(df,
-        rownames = FALSE, escape = c(-1, -2),
+        rownames = leading.edge_link,
+        escape = c(-1, -2),
         class = "compact cell-border stripe hover",
         extensions = c("Scroller"),
         plugins = "scrollResize",
@@ -84,6 +91,7 @@ wordcloud_table_leading_edge_server <- function(id,
       "datasets",
       func = wordcloud_leadingEdgeTable.RENDER,
       func2 = wordcloud_leadingEdgeTable.RENDER_modal,
+      csvFunc = function(){wordcloud_leadingEdgeTable.RENDER()$x$data[,-1]},
       selector = "none"
     )
 

diff --git a/components/ui/ui-utils.R b/components/ui/ui-utils.R
@@ -246,3 +246,10 @@ pgx.showSmallModal <- function(msg = "Please wait...") {
     size = "s", easyClose = FALSE, fade = FALSE
   ))
 }
+
+HandleNoLinkFound <- function(wrapHyperLinkOutput, NoLinkString, SubstituteString) {
+  pattern <- paste0("^",NoLinkString, "$")
+  special_cases <- grepl(pattern, wrapHyperLinkOutput, perl = TRUE)
+  wrapHyperLinkOutput[special_cases] <- SubstituteString
+  return(wrapHyperLinkOutput)
+}
diff --git a/scss/components/_table.scss b/scss/components/_table.scss
@@ -64,6 +64,7 @@ html {
 
     table.dataTable td, table.dataTable th {
 	border-bottom: solid 1px #aaa !important;
+    vertical-align: middle;
 //	border-style: none !important;
     }
 
@@ -91,4 +92,14 @@ html {
 	font-weight: 600;
     }
 
+    .icon_container {
+        position: relative
+    }
+
+    .icon_nested {
+    position: absolute;
+    left: 5px;
+    color: rgba(217, 83, 79, 1);
+    }
+
 }