Merge branch 'alex_dev' of github.com:omnideconv/deconvExplorer into alex_dev

Author: alex-d13

DESCRIPTION

@@ -7,6 +7,14 @@ Authors@R:
         person(
             given = "Constantin", family = "Zackl", role = c("aut", "cre"), 
             email = "zacklcon@uni-mainz.de", comment = c(ORCID = "0000-0003-1991-6943")
+        ),
+        person(
+            given = "Alexander", family = "Dietrich", role = c("aut"), 
+            email = "alex.dietrich@tum.de", comment = c(ORCID = "0000-0002-8661-0453")
+        ),
+        person(
+            given = "Lorenzo", family = "Merotto", role = c("aut"), 
+            email = "lorenzo.merotto@uibk.ac.at", comment = c(ORCID = "0009-0006-0637-8436")
         ),
 		    person(
             given = "Federico", family = "Marini", role = c("aut"), 

NAMESPACE

@@ -18,7 +18,8 @@ export(returnSelectedDeconvolutions)
 export(selectGenesByScore)
 import(omnideconv)
 import(shiny, except = c(renderDataTable, dataTableOutput))
-import(shinyBS)
+importFrom(BioQC,entropySpecificity)
+importFrom(BioQC,gini)
 importFrom(ComplexHeatmap,Heatmap)
 importFrom(ComplexHeatmap,UpSet)
 importFrom(ComplexHeatmap,comb_size)
@@ -56,6 +57,7 @@ importFrom(ggplot2,geom_rect)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,geom_tile)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggsave)
 importFrom(ggplot2,guide_colorbar)
 importFrom(ggplot2,guides)
 importFrom(ggplot2,labs)
@@ -67,6 +69,8 @@ importFrom(ggplot2,theme_minimal)
 importFrom(ggplot2,ylim)
 importFrom(ggpubr,stat_cor)
 importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,dev.off)
+importFrom(grDevices,pdf)
 importFrom(grid,gpar)
 importFrom(grid,unit)
 importFrom(plotly,config)
@@ -82,6 +86,7 @@ importFrom(rintrojs,readCallback)
 importFrom(rlang,.data)
 importFrom(shiny,addResourcePath)
 importFrom(shinyWidgets,actionBttn)
+importFrom(shinyBS,bsPopover)
 importFrom(shinycssloaders,withSpinner)
 importFrom(shinydashboard,box)
 importFrom(shinydashboard,dashboardBody)
@@ -100,7 +105,10 @@ importFrom(shinydashboard,valueBoxOutput)
 importFrom(shinyjs,hide)
 importFrom(shinyjs,show)
 importFrom(shinyjs,useShinyjs)
+importFrom(stats,complete.cases)
 importFrom(stats,cor.test)
+importFrom(stats,dist)
+importFrom(stats,hclust)
 importFrom(stats,sd)
 importFrom(stringr,str_split)
 importFrom(stringr,str_to_title)
@@ -109,3 +117,7 @@ importFrom(utils,read.delim)
 importFrom(utils,write.csv)
 importFrom(utils,write.table)
 importFrom(waiter,Waitress)
+importFrom(waiter,waiter_hide)
+importFrom(waiter,waiter_show)
+importFrom(waiter,waiter_show_on_load)
+importFrom(waiter,waiter_update)

R/DeconvExplorer-pkg.R

@@ -13,22 +13,26 @@
 #' geom_tile ggplot guide_colorbar guides labs scale_fill_gradient theme geom_text element_blank
 #' geom_hline scale_colour_brewer scale_fill_brewer ylim theme_minimal geom_rect element_rect
 #' @importFrom shinycssloaders withSpinner
-#' @importFrom waiter Waitress
+#' @importFrom waiter Waitress waiter_hide waiter_show waiter_show_on_load
+#' waiter_update
 #' @importFrom rlang .data
 #' @importFrom rintrojs introBox introjs introjsUI readCallback
-#' @importFrom DT datatable dataTableOutput renderDataTable formatRound formatPercentage
+#' @importFrom DT datatable dataTableOutput renderDataTable formatRound
+#' formatPercentage
 #' @importFrom shinyjs useShinyjs hide show
 #' @importFrom utils write.csv write.table read.delim
 #' @importFrom stringr str_to_title str_split
 #' @importFrom tidyr pivot_longer
-#' @importFrom stats sd cor.test
-#' @importFrom ComplexHeatmap Heatmap make_comb_mat UpSet comb_size upset_top_annotation extract_comb
+#' @importFrom stats sd cor.test complete.cases dist hclust
+#' @importFrom ComplexHeatmap Heatmap make_comb_mat UpSet comb_size
+#' upset_top_annotation extract_comb
 #' @importFrom grid gpar unit
-#' @importFrom InteractiveComplexHeatmap InteractiveComplexHeatmapOutput makeInteractiveComplexHeatmap
+#' @importFrom InteractiveComplexHeatmap InteractiveComplexHeatmapOutput
+#' makeInteractiveComplexHeatmap
 #' @importFrom RColorBrewer brewer.pal
 #' @importFrom circlize colorRamp2
 #' @importFrom ggforce facet_grid_paginate
-#' @importFrom grDevices colorRampPalette
+#' @importFrom grDevices colorRampPalette dev.off pdf
 #' @importFrom ggpubr stat_cor
 #' @importFrom corrplot corrplot
 #' @importFrom SummarizedExperiment assays

R/DeconvExplorer.R

@@ -201,7 +201,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
     column(
       width = 4,
       selectInput("deconvMethod", "Deconvolution Method",
-        choices = c('MuSiC'='music', omnideconv::deconvolution_methods[-10])
+        choices = c("MuSiC" = "music", omnideconv::deconvolution_methods[-10])
       )
     ),
     column(
@@ -220,8 +220,10 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
     column(
       width = 3,
       div(
-        shinyBS::popify(shinyWidgets::actionBttn("deconvolute", "Deconvolute", style = 'simple', icon = icon('triangle-exclamation'), color = 'warning'),
-                        "Attention", "Some methods are considerably slower than others; please keep this in mind when using DeconvExplorer for deconvolution."),
+        shinyBS::popify(
+          shinyWidgets::actionBttn("deconvolute", "Deconvolute", style = "simple", icon = icon("triangle-exclamation"), color = "warning"),
+          "Attention", "Some methods are considerably slower than others; please keep this in mind when using DeconvExplorer for deconvolution."
+        ),
         style = "margin-top:1.7em"
       )
     ),
@@ -234,7 +236,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
       title = "",
       content = "Select a deconvolution method to run. If required and supported by the deconvolution method you can additionally select a custom signature to be used in computation. Please note this is an advanced feature and should be used with caution. "
     )
-  
+
 
   deconv_plot_box <- shinydashboard::box(
     id = "tour_deconvPlot",
@@ -511,43 +513,45 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
     title = span("Clustered Signature", icon("question-circle", id = "sigHeatmapQ")),
     status = "info", solidHeader = TRUE,
     width = 12,
-    fluidRow(    
+    fluidRow(
       column(
         width = 4,
         selectInput("signatureToHeatmap", "Select a Signature", choices = NULL)
       ),
       column(
         width = 2,
         selectInput("signatureAnnotationScore", "Select an annotation score",
-                    choices = c("Entropy" = "entropy", "Gini Index" = "gini")
+          choices = c("Entropy" = "entropy", "Gini Index" = "gini")
         )
       ),
       column(
         width = 2,
         selectInput("signatureAnnotationPlotType", "Annotation Type",
-                    choices = c("Bars" = "bar", "Lines" = "line")
+          choices = c("Bars" = "bar", "Lines" = "line")
         )
       ),
       column(
         width = 2,
         selectInput("clusterCelltypes", "Order rows (cell types)",
-                    choices = c(".. by cell-type similarity" = "cluster", ".. alphabetically" = "no_cluster")
+          choices = c(".. by cell-type similarity" = "cluster", ".. alphabetically" = "no_cluster")
         )
       ),
       column(
         width = 2,
         selectInput("clusterGenes", "Order columns (genes)",
-                    choices = c(".. by maximal z-score per cell type" = "z-score cutoff",
-                                ".. hierarchically based on euclidean distance" = "hierarchical clustering",
-                                ".. alphabetically" = "alphabetical")
+          choices = c(
+            ".. by maximal z-score per cell type" = "z-score cutoff",
+            ".. hierarchically based on euclidean distance" = "hierarchical clustering",
+            ".. alphabetically" = "alphabetical"
+          )
         )
       )
     ),
     fluidRow(
       column(
         width = 12,
         InteractiveComplexHeatmap::originalHeatmapOutput("clusteredHeatmapOneSignature",
-                                                         width = "1250px", height = "450px", containment = TRUE
+          width = "1250px", height = "450px", containment = TRUE
         )
       )
     ),
@@ -725,7 +729,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
       column(
         width = 7,
         sliderInput("refinePercentZero", "Maximum percentage of zeroes allowed for each gene",
-                    min = 0, max = 100, value = 90, step = 1, post = "%"
+          min = 0, max = 100, value = 90, step = 1, post = "%"
         )
       ),
       column(
@@ -759,6 +763,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
     )
   )
 
+  refUnspecificPopover <-
+    shinyBS::bsPopover(
+      id = "refUnspecificQ",
+      title = "",
+      content = "The overall expression is binned into 'high', 'medium' and 'low expression' for each gene. The number of cell types the gene has to be in the 'high' bin can be modified and defaults to 1. Each gene expressed 'high' in more cell types than this parameter is removed. "
+    )
+
   refinementBestNBox <- shinydashboard::box(
     solidHeader = FALSE, width = NULL, background = "red",
     fluidRow(
@@ -810,8 +821,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
     shinyBS::bsPopover(
       id = "refManuallyQ",
       title = "",
-      content = 
-    )
+      content =
+      )
 
   # Info Boxes --------------------------------------------------------------
   info_overview <- shinydashboard::box(
@@ -1654,7 +1665,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL,
           scoring_method = input$signatureAnnotationScore,
           annotation_type = input$signatureAnnotationPlotType,
           color_palette = input$globalColor,
-          order_rows = input$clusterCelltypes, 
+          order_rows = input$clusterCelltypes,
           order_columns = input$clusterGenes
         ),
         "clusteredHeatmapOneSignature",

R/Global.R

@@ -29,7 +29,8 @@ returnSelectedDeconvolutions <- function(deconv_select, deconv_list) {
 
 #' Modal window to print error messages or other warnings
 #'
-#' @param error_message
+#' @param error_message Character string, with the content of the error to
+#' display
 #'
 #' @return NULL
 #' @export

R/SignatureExplorationPlots.R

@@ -253,22 +253,19 @@ plot_signatureClustered <- function(signature_mat,
     cell.types.ordered <- order(colnames(mat))
   }
 
-  if(order_columns == 'z-score cutoff'){
+  if (order_columns == "z-score cutoff") {
     genes <- c()
     for (c in cell.types.ordered) {
       highly.expr.genes <- names(which(mat[, c] > threshold))
       genes <- union(genes, highly.expr.genes)
     }
-    
+
     genes <- union(genes, rownames(mat))
-  }else if(order_columns == 'hierarchical clustering'){
-    
+  } else if (order_columns == "hierarchical clustering") {
     # use hierarchical ward D2 clustering based on euclidean distance
-    clustering <- hclust(dist(mat), method = 'ward.D2')
+    clustering <- hclust(dist(mat), method = "ward.D2")
     genes <- rownames(mat)[clustering$order]
-    
-  }else if(order_columns == 'alphabetical'){
-    
+  } else if (order_columns == "alphabetical") {
     genes <- sort(rownames(mat))
   }
 

R/SignatureRefinements.R

@@ -116,26 +116,26 @@ removeUnspecificGenes <- function(signature_mat,
 
   signature_mat <- as.matrix(signature_mat)
 
-  to_keep <- sapply(1:nrow(signature_mat), function(i){
+  to_keep <- sapply(1:nrow(signature_mat), function(i) {
     row <- signature_mat[i, ] # has colnames! drop FALSE is mandatory !!!!!
-    
+
     # calculate bins to prevent error
     breaks <- seq(floor(min(row)), ceiling(max(row)), length.out = number_of_bins + 1)
-    
+
     # cut into bins, seperate for each gene
     bins <- cut(row, breaks = breaks, labels = labels, include.lowest = TRUE)
-    
+
     nHighBins <- sum(bins == "high") # not working when labels is something else
-    
+
     # this value needs to be greater than one, depending of the step in the pipeline there arent
     # any rows producing zeros left but that is not the case for all signatures
     if (nHighBins <= max_count & nHighBins > 0) {
       return(TRUE)
-    }else{
+    } else {
       return(FALSE)
     }
   })
-  
+
 
   refinedSignature <- signature_mat[to_keep, ]
 

R/zzz.R

@@ -2,4 +2,4 @@
 
 .onLoad <- function(libname, pkgname) {
   shiny::addResourcePath("sbs", system.file("www", package = "shinyBS"))
-}
+}