diff --git a/DESCRIPTION b/DESCRIPTION index 211d320..5024821 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,32 +32,33 @@ Imports: shiny, shinydashboard, shinyBS, - omnideconv, + omnideconv, plotly, - ggplot2, + ggplot2, ggpubr, corrplot, ggforce, SummarizedExperiment, - shinycssloaders, + shinycssloaders, waiter, - rintrojs, - DT, - shinyjs, - stringr, - tidyr, + rintrojs, + DT, + shinyjs, + stringr, + tidyr, rlang, utils, - tools, + tools, vroom, ComplexHeatmap, grid, - InteractiveComplexHeatmap, + InteractiveComplexHeatmap, RColorBrewer, grDevices, stats, circlize, - BioQC + BioQC, + shinyWidgets RoxygenNote: 7.3.1 Encoding: UTF-8 Remotes: diff --git a/NAMESPACE b/NAMESPACE index ed72727..5cec841 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -85,6 +85,7 @@ importFrom(rintrojs,introjsUI) importFrom(rintrojs,readCallback) importFrom(rlang,.data) importFrom(shiny,addResourcePath) +importFrom(shinyWidgets,actionBttn) importFrom(shinyBS,bsPopover) importFrom(shinycssloaders,withSpinner) importFrom(shinydashboard,box) diff --git a/R/BenchmarkingPlots.R b/R/BenchmarkingPlots.R index f28cd9a..8feb0a9 100644 --- a/R/BenchmarkingPlots.R +++ b/R/BenchmarkingPlots.R @@ -57,10 +57,10 @@ plot_benchmark_scatter <- function(gtruth_df, margins = c("cell_type") ) + ggplot2::theme_bw() + - theme(axis.text.x = element_text(angle = 60, hjust = 1), strip.background = element_rect(fill = "white")) + + theme(axis.text.x = element_text(angle = 60, hjust = 1), strip.background = ggplot2::element_rect(fill = "white")) + labs(x = "true cellular fractions", y = "cell type estimates", title = "") + theme(legend.position = "none", text = element_text(size = 15)) + - geom_abline(linetype = "dashed") + ggplot::geom_abline(linetype = "dashed") # get palette max_colors <- RColorBrewer::brewer.pal.info[color_palette, ]$maxcolors # for brewer.pal() diff --git a/R/DeconvExplorer-pkg.R b/R/DeconvExplorer-pkg.R index 2e50d0d..2b3298d 100644 --- a/R/DeconvExplorer-pkg.R +++ b/R/DeconvExplorer-pkg.R @@ -8,11 +8,10 @@ #' dashboardSidebar dropdownMenu menuItem notificationItem sidebarMenu valueBox valueBoxOutput renderValueBox #' tabItem tabItems #' @importFrom plotly ggplotly plotlyOutput renderPlotly plot_ly layout config -#' @importFrom ggplot2 aes aes_ aes_string coord_cartesian coord_flip -#' element_rect element_text facet_wrap geom_abline geom_boxplot geom_col -#' geom_jitter geom_point geom_tile ggplot guide_colorbar guides labs -#' scale_fill_gradient theme geom_text element_blank geom_hline ggsave -#' scale_colour_brewer scale_fill_brewer ylim theme_minimal geom_rect +#' @importFrom ggplot2 aes aes_ aes_string coord_cartesian coord_flip element_text +#' facet_wrap geom_abline geom_boxplot geom_col geom_jitter geom_point +#' 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 waiter_hide waiter_show waiter_show_on_load #' waiter_update @@ -37,8 +36,8 @@ #' @importFrom ggpubr stat_cor #' @importFrom corrplot corrplot #' @importFrom SummarizedExperiment assays -#' @importFrom BioQC entropySpecificity gini -#' @importFrom shinyBS bsPopover +#' @importFrom shinyWidgets actionBttn +#' @import shinyBS #' #' @name DeconvExplorer-pkg #' @docType package diff --git a/R/DeconvExplorer.R b/R/DeconvExplorer.R index 47f01a9..8187b62 100644 --- a/R/DeconvExplorer.R +++ b/R/DeconvExplorer.R @@ -87,7 +87,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, fileInput("userBatchUpload", "Upload Batch IDs"), div(style = "margin-top: -20px"), fileInput("userMarkerUpload", "Upload Marker Genes"), - div(style = "margin-top: -20px"), collapsible = T, collapsed = T + div(style = "margin-top: -20px"), collapsible = T, collapsed = T, + shinyWidgets::actionBttn("selectDeconvolution", "Perform deconvolution", icon = icon("arrow-right"), color = "success", style = "simple") ) deconvUploadPopover <- @@ -126,7 +127,11 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, width = 12, fileInput("userSignatureUpload", "Upload Signature"), div(style = "margin-top: -25px"), - p("You can upload a previsouly generated signature matrix of a deconvolution method and analyse it with DeconvExplorer.") + p("You can upload a previsouly generated signature matrix of a deconvolution method and analyse it with DeconvExplorer. Multiple uploads are possible."), + fluidRow( + column(4, shinyWidgets::actionBttn("selectSigExploration", "Explore the signature", icon = icon("arrow-right"), color = "success", style = "simple")), + column(4, shinyWidgets::actionBttn("selectSigRefinement", "Refine the signature", icon = icon("arrow-right"), color = "success", style = "simple")) + ) ) signatureUploadPopover <- @@ -142,7 +147,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, width = 12, fileInput("userFractionsUpload", "Upload table with cell-type fractions"), div(style = "margin-top: -25px"), - p("You can upload a table containing cell-type fractions, either coming from a deconvolution method or a ground-truth dataset with which you want to compare your deconvolution result.") + p("You can upload a table containing cell-type fractions, either coming from a deconvolution method or a ground-truth dataset with which you want to compare your deconvolution result. Multiple uploads are possible."), + shinyWidgets::actionBttn("selectBenchmark", "Compare fractions", icon = icon("arrow-right"), color = "success", style = "simple") ) fractionsUploadPopover <- @@ -195,7 +201,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, column( width = 4, selectInput("deconvMethod", "Deconvolution Method", - choices = omnideconv::deconvolution_methods + choices = c('MuSiC'='music', omnideconv::deconvolution_methods[-10]) ) ), column( @@ -214,10 +220,10 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, column( width = 3, div( - actionButton("deconvolute", "Deconvolute"), + 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" - ), - # actionButton("deconvoluteAll", "Deconvolute All") + ) ), waiter::useWaitress() ) @@ -228,6 +234,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", @@ -504,36 +511,50 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, title = span("Clustered Signature", icon("question-circle", id = "sigHeatmapQ")), status = "info", solidHeader = TRUE, width = 12, - 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") - ) - ), - column( - width = 2, - selectInput("signatureAnnotationPlotType", "Annotation Type", - choices = c("Bars" = "bar", "Lines" = "line") + 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") + ) + ), + column( + width = 2, + selectInput("signatureAnnotationPlotType", "Annotation Type", + 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") + ) + ), + 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") + ) ) ), - column( - width = 2, - selectInput("clusterCelltypes", "Order rows", - choices = c(".. by cell-type similarity" = "cluster", ".. alphabetically" = "no_cluster") + fluidRow( + column( + width = 12, + InteractiveComplexHeatmap::originalHeatmapOutput("clusteredHeatmapOneSignature", + width = "1250px", height = "450px", containment = TRUE + ) ) ), - column( - width = 1, - div(downloadButton("signatureSelectedGenesDownloadButton", "Download selected Genes"), style = "margin-top:1.9em") - ), - column( - width = 12, - InteractiveComplexHeatmap::originalHeatmapOutput("clusteredHeatmapOneSignature", - width = "1250px", height = "450px", containment = TRUE + fluidRow( + column( + width = 2, + div(downloadButton("signatureSelectedGenesDownloadButton", "Download selected Genes"), style = "margin-top:1.9em") ) ) ) @@ -696,46 +717,49 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, refinementUnzeroBox <- shinydashboard::box( solidHeader = FALSE, width = NULL, background = "aqua", - column( - width = 4, - h1("Unzero"), icon("question-circle", id = "refUnzeroQ") - ), - column( - width = 7, - sliderInput("refinePercentZero", "Maximum percentage of zeroes allowed for each gene", - min = 0, max = 100, value = 90, step = 1, post = "%" + fluidRow( + column( + width = 4, + h1("Unzero") + ), + column( + width = 7, + sliderInput("refinePercentZero", "Maximum percentage of zeroes allowed for each gene", + min = 0, max = 100, value = 90, step = 1, post = "%" + ) + ), + column( + width = 1, + actionButton("refinePercentZeroGo", "Run", style = "margin-top: 1.7em") ) ), - column( - width = 1, - actionButton("refinePercentZeroGo", "Run", style = "margin-top: 1.7em") + fluidRow( + column(10, p("Remove genes that contain mostly 0 in their expression profile. All genes with more zeros than the provided percentage are removed. ")) ) ) - refUnzeroPopover <- - shinyBS::bsPopover( - id = "refUnzeroQ", - title = "", - content = "Remove genes that contain mostly 0 in their expression profile. All genes with more zeros than the provided percentage are removed. " - ) - refinementRemoveUnspecificBox <- shinydashboard::box( solidHeader = FALSE, width = NULL, background = "yellow", - column( - width = 4, - h1("Remove Unspecific"), icon("question-circle", id = "refUnspecificQ") - ), - column( - width = 7, - numericInput("refineUnspecific", "Remove unspecific genes", 1) + fluidRow( + column( + width = 4, + h1("Remove Unspecific") + ), + column( + width = 7, + numericInput("refineUnspecific", "Remove unspecific genes", 1) + ), + column( + width = 1, + actionButton("refineUnspecificGo", "Run", style = "margin-top: 1.7em") + ) ), - column( - width = 1, - actionButton("refineUnspecificGo", "Run", style = "margin-top: 1.7em") + fluidRow( + column(10, p("The expression of each gene over all cell types is binned into 'high', 'medium' and 'low'. A gene is considered 'specific' if its expression is 'high' in no more than n cell types; a gene with a 'high' expression in more than n cell types is removed. The 'n' parameter can be modified in the field on the side.")) ) ) - refUnspecificPopover <- +refUnspecificPopover <- shinyBS::bsPopover( id = "refUnspecificQ", title = "", @@ -744,44 +768,48 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, refinementBestNBox <- shinydashboard::box( solidHeader = FALSE, width = NULL, background = "red", - column( - width = 4, - h1("Best n genes"), icon("question-circle", id = "refBestQ") - ), - column( - width = 5, - numericInput("refineBestN", "Number of genes to select for each cell type", 20, 1) - ), - column( - width = 2, - selectInput("refineBestNScore", "How to score genes", choices = c("Entropy" = "entropy", "Gini Index" = "gini")) + fluidRow( + column( + width = 4, + h1("Best n genes") + ), + column( + width = 5, + numericInput("refineBestN", "Number of genes to select for each cell type", 20, 1) + ), + column( + width = 2, + selectInput("refineBestNScore", "How to score genes", choices = c("Entropy" = "entropy", "Gini Index" = "gini")) + ), + column( + width = 1, + actionButton("refineBestNGo", "Run", style = "margin-top: 1.7em") + ) ), - column( - width = 1, - actionButton("refineBestNGo", "Run", style = "margin-top: 1.7em") + fluidRow( + column(10, p("Based on the selected scoring method, the top ranking genes are selected for each cell type. ")) ) ) - refBestPopover <- - shinyBS::bsPopover( - id = "refBestQ", - title = "", - content = "Based on the selected scoring method, the top ranking genes are selected for each cell type. " - ) refinementManualBox <- shinydashboard::box( solidHeader = FALSE, width = NULL, background = "purple", - column( - width = 4, - h1("Remove manually"), icon("question-circle", id = "refManuallyQ") - ), - column( - width = 7, - textInput("refinementManualGene", "Type in a Gene Identifier to remove") + fluidRow( + column( + width = 4, + h1("Remove manually") + ), + column( + width = 7, + textInput("refinementManualGene", "Type in a Gene Identifier to remove") + ), + column( + width = 1, + actionButton("refinementManualGo", "Run", style = "margin-top: 1.7em") + ) ), - column( - width = 1, - actionButton("refinementManualGo", "Run", style = "margin-top: 1.7em") + fluidRow( + column(10, p("Manually remove genes by providing a Gene Identifier. ")) ) ) @@ -789,7 +817,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, shinyBS::bsPopover( id = "refManuallyQ", title = "", - content = "Manually remove genes by providing a Gene Identifier. " + content = ) # Info Boxes -------------------------------------------------------------- @@ -898,6 +926,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ), dashboardSidebar(sidebarMenu( + id = "tabs", shinyjs::useShinyjs(), rintrojs::introjsUI(), waiter::use_waiter(), @@ -1064,10 +1093,10 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, fluidRow( column( width = 8, - refinementUnzeroBox, refUnzeroPopover, - refinementRemoveUnspecificBox, refUnspecificPopover, - refinementBestNBox, refBestPopover, - refinementManualBox, refManuallyPopover + refinementUnzeroBox, + refinementRemoveUnspecificBox, + refinementBestNBox, + refinementManualBox ), refinementSettingsBox, refSettingsPopover ) @@ -1177,6 +1206,22 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, updateSelectInput(session, "benchmark_ToPlot", choices = names(internal$deconvolutions)) }) + observeEvent(input$selectDeconvolution, { + updateTabItems(session, inputId = "tabs", selected = "deconv") + }) + + observeEvent(input$selectSigExploration, { + updateTabItems(session, inputId = "tabs", selected = "signatureExploration") + }) + + observeEvent(input$selectSigRefinement, { + updateTabItems(session, inputId = "tabs", selected = "signatureRefinement") + }) + + observeEvent(input$selectBenchmark, { + updateTabItems(session, inputId = "tabs", selected = "benchmark") + }) + observeEvent(input$loadSample, { waiter::waiter_show(html = tagList(waiter::spin_rotating_plane(), "Loading example data ..."), color = overlay_color) internal$bulk[["Example Bulk"]] <- omnideconv::bulk @@ -1184,6 +1229,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, internal$annotation[["Example Cell-type annotation"]] <- omnideconv::cell_type_annotations_1 internal$batch[["Example Batch-IDs"]] <- omnideconv::batch_ids_1 internal$deconvolutions[["Example Ground-truth"]] <- omnideconv::RefData + internal$deconvolutions[["Example Deconvolution Result (DWLS)"]] <- readRDS(system.file("extdata", "deconvolution_example.rds", package = "DeconvExplorer")) internal$signatures[["Example Signature (DWLS)"]] <- readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer")) showNotification("Loaded Sample Data") @@ -1598,14 +1644,14 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, } ) - # plot interactive heatmap observe({ req( input$signatureToHeatmap, input$signatureAnnotationScore, input$signatureAnnotationPlotType, - input$clusterCelltypes + input$clusterCelltypes, + input$clusterGenes ) signature <- isolate(internal$signatures[[input$signatureToHeatmap]]) InteractiveComplexHeatmap::makeInteractiveComplexHeatmap(input, @@ -1615,7 +1661,8 @@ 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", brush_action = brush_action @@ -2026,7 +2073,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # load file, depending on extension if (ext == "txt") { - content <- utils::read.table(path) + content <- utils::read.table(path, header = T) } else if (ext == "csv") { content <- vroom::vroom(path, delim = ",") } else if (ext == "tsv") { diff --git a/R/SignatureExplorationPlots.R b/R/SignatureExplorationPlots.R index 4af6a63..4091970 100644 --- a/R/SignatureExplorationPlots.R +++ b/R/SignatureExplorationPlots.R @@ -176,6 +176,7 @@ plot_signatureClustered <- function(signature_mat, annotation_type = "line", color_palette = "Spectral", order_rows = "cluster", + order_columns = "z-score cutoff", threshold = 1.5) { if (is.null(signature_mat)) { stop("Please provide a signature") @@ -252,13 +253,25 @@ plot_signatureClustered <- function(signature_mat, cell.types.ordered <- order(colnames(mat)) } - genes <- c() - for (c in cell.types.ordered) { - highly.expr.genes <- names(which(mat[, c] > threshold)) - genes <- union(genes, highly.expr.genes) + 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'){ + + # use hierarchical ward D2 clustering based on euclidean distance + clustering <- hclust(dist(mat), method = 'ward.D2') + genes <- rownames(mat)[clustering$order] + + }else if(order_columns == 'alphabetical'){ + + genes <- sort(rownames(mat)) } - genes <- union(genes, rownames(mat)) # Plot with complex heatmap @@ -268,7 +281,6 @@ plot_signatureClustered <- function(signature_mat, border = TRUE, col = col_fun, column_order = genes, row_order = cell.types.ordered, - # cluster_columns = agnes(mat), cluster_rows = diana(t(mat)) # cluster_columns = TRUE, cluster_rows = cluster_rows, # clustering_method_columns = "euclidean", top_annotation = annotation ) diff --git a/R/SignatureRefinements.R b/R/SignatureRefinements.R index 544c824..f5a630b 100644 --- a/R/SignatureRefinements.R +++ b/R/SignatureRefinements.R @@ -75,7 +75,7 @@ removePercentZeros <- function(signature_mat, max_percentage_zeroes = 0.5) { #' Remove unspecific Genes of a Gene Expression Signature #' #' Remove genes expressed in an unspecific manner. The expression range is divided into -#' a user selected number of bins. Only genes expressed high in celltypes are returned. +#' a user selected number of bins. Only genes expressed high in cell types are returned. #' Genes expressed high in more than cell types are discarded. #' #' @param signature_mat gene Expression Signature @@ -116,25 +116,26 @@ removeUnspecificGenes <- function(signature_mat, signature_mat <- as.matrix(signature_mat) - to_keep <- vector(length = nrow(signature_mat)) - - for (i in 1:nrow(signature_mat)) { + 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) { - to_keep[i] <- TRUE + return(TRUE) + }else{ + return(FALSE) } - } + }) + refinedSignature <- signature_mat[to_keep, ] diff --git a/inst/extdata/app_information.md b/inst/extdata/app_information.md index 21cecb4..47acf12 100644 --- a/inst/extdata/app_information.md +++ b/inst/extdata/app_information.md @@ -27,21 +27,10 @@ uploaded as txt as well.** - Vector containing gene names - This is only necessary for BSeq-sc -#### SimBu Simulation - -If no ground truth data is available for your bulk dataset you can -benchmark by simulating a pseudo-bulk sample with known cell type -fraction using SimBu. To transfer your simulation to DeconvExplorer save -it in rds format and upload it to retrieve the simulated bulk file and -the corresponding ground truth. - - simulation <- SimBu::simulate_bulk(...) - saveRDS(simulation, 'filepath.rds') # upload this file - #### Custom Signature and Ground Truth Reference -Please make sure the first column contains gene identifiers matching the -bulk sample. +The signature matrix you upload, needs to have gene symbols as the first column. The other columns need to be cell types, +which signature-specific values in each cell. # Deconvolution diff --git a/man/plot_signatureClustered.Rd b/man/plot_signatureClustered.Rd index e424df9..81a68ac 100644 --- a/man/plot_signatureClustered.Rd +++ b/man/plot_signatureClustered.Rd @@ -12,6 +12,7 @@ plot_signatureClustered( annotation_type = "line", color_palette = "Spectral", order_rows = "cluster", + order_columns = "z-score cutoff", threshold = 1.5 ) } diff --git a/man/removeUnspecificGenes.Rd b/man/removeUnspecificGenes.Rd index 4d10905..b090c82 100644 --- a/man/removeUnspecificGenes.Rd +++ b/man/removeUnspecificGenes.Rd @@ -26,7 +26,7 @@ a gene expression signature containing only genes matching the passed requiremen } \description{ Remove genes expressed in an unspecific manner. The expression range is divided into -a user selected number of bins. Only genes expressed high in celltypes are returned. +a user selected number of bins. Only genes expressed high in cell types are returned. Genes expressed high in more than cell types are discarded. } \examples{