diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 989eaae..4afcffc 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -18,11 +18,9 @@ jobs: fail-fast: false matrix: config: - - { os: macOS-latest, r: "release" } - - { os: windows-latest, r: "release" } - { os: ubuntu-latest, r: "devel", http-user-agent: "release" } - { os: ubuntu-latest, r: "release" } - - { os: ubuntu-latest, r: "oldrel-1" } + #- { os: ubuntu-latest, r: "oldrel-1" } env: R_REMOTES_NO_ERRORS_FROM_WARNINGS: true diff --git a/DESCRIPTION b/DESCRIPTION index 997f1db..d003835 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,6 +23,7 @@ Depends: Imports: shiny, shinydashboard, + shinyBS, omnideconv, plotly, ggplot2, @@ -49,7 +50,7 @@ Imports: stats, circlize, BioQC -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Encoding: UTF-8 Remotes: github::omnideconv/omnideconv @@ -59,5 +60,10 @@ Suggests: bookdown, testthat (>= 3.0.0), markdown +biocViews: + Software, GeneExpression, ImmunoOncology, Sequencing, Transcription, + Classification, Transcriptomics, Visualization +URL: https://github.com/omnideconv/DeconvExplorer/ +BugReports: https://github.com/omnideconv/DeconvExplorer/issues VignetteBuilder: knitr Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 2fc987d..11bd072 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(DeconvExplorer) export(download_signatureUpset) +export(errorModal) export(plot_benchmark_correlation) export(plot_benchmark_rmse) export(plot_benchmark_scatter) @@ -14,10 +15,10 @@ export(removePercentZeros) export(removeUnspecificGenes) export(renameCellType) export(returnSelectedDeconvolutions) -export(scoreEntropy) export(selectGenesByScore) import(omnideconv) import(shiny, except = c(renderDataTable, dataTableOutput)) +import(shinyBS) importFrom(ComplexHeatmap,Heatmap) importFrom(ComplexHeatmap,UpSet) importFrom(ComplexHeatmap,comb_size) @@ -50,6 +51,7 @@ importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_jitter) importFrom(ggplot2,geom_point) +importFrom(ggplot2,geom_rect) importFrom(ggplot2,geom_text) importFrom(ggplot2,geom_tile) importFrom(ggplot2,ggplot) diff --git a/R/BenchmarkingPlots.R b/R/BenchmarkingPlots.R index 2844a59..f28cd9a 100644 --- a/R/BenchmarkingPlots.R +++ b/R/BenchmarkingPlots.R @@ -47,24 +47,20 @@ plot_benchmark_scatter <- function(gtruth_df, # merge merged.df <- merge(df, ref, all.x = TRUE) # keep all deconvolution results + merged.df <- merged.df[complete.cases(merged.df), ] # build plot plot <- ggplot(merged.df, aes(x = .data$truth, y = .data$estimate, color = .data$cell_type)) + - geom_point(show.legend = FALSE) + - ggpubr::stat_cor(label.sep = "\n", size = 3, color = "black", label.x.npc = 0.01) + + geom_point(show.legend = FALSE, size = 3, alpha = .8) + + ggpubr::stat_cor(label.sep = "\n", size = 3, color = "black", label.x.npc = 0.05, label.y = max(merged.df$estimate) + 0.05, vjust = 1) + ggforce::facet_grid_paginate(method ~ .data$cell_type, - margins = c("cell_type"), scales = "free" + margins = c("cell_type") ) + ggplot2::theme_bw() + - theme(axis.text.x = element_text(angle = 60, hjust = 1)) + + theme(axis.text.x = element_text(angle = 60, hjust = 1), strip.background = element_rect(fill = "white")) + labs(x = "true cellular fractions", y = "cell type estimates", title = "") + - theme(legend.position = "none", text = element_text(size = 15)) - - plot <- plot + geom_abline() + - ggforce::facet_grid_paginate(method ~ .data$cell_type, - margins = c("cell_type"), scales = "free" - ) + - theme(axis.text.x = element_text(angle = 60, hjust = 1)) + theme(legend.position = "none", text = element_text(size = 15)) + + 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 48dc76e..f7d65bf 100644 --- a/R/DeconvExplorer-pkg.R +++ b/R/DeconvExplorer-pkg.R @@ -11,7 +11,7 @@ #' @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_hline scale_colour_brewer scale_fill_brewer ylim theme_minimal geom_rect #' @importFrom shinycssloaders withSpinner #' @importFrom waiter Waitress #' @importFrom rlang .data @@ -32,7 +32,8 @@ #' @importFrom ggpubr stat_cor #' @importFrom corrplot corrplot #' @importFrom SummarizedExperiment assays +#' @import shinyBS #' #' @name DeconvExplorer-pkg #' @docType package -NULL +"_PACKAGE" diff --git a/R/DeconvExplorer.R b/R/DeconvExplorer.R index 7b39757..a1a3241 100644 --- a/R/DeconvExplorer.R +++ b/R/DeconvExplorer.R @@ -1,35 +1,46 @@ #' Run DeconvExplorer #' -#' @param deconvexp_bulk Bulk Sequencing data which will be deconvoluted -#' @param deconvexp_singlecelldata Single Cell Data which is used to calculate the signature matrix -#' @param deconvexp_cell_annotation Cell Type annotations for the single cell data -#' @param deconvexp_batch Batch IDs, only for some deconvolution methods +#' This function launches a Shiny app to facilitate cell type deconvolution using both bulk +#' and single-cell RNA sequencing data. It provides a comprehensive interface for data upload, +#' deconvolution execution, and result visualization. The app supports various deconvolution +#' methods and offers tools for signature matrix refinement. #' -#' @return A Shiny app object is returned +#' @param deconvexp_bulk Optional; a matrix or data frame containing bulk sequencing data to be deconvoluted. +#' Rows should represent genes, and columns should represent samples. The data can also be +#' uploaded directly in the app. #' -#' @export +#' @param deconvexp_singlecelldata Optional; a matrix, data frame, or SingleCellExperiment object +#' containing single-cell data used to calculate the signature matrix. Rows should represent genes, +#' and columns should represent single cells. +#' +#' @param deconvexp_cell_annotation Optional; a vector providing cell type annotations +#' for the single-cell data. Each entry corresponds to the cell type of the respective column +#' in `deconvexp_singlecelldata`. +#' +#' @param deconvexp_batch Optional; a vector indicating the batch ID for each sample or cell +#' in `deconvexp_singlecelldata`. This is relevant for methods that can adjust for batch effects. #' -#' @examples -#' if (interactive()) { -#' DeconvExplorer::DeconvExplorer() -#' } +#' @param maxsize_upload Numeric; specifies the maximum file size in MB acceptable for upload +#' during runtime. This is particularly important when files are uploaded directly through the +#' app interface. Defaults to 50 MB. #' -#' # COSTODO: an example where the parameters are provided before starting the app -#' # my_deconvexp_bulk <- ... -#' # my_deconvexp_singlecelldata <- ... -#' # my_deconvexp_cell_annotation <- ... -#' # my_deconvexp_batch <- ... -#' # if (interactive()) { -#' # DeconvExplorer::DeconvExplorer(deconvexp_bulk = ..., -#' # deconvexp_singlecelldata = ..., -#' # deconvexp_cell_annotation = ..., -#' # deconvexp_batch = ... -#' # ) -#' # } +#' @return Starts a shiny app +#' +#' @export DeconvExplorer <- function(deconvexp_bulk = NULL, deconvexp_singlecelldata = NULL, deconvexp_cell_annotation = NULL, - deconvexp_batch = NULL) { + deconvexp_batch = NULL, + maxsize_upload = 50) { + # options management + oopt <- options( + spinner.type = 6, + spinner.color = "#0092AC", + shiny.maxRequestSize = maxsize_upload * 1024^2 + ) + # play nice with other previously chosen options + on.exit(options(oopt)) + # methods that produce a signature produces_signature <- c( # "BSeq-sc" = "bseqsc", # markers!!! @@ -46,6 +57,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, "MOMF" = "momf" ) + overlay_color <- "rgb(51, 62, 72, .5)" + # Data Upload Boxes ------------------------------------------------------- data_simbu_box <- shinydashboard::box( @@ -63,7 +76,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, data_deconvolution <- shinydashboard::box( id = "tour_upload", - title = "Deconvolution", solidHeader = TRUE, status = "primary", width = 12, + title = span("Input files for Deconvolution", icon("question-circle"), id = "uploadDeconvolutionQ"), + solidHeader = TRUE, status = "primary", width = 12, fileInput("userBulkUpload", "Upload Bulk Data"), div(style = "margin-top: -20px"), fileInput("userSingleCellUpload", "Upload Single Cell Data"), @@ -73,50 +87,82 @@ 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"), + div(style = "margin-top: -20px"), collapsible = T, collapsed = T ) + deconvUploadPopover <- + shinyBS::bsPopover( + id = "uploadDeconvolutionQ", + title = "Upload Data for deconvolution", + content = "Provide bulk and single cell data as well as the respective cell type annotation. This data will be used as input for deconvolution. Some methods might require additional batch labels or marker genes.", + trigger = "hover" + ) + data_load_sample <- shinydashboard::box( id = "tour_sample", - title = "Load Sample Data", solidHeader = TRUE, status = "primary", width = 12, - column( - width = 4, - div(selectInput("sampleNumber", NULL, choices = c("Sample 1" = 1, "Sample2" = 2, "Sample3" = 3)), style = "margin-top:0.5em;") - ), + title = span("Load Example Data", icon("question-circle", id = "exampleDataQ")), + solidHeader = TRUE, status = "primary", width = 12, column( width = 3, - div(actionButton("loadSample", "Load Sample Files"), style = "margin-top:0.5em") + div(actionButton("loadSample", "Load Example Files"), style = "margin-top:0.5em") ), column( - width = 5, - helpText("Ground truth data will be loaded as 'SampleReference'") + width = 8, + helpText("Ground truth data will be loaded as 'Example Ground-truth'") ) ) + exampleDataPopover <- + shinyBS::bsPopover( + id = "exampleDataQ", + title = "Example Data", + content = "Load a sample dataset that can be used to showcase deconvExplorers features." + ) + data_load_signature <- shinydashboard::box( id = "tour_signatureUpload", - title = "Upload Signature", solidHeader = TRUE, status = "primary", + title = span("Upload Signature", icon("question-circle", id = "uploadSignatureQ")), + solidHeader = TRUE, status = "primary", width = 12, fileInput("userSignatureUpload", "Upload Signature"), - div(style = "margin-top: -25px") + div(style = "margin-top: -25px"), + p("You can upload a previsouly generated signature matrix of a deconvolution method and analyse it with DeconvExplorer.") ) - data_load_reference <- shinydashboard::box( - title = "Upload a custom reference file", solidHeader = TRUE, status = "primary", + signatureUploadPopover <- + shinyBS::bsPopover( + id = "uploadSignatureQ", + title = "Gene Expression Signature", + content = "Upload a gene expression signature. The signature can further be analyzed in the Signature Exploration and Refinement modules or used as input in deconvolution." + ) + + data_load_fractions <- shinydashboard::box( + title = span("Upload cell-type fractions", icon("question-circle", id = "uploadFractionsQ")), + solidHeader = TRUE, status = "primary", width = 12, - fileInput("userReferenceUpload", "Upload Reference") + 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.") ) + fractionsUploadPopover <- + shinyBS::bsPopover( + id = "uploadFractionsQ", + title = "Deconvolution results or Ground Truth", + content = "Upload cell fractions or ground truth to be used in comparisons or benchmarking." + ) + data_info <- shinydashboard::box( title = span(icon("info-circle"), "Input data formats and requirements"), solidHeader = FALSE, width = 12, - collapsible = TRUE, collapsed = FALSE, + collapsible = TRUE, collapsed = TRUE, includeMarkdown(system.file("extdata", "data_info.md", package = "DeconvExplorer")) ) # Deconvolution Boxes ------------------------------------------------------- data_upload_box <- shinydashboard::box( - title = "Select your Data", status = "primary", + title = span("Select your Data", icon("question-circle", id = "deconvSelectDataQ")), + status = "primary", solidHeader = TRUE, height = "30em", # collapsible = TRUE, # used to be 30em selectInput("bulkSelection", "Select a bulk dataset", choices = NULL), div(style = "margin-top: -10px"), @@ -129,9 +175,17 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, selectInput("markerSelection", "Select Marker Genes", choices = NULL) ) + deconvSelectDataPopover <- + shinyBS::bsPopover( + id = "deconvSelectDataQ", + title = "", + content = "Select the datasets you want to use as input for deconvolution. Upload your Data in the Data Upload module. Your first uploaded dataset will be selected automatically. " + ) + settings_box <- shinydashboard::box( id = "tour_deconvSettings", - title = "Deconvolution Settings", status = "primary", + title = span("Deconvolution Settings", icon("question-circle", id = "deconvSettingsQ")), + status = "primary", solidHeader = TRUE, height = "30em", # collapsible = TRUE, # used to be 30em imageOutput("logo", height = "auto"), column( @@ -168,9 +222,16 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, waiter::useWaitress() ) + deconvSettingsPopover <- + shinyBS::bsPopover( + id = "deconvSettingsQ", + 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", - title = span("Deconvolution Plot ", icon("tasks", lib = "glyphicon")), + title = span("Deconvolution Plot ", icon("tasks", lib = "glyphicon"), icon("question-circle", id = "deconvPlotQ")), status = "warning", solidHeader = TRUE, width = 12, column( width = 3, @@ -199,6 +260,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + deconvPlotPopover <- + shinyBS::bsPopover( + id = "deconvPlotQ", + title = "", + content = "Customize plot type and grouping of the results. You can change the selected deconvolution results above. " + ) + deconv_table_box <- shinydashboard::box( title = span("Deconvolution Table ", icon("th", lib = "glyphicon")), status = "warning", solidHeader = TRUE, width = 12, @@ -245,11 +313,11 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, deconv_all_results <- shinydashboard::box( id = "tour_deconvPlotSettings", - title = NULL, status = NULL, solidHeader = FALSE, width = 12, + title = span("Results", icon("question-circle", id = "deconvResultQ")), status = NULL, solidHeader = FALSE, width = 12, column( width = 5, selectInput("deconvolutionToPlot", "Select Deconvolution results", - choices = c("dwls_dwls"), selected = "dwls_dwls", multiple = TRUE + choices = c(""), multiple = TRUE ) ), column( @@ -270,13 +338,28 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + deconvResultPopover <- shinyBS::bsPopover( + id = "deconvResultsQ", + title = "", + content = "Select one or multiple deconvolution results to be plotted below. " + ) + + # Benchmarking Boxes ------------------------------------------------------ benchmark_deconvolutionSelection <- shinydashboard::box( - title = "Deconvolution Settings", status = "info", solidHeader = TRUE, width = 12, + title = span("Benchmarking Selection", icon("question-circle", id = "benchSettingsQ")), + status = "info", solidHeader = TRUE, width = 12, selectInput("benchmark_reference", "Reference", choices = NULL), selectInput("benchmark_ToPlot", "Select Deconvolution to benchmark", choices = NULL, multiple = TRUE) ) + benchSettingsPopover <- + shinyBS::bsPopover( + id = "benchSettingsQ", + title = "", + content = "Compare deconvolution results to a ground truth or between each other. The ground truth can be uploaded as cell fractions in the data module." + ) + benchmark_plot_box <- shinydashboard::tabBox( title = "Benchmark", width = 12, @@ -367,31 +450,59 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # Signature Exploration Boxes --------------------------------------------- signature_genesPerMethod <- shinydashboard::box( id = "tour_genesPlot", - title = "Genes per Method", status = "info", solidHeader = TRUE, + title = span("Genes per Method", icon("question-circle", id = "sigGenesQ")), + status = "info", solidHeader = TRUE, width = 4, withSpinner( plotOutput("signatureGenesPerMethod") - ) + ), + downloadButton("downloadSignatureGenesPerMethod", label = "Download as PDF") ) + sigGenesPopover <- + shinyBS::bsPopover( + id = "sigGenesQ", + title = "", + content = "Compare the size of available signatures. The plot displays the number of genes contained in each signature. Smaller signatures result in faster computation time." + ) + signature_kappaPerMethod <- shinydashboard::box( - title = "Condition Number per Method", status = "info", solidHeader = TRUE, + title = span("Condition Number per Method", icon("question-circle", id = "sigConditionNumberQ")), + status = "info", solidHeader = TRUE, width = 4, withSpinner( plotOutput("kappaPerMethod") - ) + ), + downloadButton("downloadKappaPerMethod", label = "Download as PDF") ) + sigConditionNumberPopover <- + shinyBS::bsPopover( + id = "sigConditionNumberQ", + title = "", + content = "The condition number quantifies how robust the signature is to noise in the input bulk data. In general, a lower number is considered to provide more stable deconvolution results." + ) + signature_entropyPerMethod <- shinydashboard::box( - title = "Mean Entropy per Method", status = "info", solidHeader = TRUE, + title = span("Mean Entropy per Method", icon("question-circle", id = "sigEntropyQ")), + status = "info", solidHeader = TRUE, width = 4, withSpinner( plotOutput("signatureEntropyPerMethod") - ) + ), + downloadButton("downloadSignatureEntropyPerMethod", label = "Download as PDF") ) + sigEntropyPopover <- + shinyBS::bsPopover( + id = "sigEntropyQ", + title = "", + content = "The entropy quantifies how informative a gene's expression pattern is across cell-types. Lower values indicate a more cell-type specific expression pattern. Please note that very low values could also hint sequencing artifacts." + ) + signature_clusteredHeatmap <- shinydashboard::box( - title = "Clustered Signature", status = "info", solidHeader = TRUE, + title = span("Clustered Signature", icon("question-circle", id = "sigHeatmapQ")), + status = "info", solidHeader = TRUE, width = 12, column( width = 4, @@ -410,7 +521,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ), column( - width = 4, + width = 2, + selectInput("clusterCelltypes", "Order rows", + choices = c(".. by cell-type similarity" = "cluster", ".. alphabetically" = "no_cluster") + ) + ), + column( + width = 1, div(downloadButton("signatureSelectedGenesDownloadButton", "Download selected Genes"), style = "margin-top:1.9em") ), column( @@ -421,6 +538,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + sigHeatmapPopover <- + shinyBS::bsPopover( + id = "sigHeatmapQ", + title = "", + content = "This heatmap displays the z-scored expression profile of all genes in the signature. By selecting a subsection of the plot a more in-depth analysis is possible in the next plot below." + ) + signature_clusteredHeatmapSubPlot <- shinydashboard::box( title = "Sub Selection Heatmap", status = "info", solidHeader = TRUE, width = 12, collapsible = TRUE, collapsed = TRUE, @@ -440,11 +564,20 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) signature_upsetPlot <- shinydashboard::box( - title = "UpSet Plot", status = "info", solidHeader = TRUE, width = 8, height = "33em", + title = span("UpSet Plot", icon("question-circle", id = "sigUpsetQ")), + status = "info", solidHeader = TRUE, width = 8, height = "33em", withSpinner( plotOutput("signatureUpset") ) ) + + sigUpsetPopover <- + shinyBS::bsPopover( + id = "sigUpsetQ", + title = "", + content = "Compare and analyze the available genes and composition from all provided signatures." + ) + signature_upsetPlotSettings <- shinydashboard::box( title = "UpSet Plot Settings", status = "info", solidHeader = TRUE, width = 4, height = "33em", @@ -491,7 +624,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, checkboxGroupInput("upSetDownloadSelection", h3("Download Genes of a specific subset"), choices = NULL, inline = TRUE ), - downloadButton("upSetDownloadButton", label = "Download Subset Genes") + downloadButton("upSetDownloadButton", label = "Download Subset Genes"), + downloadButton("upSetPlotDownloadButton", label = "Download plot as PDF") ) # Signature Refinement Boxes ---------------------------------------------- @@ -519,7 +653,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) refinementSettingsBox <- shinydashboard::box( - title = "Settings", solidHeader = TRUE, width = 4, status = "info", + title = span("Settings", icon("question-circle", id = "refSettingsQ")), + solidHeader = TRUE, width = 4, status = "info", column( width = 8, selectInput("signatureToRefine", "Choose a signature to refine", choices = NULL) @@ -552,11 +687,18 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + refSettingsPopover <- + shinyBS::bsPopover( + id = "refSettingsQ", + title = "", + content = "Load a signature for modifications. A new name is required for saving. If necessary, cell-types can be renamed." + ) + refinementUnzeroBox <- shinydashboard::box( solidHeader = FALSE, width = NULL, background = "aqua", column( width = 4, - h1("Unzero") + h1("Unzero"), icon("question-circle", id = "refUnzeroQ") ), column( width = 7, @@ -570,11 +712,18 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + 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") + h1("Remove Unspecific"), icon("question-circle", id = "refUnspecificQ") ), column( width = 7, @@ -586,11 +735,18 @@ 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", column( width = 4, - h1("Best n genes") + h1("Best n genes"), icon("question-circle", id = "refBestQ") ), column( width = 5, @@ -606,11 +762,18 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + 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") + h1("Remove manually"), icon("question-circle", id = "refManuallyQ") ), column( width = 7, @@ -622,6 +785,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) ) + refManuallyPopover <- + shinyBS::bsPopover( + id = "refManuallyQ", + title = "", + content = "Manually remove genes by providing a Gene Identifier. " + ) + # Info Boxes -------------------------------------------------------------- info_overview <- shinydashboard::box( id = "tour_infoOverview", @@ -645,7 +815,10 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, h3(icon("envelope"), style = "display: inline; margin-right:1em"), a("Francesca Finotello", href = "mailto:francesca.finotello@uibk.ac.at", style = "margin-right:1em"), a("Markus List", href = "mailto:markus.list@wzw.tum.de", style = "margin-right:1em"), - a("Gregor Sturm", href = "mailto:gregor.stum@i-med.ac.at", style = "margin-right:1em"), + a("Federico Marini", href = "mailto:marinif@uni-mainz.de", style = "margin-right:1em"), + a("Constantin Zackl", href = "mailto:Constantin.Zackl@student.uibk.ac.at", style = "margin-right:1em"), + a("Lorenzo Meretto", href = "mailto:Lorenzo.Merotto@uibk.ac.at", style = "margin-right:1em"), + a("Alexander Dietrich", href = "mailto:alex.dietrich@tum.de", style = "margin-right:1em"), style = "display:block; font-size:1.4em; margin-top:0.7em; " ) ), br() @@ -670,6 +843,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, div(includeMarkdown(system.file("extdata", "app_information.md", package = "DeconvExplorer")), style = "padding:1em; padding-top:0em") ) + # ui definition ---------------------------------------------------------- deconvexplorer_ui <- dashboardPage( dashboardHeader( @@ -683,12 +857,12 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, text = actionButton("startTour", "Start Tour", icon = icon("directions") ), - icon = icon("", verify_fa = FALSE) + icon = icon(NULL, verify_fa = FALSE) ), notificationItem(text = actionButton("githubLink", "View the Code", onclick = "window.open('https://github.com/omnideconv', '_blank')", icon = icon("github") - ), icon = icon("", verify_fa = FALSE)) + ), icon = icon(NULL, verify_fa = FALSE)) ), dropdownMenu( type = "task", @@ -697,15 +871,15 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, badgeStatus = NULL, notificationItem( text = textInput("csxEmail", "Email Adress"), - icon = icon("", verify_fa = FALSE) + icon = icon(NULL, verify_fa = FALSE) ), notificationItem( text = textInput("csxToken", "Token"), - icon = icon("", verify_fa = FALSE) + icon = icon(NULL, verify_fa = FALSE) ), notificationItem( text = actionButton("setCSX", "Set CIBERSORTx Credentials"), - icon = icon("", verify_fa = FALSE) + icon = icon(NULL, verify_fa = FALSE) ) ), dropdownMenu( @@ -715,17 +889,19 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, badgeStatus = NULL, notificationItem( text = downloadButton("downloadSession", "Download Session"), - icon = icon("", verify_fa = FALSE) + icon = icon(NULL, verify_fa = FALSE) ), notificationItem( text = fileInput("uploadSession", "Upload Session File", accept = c(".rds")), - icon = icon("", verify_fa = FALSE), status = "primary" + icon = icon(NULL, verify_fa = FALSE), status = "primary" ) ) ), dashboardSidebar(sidebarMenu( shinyjs::useShinyjs(), - introjsUI(), + rintrojs::introjsUI(), + waiter::use_waiter(), + waiter::waiter_show_on_load(html = tagList(waiter::spin_rotating_plane(), "Loading necessary packages ...")), menuItem("Data Upload", tabName = "data"), menuItem("Deconvolution", tabName = "deconv"), menuItem("Signature Exploration", tabName = "signatureExploration"), @@ -734,27 +910,109 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, menuItem("Further Information", tabName = "fInfo"), selectInput("globalColor", "Select Plot Color Palette", choices = c("Set1", "Set2", "Set3", "Paired", "Dark2", "Spectral", "Accent"), - selected = "Spectral" + selected = "Dark2" ) )), dashboardBody( tags$head(tags$style( - HTML(".wrapper {height: auto !important; - position:relative; overflow-x:hidden; overflow-y:hidden}") + HTML(" + .wrapper {height: auto !important; + position:relative; overflow-x:hidden; overflow-y:hidden} + /* logo */ + .skin-blue .main-header .logo { + background-color: #11415d; + } + + /* logo when hovered */ + .skin-blue .main-header .logo:hover { + background-color: #11415d; + } + + /* navbar (rest of the header) */ + .skin-blue .main-header .navbar { + background-color: #11415d; + } + + /* main sidebar */ + .skin-blue .main-sidebar { + background-color: #11415d; + } + + /* active selected tab in the sidebarmenu */ + .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{ + background-color: #73bfa7; + } + + /* other links in the sidebarmenu */ + .skin-blue .main-sidebar .sidebar .sidebar-menu a{ + background-color: #3687ba; + color: #000000; + } + + /* other links in the sidebarmenu when hovered */ + .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{ + background-color: #afdca4; + } + + /* toggle button when hovered */ + .skin-blue .main-header .navbar .sidebar-toggle:hover{ + background-color: #3687ba; + } + + /* primary box header and border */ + .box.box-solid.box-primary>.box-header { + color:#ffffff; + background:#11415d + } + .box.box-solid.box-primary{ + border-bottom-color:#11415d; + border-left-color:#11415d; + border-right-color:#11415d; + border-top-color:#11415d; + } + + /* info box header and border */ + .box.box-solid.box-info>.box-header { + color:#ffffff; + background:#3687ba + } + .box.box-solid.box-info{ + border-bottom-color:#3687ba; + border-left-color:#3687ba; + border-right-color:#3687ba; + border-top-color:#3687ba; + } + + /* warning box header and border */ + .box.box-solid.box-warning>.box-header { + color:#ffffff; + background:#ee6d3d + } + .box.box-solid.box-warning{ + border-bottom-color:#ee6d3d; + border-left-color:#ee6d3d; + border-right-color:#ee6d3d; + border-top-color:#ee6d3d; + } + + .popover{ + color:#000000 + } + ") )), tabItems( tabItem(tabName = "data", fluidPage( fluidRow( column( width = 6, - data_deconvolution + data_load_signature, signatureUploadPopover, + data_load_fractions, fractionsUploadPopover, + data_load_sample, exampleDataPopover, + data_deconvolution, deconvUploadPopover ), column( width = 6, - data_simbu_box, - data_load_sample, - data_load_signature, - data_load_reference + imageOutput("logoDeconvExplorer", height = "auto") ) ), fluidRow( @@ -767,26 +1025,26 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, )), tabItem(tabName = "deconv", fluidPage( fluidRow( - data_upload_box, - settings_box + data_upload_box, deconvSelectDataPopover, + settings_box, deconvSettingsPopover ), fluidRow( - deconv_all_results + deconv_all_results, deconvResultPopover ), fluidRow( - deconv_plot_box, + deconv_plot_box, deconvPlotPopover, deconv_table_box, deconv_signature_box ) )), tabItem(tabName = "signatureExploration", fluidPage( fluidRow( - signature_genesPerMethod, - signature_kappaPerMethod, - signature_entropyPerMethod + signature_genesPerMethod, sigGenesPopover, + signature_kappaPerMethod, sigConditionNumberPopover, + signature_entropyPerMethod, sigEntropyPopover ), fluidRow( - signature_clusteredHeatmap + signature_clusteredHeatmap, sigHeatmapPopover ), fluidRow( signature_clusteredHeatmapSubPlot @@ -795,7 +1053,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, signature_clusteredHeatmapSubTable ), fluidRow( - signature_upsetPlot, + signature_upsetPlot, sigUpsetPopover, signature_upsetPlotSettings ) )), @@ -806,17 +1064,17 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, fluidRow( column( width = 8, - refinementUnzeroBox, - refinementRemoveUnspecificBox, - refinementBestNBox, - refinementManualBox + refinementUnzeroBox, refUnzeroPopover, + refinementRemoveUnspecificBox, refUnspecificPopover, + refinementBestNBox, refBestPopover, + refinementManualBox, refManuallyPopover ), - refinementSettingsBox + refinementSettingsBox, refSettingsPopover ) )), tabItem(tabName = "benchmark", fluidPage( fluidRow( - benchmark_deconvolutionSelection + benchmark_deconvolutionSelection, benchSettingsPopover ), fluidRow( benchmark_plot_box @@ -839,11 +1097,14 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, deconvexplorer_server <- shinyServer(function(input, output, session) { # nocov start + waiter::waiter_hide() # General Setup ----------------------------------------------------------- internal <- shiny::reactiveValues( - signatures = list("dwls" = readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer"))), - deconvolutions = list("dwls_dwls" = readRDS(system.file("extdata", "deconvolution_example.rds", package = "DeconvExplorer"))), + # signatures = list("dwls" = readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer"))), + # deconvolutions = list("dwls_dwls" = readRDS(system.file("extdata", "deconvolution_example.rds", package = "DeconvExplorer"))), + signatures = list(), + deconvolutions = list(), bulk = list(), singleCell = list(), annotation = list(), @@ -888,11 +1149,12 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # start the tour observeEvent(input$startTour, { - tour_steps <- read.delim(system.file("extdata", "tour_intro.txt", - package = "DeconvExplorer" - ), - sep = ";", stringsAsFactors = FALSE, - row.names = NULL, quote = "" + tour_steps <- read.delim( + system.file("extdata", "tour_intro.txt", + package = "DeconvExplorer" + ), + sep = ";", stringsAsFactors = FALSE, + row.names = NULL, quote = "" ) introjs(session, options = list( steps = tour_steps, @@ -916,28 +1178,16 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, }) observeEvent(input$loadSample, { - req(input$sampleNumber) - if (input$sampleNumber == 1) { - internal$bulk[["BulkSample"]] <- omnideconv::bulk - internal$singleCell[["SingleCellSample1"]] <- omnideconv::single_cell_data_1 - internal$annotation[["CellTypeAnnotation1"]] <- omnideconv::cell_type_annotations_1 - internal$batch[["BatchIDs1"]] <- omnideconv::batch_ids_1 - internal$deconvolutions[["SampleReference"]] <- omnideconv::RefData - } else if (input$sampleNumber == 2) { - internal$bulk[["BulkSample"]] <- omnideconv::bulk - internal$singleCell[["SingleCellSample2"]] <- omnideconv::single_cell_data_2 - internal$annotation[["CellTypeAnnotation2"]] <- omnideconv::cell_type_annotations_2 - internal$batch[["BatchIDs2"]] <- omnideconv::batch_ids_2 - internal$deconvolutions[["SampleReference"]] <- omnideconv::RefData - } else if (input$sampleNumber == 3) { - internal$bulk[["BulkSample"]] <- omnideconv::bulk - internal$singleCell[["SingleCellSample3"]] <- omnideconv::single_cell_data_3 - internal$annotation[["CellTypeAnnotation3"]] <- omnideconv::cell_type_annotations_3 - internal$batch[["BatchIDs3"]] <- omnideconv::batch_ids_3 - internal$deconvolutions[["SampleReference"]] <- omnideconv::RefData - } + waiter::waiter_show(html = tagList(waiter::spin_rotating_plane(), "Loading example data ..."), color = overlay_color) + internal$bulk[["Example Bulk"]] <- omnideconv::bulk + internal$singleCell[["Example Single-cell"]] <- omnideconv::single_cell_data_1 + 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$signatures[["Example Signature (DWLS)"]] <- readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer")) showNotification("Loaded Sample Data") + waiter::waiter_hide() }) # update Signature Select Options @@ -1125,6 +1375,8 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, observeEvent(input$deconvolute, { # reqs + waiter::waiter_show(html = tagList(waiter::spin_rotating_plane(), "Starting deconvolution ..."), color = overlay_color) + bulkData <- NULL singleCellData <- NULL cellTypeAnnotations <- NULL @@ -1140,14 +1392,16 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # input$deconvMethod, signature_Method# if (is.null(input$bulkSelection) | input$bulkSelection == "") { + waiter::waiter_hide() showNotification("Bulk Data Missing", type = "error") } req(input$bulkSelection) bulkData <- internal$bulk[[input$bulkSelection]] # check if Single Cell Data Necessary - if (input$deconvMethod %in% c("momf", "bisque", "music", "bseqsc", "cdseq", "cpm", "scdc", "scaden") | signature_Method %in% c("cibersortx", "dwls", "momf")) { + if (input$deconvMethod %in% c("autogenes", "momf", "bisque", "music", "bseqsc", "cdseq", "cpm", "scdc", "scaden") | signature_Method %in% c("cibersortx", "dwls", "momf")) { if (is.null(input$singleCellSelection) | input$singleCellSelection == "") { + waiter::waiter_hide() showNotification("Single Cell Data Missing", type = "error") } req(input$singleCellSelection) @@ -1156,6 +1410,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # check if annotation necessary if (input$deconvMethod %in% c("music", "bisque", "autogenes", "bseqsc", "cdseq", "cpm", "scdc", "scaden") | signature_Method %in% c("cibersortx", "dwls", "momf")) { if (is.null(input$annotationSelection) | input$annotationSelection == "") { + waiter::waiter_hide() showNotification("Cell type annotation missing", type = "error") } req(input$annotationSelection) @@ -1165,6 +1420,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # check if batch ids necessary if (input$deconvMethod %in% c("music", "bisque", "bseqsc", "cdseq", "scdc")) { if (is.null(input$batchSelection) | input$batchSelection == "") { + waiter::waiter_hide() showNotification("BatchIDs Missing", type = "error") } req(input$batchSelection) @@ -1173,13 +1429,13 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, if (input$deconvMethod %in% c("bseqsc")) { if (is.null(input$markerSelection) | input$markerSelection == "") { + waiter::waiter_hide() showNotification("Markers Missing", type = "error") } req(input$markerSelection) markers <- internal$markers[[input$markerSelection]] } - waitress$start() # check if signature needs to be calculated or loaded if (grepl("precalculated", signature_Method)) { @@ -1190,43 +1446,52 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, showNotification(paste0("Using Available Signature ", signature_Method, " for deconvolution")) } else { # calculate signature from signature method - showNotification(paste0("Building Signature: ", signature_Method), type = "warning") - - signature <- omnideconv::build_model( - single_cell_object = singleCellData, - bulk_gene_expression = bulkData, - method = signature_Method, - batch_ids = batchIDs, - cell_type_annotations = cellTypeAnnotations, - markers = markers, - verbose = TRUE - ) - } + waiter::waiter_update(html = tagList(waiter::spin_rotating_plane(), paste0("Building Signature: ", signature_Method))) + + tryCatch( + { + signature <- omnideconv::build_model( + single_cell_object = singleCellData, + bulk_gene_expression = bulkData, + method = signature_Method, + batch_ids = batchIDs, + cell_type_annotations = cellTypeAnnotations, + markers = markers, + verbose = TRUE + ) - # deconvolute - showNotification(paste0("Deconvolution started: ", input$deconvMethod), type = "warning") - deconvolution_result <- - omnideconv::deconvolute( - bulk_gene_expression = bulkData, - signature = signature, - method = input$deconvMethod, - single_cell_object = singleCellData, - cell_type_annotations = cellTypeAnnotations, - batch_ids = batchIDs, - verbose = TRUE + # only add signature if not null + if (!is.null(signature) && signature_Method != "autogenes" && signature_Method != "scaden") { + internal$signatures[[signature_Method]] <- signature + } + + message("Finished Signature") # debug reasons + + waiter::waiter_update(html = tagList(waiter::spin_rotating_plane(), paste0("Deconvolution started: ", input$deconvMethod))) + + deconvolution_result <- + omnideconv::deconvolute( + bulk_gene_expression = bulkData, + signature = signature, + method = input$deconvMethod, + single_cell_object = singleCellData, + cell_type_annotations = cellTypeAnnotations, + batch_ids = batchIDs, + verbose = TRUE + ) + + # insert result into the internal$deconvolutions reactive ValuelogoInfo + internal$deconvolutions[[paste0(input$deconvMethod, "_", signature_Method)]] <- deconvolution_result + + waiter::waiter_hide() + message("Finished Deconvolution") # debug reasons + }, + error = function(e) { + showModal(errorModal(error_message = e$message)) + waiter_hide() + } ) - - # insert result into the internal$deconvolutions reactive ValuelogoInfo - internal$deconvolutions[[paste0(input$deconvMethod, "_", signature_Method)]] <- deconvolution_result - - # only add signature if not null - if (!is.null(signature) && signature_Method != "autogenes" && signature_Method != "scaden") { - internal$signatures[[signature_Method]] <- signature } - - waitress$close() - showNotification("Deconvolution finished", type = "message") - message("Finished Deconvolution") # debug reasons }) # update avaible deconvolutions for plotting @@ -1262,40 +1527,85 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, output$plotBox <- plotly::renderPlotly({ # req(userData$deconvolution_result) req(input$deconvolutionToPlot) - omnideconv::plot_deconvolution( + suppressWarnings(omnideconv::plot_deconvolution( returnSelectedDeconvolutions(input$deconvolutionToPlot, isolate(internal$deconvolutions)), input$plotMethod, input$facets, input$globalColor - ) + )) }) - # Number Of Genes Barplot - output$signatureGenesPerMethod <- renderPlot({ + # barplots + barplotReactive <- reactive({ req(length(internal$signatures) > 0) signatures <- shiny::isolate(internal$signatures) - plot_signatureGenesPerMethod(signatures, input$globalColor) + nGenesPlot <- plot_signatureGenesPerMethod(signatures, input$globalColor) + conditionNumberPlot <- plot_conditionNumberPerMethod(signatures, input$globalColor) + entropyPlot <- plot_meanEntropyPerMethod(signatures, input$globalColor) + + return(list( + nGenesPlot = nGenesPlot, + conditionNumberPlot = conditionNumberPlot, + entropyPlot = entropyPlot + )) + }) + + # Number of genes Plot + output$signatureGenesPerMethod <- renderPlot({ + req(barplotReactive) + barplotReactive()$nGenesPlot }) + output$downloadSignatureGenesPerMethod <- downloadHandler( + filename = function() { + "signature_genes_plot.pdf" + }, + content = function(file) { + req(barplotReactive) + ggsave(file, plot = barplotReactive()$nGenesPlot, device = "pdf", width = 6, height = 6) + } + ) + # Condition Number Plot output$kappaPerMethod <- renderPlot({ - req(length(internal$signatures) > 0) - signatures <- shiny::isolate(internal$signatures) - plot_conditionNumberPerMethod(signatures, input$globalColor) + req(barplotReactive) + barplotReactive()$conditionNumberPlot }) + output$downloadKappaPerMethod <- downloadHandler( + filename = function() { + "condition_number_plot.pdf" + }, + content = function(file) { + req(barplotReactive) + ggsave(file, plot = barplotReactive()$conditionNumberPlot, device = "pdf", width = 6, height = 6) + } + ) + + # Entropy Plot output$signatureEntropyPerMethod <- renderPlot({ - req(length(internal$signatures) > 0) - signatures <- shiny::isolate(internal$signatures) - plot_meanEntropyPerMethod(signatures, input$globalColor) + req(barplotReactive) + barplotReactive()$entropyPlot }) + output$downloadSignatureEntropyPerMethod <- downloadHandler( + filename = function() { + "condition_number_plot.pdf" + }, + content = function(file) { + req(barplotReactive) + ggsave(file, plot = barplotReactive()$entropyPlot, device = "pdf", width = 6, height = 6) + } + ) + + # plot interactive heatmap observe({ req( input$signatureToHeatmap, input$signatureAnnotationScore, - input$signatureAnnotationPlotType + input$signatureAnnotationPlotType, + input$clusterCelltypes ) signature <- isolate(internal$signatures[[input$signatureToHeatmap]]) InteractiveComplexHeatmap::makeInteractiveComplexHeatmap(input, @@ -1304,15 +1614,15 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, plot_signatureClustered(signature, scoring_method = input$signatureAnnotationScore, annotation_type = input$signatureAnnotationPlotType, - color_palette = input$globalColor + color_palette = input$globalColor, + order_rows = input$clusterCelltypes ), "clusteredHeatmapOneSignature", brush_action = brush_action ) }) - # UpSet Plot - output$signatureUpset <- renderPlot({ + upsetReactive <- reactive({ req(length(internal$signatures) > 0, input$upSetDegree, input$upSetOrder) # update checkbox of setting box before rendering the plot @@ -1340,11 +1650,30 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, # updateSliderInput(session, inputId = "upSetDegree", max=max(ComplexHeatmap::comb_degree(result[[2]]))) # show the plot - result[[1]] + return(list("plot" = result[[1]])) }) + # UpSet Plot + output$signatureUpset <- renderPlot({ + req(upsetReactive) + upsetReactive()$plot + }) + + output$upSetPlotDownloadButton <- downloadHandler( + filename = function() { + "upset_signatures.pdf" + }, + content = function(file) { + req(upsetReactive) + pdf(file = file, width = 9, height = 6) + print(upsetReactive()$plot) + dev.off() + # ggsave(file, plot = upsetReactive()$plot, device = "pdf", width = 9, height = 6) + } + ) + output$refinementHeatmapPlot <- renderPlot({ - req(input$refinementHeatmapScore, input$refinementHeatmapScorePlotType, signatureRefined()) # und die signature + req(input$refinementHeatmapScore, input$refinementHeatmapScorePlotType, signatureRefined()) # und die signatur plot_signatureClustered(signatureRefined(), scoring_method = input$refinementHeatmapScore, @@ -1357,19 +1686,36 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, req(input$benchmark_reference, input$benchmark_ToPlot) reference <- internal$deconvolutions[[input$benchmark_reference]] estimates <- returnSelectedDeconvolutions(input$benchmark_ToPlot, isolate(internal$deconvolutions)) - plot_benchmark_scatter(reference, estimates, input$globalColor) + print(estimates) + tryCatch( + { + plot_benchmark_scatter(reference, estimates, input$globalColor) + }, + error = function(e) { + print(e$message) + showModal(errorModal(e$message)) + } + ) }) output$benchmark_correlation <- renderPlot({ req(input$benchmark_reference, input$benchmark_ToPlot, input$correlationPlotType, input$correlationAnnotationType, input$correlationAnntotationColor) reference <- internal$deconvolutions[[input$benchmark_reference]] estimates <- returnSelectedDeconvolutions(input$benchmark_ToPlot, isolate(internal$deconvolutions)) - plot_benchmark_correlation( - reference, - estimates, - plot_method = input$correlationPlotType, - pvalue_type = input$correlationAnnotationType, - pvalue_color = input$correlationAnntotationColor + tryCatch( + { + plot_benchmark_correlation( + reference, + estimates, + plot_method = input$correlationPlotType, + pvalue_type = input$correlationAnnotationType, + pvalue_color = input$correlationAnntotationColor + ) + }, + error = function(e) { + print(e$message) + showModal(errorModal(e$message)) + } ) }) @@ -1378,12 +1724,19 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, reference <- internal$deconvolutions[[input$benchmark_reference]] estimates <- returnSelectedDeconvolutions(input$benchmark_ToPlot, isolate(internal$deconvolutions)) - - plot_benchmark_rmse(reference, - estimates, - plot_type = input$rmsePlotType, - hm_method = input$rmseHeatmapMethod, - color_palette = input$globalColor + tryCatch( + { + plot_benchmark_rmse(reference, + estimates, + plot_type = input$rmsePlotType, + hm_method = input$rmseHeatmapMethod, + color_palette = input$globalColor + ) + }, + error = function(e) { + print(e$message) + showModal(errorModal(e$message)) + } ) }) @@ -1423,7 +1776,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, output$refinementMeanEntropy <- shinydashboard::renderValueBox({ req(signatureRefined()) - meanEntropy <- round(mean(apply(signatureRefined(), 1, scoreEntropy)), 2) + meanEntropy <- round(mean(BioQC::entropySpecificity(signatureRefined())), 2) shinydashboard::valueBox( value = meanEntropy, subtitle = "Mean Entropy", @@ -1529,11 +1882,12 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, ) }) - observeEvent(input$userReferenceUpload, { - name <- input$userReferenceUpload$name + observeEvent(input$userFractionsUpload, { + name <- input$userFractionsUpload$name + tryCatch( { - internal$deconvolutions[[paste0("Reference", name)]] <- loadFile(input$userReferenceUpload) + internal$deconvolutions[[name]] <- loadFile(input$userFractionsUpload) }, error = function(e) { showNotification("There was an error with your upload", type = "error") @@ -1552,7 +1906,7 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, deconvolution <- internal$deconvolutions[[input$deconvolutionToTable]] # turn rownames to column to enable DT search - deconvolution <- data.frame("Gene" = rownames(deconvolution), deconvolution, check.names = FALSE) # check.names prevents cell type names from beeing changed + deconvolution <- data.frame("Sample" = rownames(deconvolution), deconvolution, check.names = FALSE) # check.names prevents cell type names from beeing changed rownames(deconvolution) <- NULL columns <- colnames(deconvolution)[-1] @@ -1705,12 +2059,10 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, } # turn into vector content <- as.vector(t(content)) - } else { - # all other cases: matrix? - content <- as.matrix(content) } showNotification(paste("Successfully Loaded File: ", file$name), type = "default") + print(is.data.frame(content)) } content # case NULL = File not loaded, error already displayed to user } @@ -1738,6 +2090,21 @@ DeconvExplorer <- function(deconvexp_bulk = NULL, deleteFile = TRUE ) + output$logoDeconvExplorer <- renderImage( + { + list( + src = system.file("www", "deconvExplorer.png", package = "DeconvExplorer"), + contentType = "image/png", + width = "100%" + ) + }, + deleteFile = TRUE + ) +<<<<<<< HEAD + +======= +>>>>>>> aa2a3bb4dc946dc1e3af93a5462df63292d64f52 + # functions --------------------------------------------------------------- brush_action <- function(df, input, output, session) { req(internal$signatures, input$signatureToHeatmap) # used to contain deconv_list diff --git a/R/Global.R b/R/Global.R index a47ec25..8d0fde6 100644 --- a/R/Global.R +++ b/R/Global.R @@ -1,4 +1,3 @@ - #' Get subset of deconvolution results #' #' This function returns the requested deconvolution results as a list @@ -28,82 +27,16 @@ returnSelectedDeconvolutions <- function(deconv_select, deconv_list) { } -########################################### -## Deprecated , but commented for testing # -########################################### - -#' Title -#' -#' CosTODO +#' Modal window to print error messages or other warnings #' -#' @param deconvolutions CosTODO +#' @param error_message #' -#' @return CosTODO +#' @return NULL #' @export -#' -#' @examples -#' # CosTODO -# plot_benchmark <- function(deconvolutions) { -# # import and preformat data -# -# # deconvolution_list <- list() -# # for (deconvolution in deconv_select) { -# # # deconvolution_list[length(deconvolution_list) + 1] <- deconv_list[[deconvolution]][1] -# # deconvolution_list[deconvolution] <- deconv_list[[deconvolution]][1] -# # } -# -# # add samples and deconvolution method -# deconvolutions <- lapply(deconvolutions, function(x) cbind(x, sample = rownames(x))) -# deconvolutions <- lapply(names(deconvolutions), function(x) { -# cbind(deconvolutions[[x]], method = rep(x, nrow(deconvolutions[[x]]))) -# }) -# -# deconvolutions <- lapply(deconvolutions, function(x) { -# tidyr::pivot_longer(data.frame(x), !c("sample", "method"), -# names_to = "cell_type", values_to = "predicted_fraction" -# ) -# }) -# -# # combine to one dataframe -# data <- do.call("rbind", deconvolutions) -# -# # preformat reference data -# ref <- omnideconv::RefData -# ref$sample <- rownames(ref) -# ref <- tidyr::pivot_longer(ref, !sample, names_to = "cell_type", values_to = "true_fraction") -# -# # merge the reference data with the deconvolution results -# data <- merge(ref, data, by = c("sample", "cell_type")) -# -# # change datatype to numeric -# data$predicted_fraction <- as.numeric(data$predicted_fraction) -# data$true_fraction <- as.numeric(data$true_fraction) -# -# # calculate max width/heigth -> plot symmetric and line @ 45 Degrees -# max_value <- max(max(data$true_fraction), max(data$predicted_fraction)) + 0.1 -# -# # create plot -# plot <- ggplot(data, aes( -# x = .data$true_fraction, y = predicted_fraction, color = cell_type, -# text = paste0("Sample: ", sample, "\nTrue: ", true_fraction, "\nPredicted: ", predicted_fraction) -# )) + -# geom_point(size = 4) + -# facet_wrap(~method) + -# geom_abline(color = "black") + -# labs(x = "True Fraction", y = "predicted Fraction", color = "cell type") + -# coord_cartesian(xlim = c(0, max_value), ylim = c(0, max_value)) -# -# # render -# plotly::ggplotly(plot, tooltip = c("text")) |> -# plotly::config( -# displaylogo = FALSE, showTips = FALSE, toImageButtonOptions = list(filename = paste0("plotMethod", "_plot")), -# modeBarButtonsToRemove = list( -# "hoverClosestCartesian", -# "hoverCompareCartesian", -# "zoomIn2d", "zoomOut2d", -# "lasso2d", "zoom2d", -# "pan2d", "autoScale2d", "select2d" -# ) -# ) |> -# plotly::layout(xaxis = list(fixedrange = TRUE), yaxis = list(fixedrange = TRUE)) -# } +errorModal <- function(error_message = NULL) { + modalDialog( + p(error_message, style = "color:red;"), + easyClose = T, + modalButton("Cancel") + ) +} diff --git a/R/SignatureExplorationPlots.R b/R/SignatureExplorationPlots.R index 9ce74a3..4af6a63 100644 --- a/R/SignatureExplorationPlots.R +++ b/R/SignatureExplorationPlots.R @@ -128,7 +128,7 @@ plot_meanEntropyPerMethod <- function(signature_list, # calculate Mean Entropy for each signature for (name in names(signature_list)) { - meanEntropy <- mean(apply(signature_list[[name]], 1, scoreEntropy)) + meanEntropy <- mean(BioQC::entropySpecificity(signature_list[[name]])) entropies[nrow(entropies) + 1, ] <- list(name, meanEntropy) } @@ -155,7 +155,6 @@ plot_meanEntropyPerMethod <- function(signature_list, #' Calculate Clustered Heatmap of Signature Genes -#' #' This Heatmap displays a z-scored signature in heatmap form. The plot is annotated #' by a gene scores ranking the distinctness of a gene in the signature. #' @@ -163,6 +162,9 @@ plot_meanEntropyPerMethod <- function(signature_list, #' @param color_palette RColorBrewer Palette name, standard = Spectral #' @param scoring_method The score used to annotate the genes (entropy, gini) #' @param annotation_type How the score is rendered (line, bar) +#' @param order_rows Either 'cluster' to order cell types by similarity or 'no_cluster' to order alphabeticaly +#' @param threshold the threshold for the z-scored expresion in the signature matrix to consider +#' a gene as being differentially expressed. Default: 1.5 #' #' @returns A Heatmap #' @export @@ -172,7 +174,9 @@ plot_meanEntropyPerMethod <- function(signature_list, plot_signatureClustered <- function(signature_mat, scoring_method = "entropy", annotation_type = "line", - color_palette = "Spectral") { + color_palette = "Spectral", + order_rows = "cluster", + threshold = 1.5) { if (is.null(signature_mat)) { stop("Please provide a signature") } @@ -227,9 +231,9 @@ plot_signatureClustered <- function(signature_mat, if (scoring_method == "entropy") { if (annotation_type == "line") { - annotation <- ComplexHeatmap::columnAnnotation(entropy = ComplexHeatmap::anno_lines(apply(signature_mat, 1, scoreEntropy), which = "row")) + annotation <- ComplexHeatmap::columnAnnotation(entropy = ComplexHeatmap::anno_lines(BioQC::entropySpecificity(signature_mat), which = "row")) } else if (annotation_type == "bar") { - annotation <- ComplexHeatmap::columnAnnotation(entropy = ComplexHeatmap::anno_barplot(apply(signature_mat, 1, scoreEntropy), which = "row")) + annotation <- ComplexHeatmap::columnAnnotation(entropy = ComplexHeatmap::anno_barplot(BioQC::entropySpecificity(signature_mat), which = "row")) } } else if (scoring_method == "gini") { if (annotation_type == "line") { @@ -240,13 +244,32 @@ plot_signatureClustered <- function(signature_mat, } + if (order_rows == "cluster") { + cell.types.distance <- dist(t(mat), method = "euclidean") + cell.types.clustering <- hclust(cell.types.distance, method = "complete") + cell.types.ordered <- cell.types.clustering$labels[cell.types.clustering$order] + } else if (order_rows == "no_cluster") { + 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) + } + + genes <- union(genes, rownames(mat)) + # Plot with complex heatmap + heatmap <- ComplexHeatmap::Heatmap(t(mat), name = "z-score", show_column_dend = FALSE, show_row_dend = FALSE, show_column_names = FALSE, row_title = NULL, row_names_side = "left", 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 = TRUE, # clustering_method_columns = "euclidean", + # cluster_columns = TRUE, cluster_rows = cluster_rows, # clustering_method_columns = "euclidean", top_annotation = annotation ) @@ -321,15 +344,18 @@ plot_signatureUpset <- function(signature_list, upSetColors <- c("black") } + top_annotation <- ComplexHeatmap::upset_top_annotation( + mat, + add_numbers = TRUE, + numbers_gp = grid::gpar( + fontsize = "14", + fontface = "bold" + ) + ) + p <- ComplexHeatmap::UpSet(mat, comb_order = combOrder, - top_annotation = upset_top_annotation(mat, - add_numbers = TRUE, - numbers_gp = grid::gpar( - fontsize = "14", - fontface = "bold" - ) - ), + top_annotation = top_annotation, pt_size = grid::unit(8, "mm"), lwd = 6, comb_col = upSetColors ) diff --git a/R/SignatureRefinements.R b/R/SignatureRefinements.R index 4d4869e..544c824 100644 --- a/R/SignatureRefinements.R +++ b/R/SignatureRefinements.R @@ -188,7 +188,8 @@ selectGenesByScore <- function(signature_mat, score <- list() if (scoring_method == "entropy") { - score[gene] <- scoreEntropy(row) # calculate score and save named result + # score[gene] <- scoreEntropy(row) # calculate score and save named result + score[gene] <- BioQC::entropySpecificity(rbind(row, row))[1] } else if (scoring_method == "gini") { score[gene] <- 1 - BioQC::gini(row) # need to flip the value since lower scores schould be better (entropy!) } @@ -221,35 +222,3 @@ selectGenesByScore <- function(signature_mat, return(refinedSignature) } - -#' Score Gene Expression of a single Gene based on information entropy -#' -#' Score Genes Expression of a single gene across celltypes. The function returns -#' the calculated entropy of the expression value distribution. -#' -#' @param expression_feature row from Gene Expression Matrix = Expression Data for a single Gene -#' @returns Score for the given gene based on information entropy -#' Here: The lower the better -#' -#' @export -#' -#' @examples -#' signature <- readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer")) -#' -#' entropy <- scoreEntropy(signature[1, ]) # scoring the first gene -scoreEntropy <- function(expression_feature) { - # TODO add parameter checks #### - probs <- list() - - # turn expression data to a list of probabilities - for (val in expression_feature) { - if (val == 0) { - next - } - probs <- append(probs, val / sum(expression_feature)) # turn in to probabilities - } - - entropy <- -sum(unlist(lapply(probs, function(x) log(x) * x))) - - return(entropy) -} diff --git a/inst/deconvexplorer-webserver/app/Dockerfile b/inst/deconvexplorer-webserver/app/Dockerfile index 30ad5ef..f3fa81a 100644 --- a/inst/deconvexplorer-webserver/app/Dockerfile +++ b/inst/deconvexplorer-webserver/app/Dockerfile @@ -1,6 +1,6 @@ #syntax=docker/dockerfile:1 -FROM rocker/r-base +FROM rocker/r-base:4.4.0 # github setup ARG GITHUB_PAT @@ -27,7 +27,8 @@ RUN apt-get update && apt-get install -y \ # omnideconv and DeconvExplorer #RUN install2.r --error textshaping -RUN install2.r --error pak car matlib remotes +RUN R -e "install.packages('pak')" +RUN R -e "pak::pkg_install(c('car', 'matlib', 'remotes'))" RUN R -e "remotes::install_github('omnideconv/omnideconv', dependencies=TRUE)" RUN R -e "pak::pkg_install('omnideconv/DeconvExplorer', dependencies=TRUE)" @@ -43,7 +44,7 @@ RUN R -e "omnideconv::install_all_python()" # Cibersort Source Code COPY CIBERSORT.R . -RUN R -e "omnideconv::bseqsc_config(file = 'CIBERSORT.R')" +#RUN R -e "omnideconv::bseqsc_config(file = 'CIBERSORT.R')" RUN groupadd shiny \ && useradd --gid shiny --shell /bin/bash --create-home shiny diff --git a/inst/extdata/data_info.md b/inst/extdata/data_info.md index 056deae..31ac19d 100644 --- a/inst/extdata/data_info.md +++ b/inst/extdata/data_info.md @@ -13,39 +13,36 @@ - Counts are **not log-transformed** - Rownames (gene names) are provided in the same format as in the bulk RNA-seq data, for instance HGNC symbols +sc_image + #### Cell type annotations - Vector containing cell type annotations - Annotations are in the same order as the columns of the single cell matrix +anno_image + #### Batch ids - Vector containing batch ids, so sample or patient ids - Ids are in the same order as the columns of the single cell matrix - This is only necessary for Bisque, MuSiC and SCDC +batch_image + #### (Marker genes) - Vector containing gene names - This is only necessary for BSeq-sc +markers_image + #### Bulk RNA-seq data - **Genes** x **Samples** matrix - Rownames (gene names) are provided in the same format as in the sc RNA-seq data, for instance HGNC symbols -#### SimBu data - -Upload your SimBu simulation as .rds file, as generated with this command - -``` -simulation <- SimBu::simulate_bulk(...) -saveRDS(simulation, 'filepath.rds') # upload this file -``` - - - For further Information see the SimBu Documentation - +bulk_image #### Signature @@ -58,3 +55,5 @@ Supported data types: For csv and tsv files the first column must contain gene identifiers + +signature_image diff --git a/inst/extdata/tour_intro.txt b/inst/extdata/tour_intro.txt index a5a9ff6..fd1ea2a 100644 --- a/inst/extdata/tour_intro.txt +++ b/inst/extdata/tour_intro.txt @@ -1,13 +1,11 @@ element;intro -#logo;Welcome to DeconvExplorer, an interactive framework to perform, evaluate and enhance cell type deconvolution from transcriptome data.
In this tour we will give an overview over DeconvExplorers functionality. DeconvExplorer performs deconvolution with the omnideconv toolset. +.main-header;Welcome to DeconvExplorer, an interactive framework to perform, evaluate and enhance cell type deconvolution from transcriptome data.
In this tour we will give an overview over DeconvExplorers functionality. DeconvExplorer performs deconvolution with the omnideconv toolset. .sidebar;DeconvExplorer is devided into six modules. You can always switch between modules but keep in mind that, while a deconvolution is running, plots are not updating. -#tour_upload;Upload your data here as a csv, tsv, txt or rds file. Further data requirements are listed below. -#tour_sample;To test the interface you can load three different sample datasets. -#tour_simbu;If you want to use a simulated pseudo-bulk sample from SimBu you can upload your simulation in rds format. +#uploadDeconvolutionQ;Upload your data here as a csv, tsv, txt or rds file. Further data requirements are listed below. +#tour_sample;To explore deconvExplorers functionality you can load a sample dataset here. #tour_signatureUpload;If required you can upload a custom signature. -#tour_deconvSettings;To perform a deconvolution, select a deconvolution method. If applicable you can choose a custom signature as well. -#tour_deconvPlotSettings;All deconvolution results are collected here and can be selected for plotting below. -#tour_deconvPlot;All chosen deconvolution results are visualized here. Feel free to explore the different available plotting options! -#tour_genesPlot;The Signature Exploration module plots multiple metrics to analyse and compare expression signatures. -#tour_refinementHeatmap;In the Signature Refinement module you can further subset the genes of a signature to analyse the impact on deconvolution performance. -#tour_infoOverview;More information about each module can be found here. +[data-value="deconv"];Perform deconvolution analysis and visualize the results. Multiple algorithms can be applied. You can further observe the computed cell fractions and signature. +[data-value="signatureExploration"];Analyze gene expression signatures. Many visualizations are applicable to compare and understand a signatures composition. +[data-value="signatureRefinement"];Fine-tune your gene expression signature. +[data-value="benchmark"];Compare and benchmark deconvolution results. You can upload a ground truth in the data upload tab. +[data-value="fInfo"];Find additional information, tutorials and contact details. diff --git a/inst/www/batch.png b/inst/www/batch.png new file mode 100644 index 0000000..ae2bc6c Binary files /dev/null and b/inst/www/batch.png differ diff --git a/inst/www/bulk.png b/inst/www/bulk.png new file mode 100644 index 0000000..3558617 Binary files /dev/null and b/inst/www/bulk.png differ diff --git a/inst/www/cell_anno.png b/inst/www/cell_anno.png new file mode 100644 index 0000000..346a2d6 Binary files /dev/null and b/inst/www/cell_anno.png differ diff --git a/inst/www/deconv.png b/inst/www/deconv.png new file mode 100644 index 0000000..f5bfa2c Binary files /dev/null and b/inst/www/deconv.png differ diff --git a/inst/www/deconvExplorer.png b/inst/www/deconvExplorer.png new file mode 100644 index 0000000..3697237 Binary files /dev/null and b/inst/www/deconvExplorer.png differ diff --git a/inst/www/markers.png b/inst/www/markers.png new file mode 100644 index 0000000..5838293 Binary files /dev/null and b/inst/www/markers.png differ diff --git a/inst/www/sc.png b/inst/www/sc.png new file mode 100644 index 0000000..cd6d249 Binary files /dev/null and b/inst/www/sc.png differ diff --git a/inst/www/signature.png b/inst/www/signature.png new file mode 100644 index 0000000..bb07502 Binary files /dev/null and b/inst/www/signature.png differ diff --git a/man/DeconvExplorer-pkg.Rd b/man/DeconvExplorer-pkg.Rd index 1090a23..d0e4a81 100644 --- a/man/DeconvExplorer-pkg.Rd +++ b/man/DeconvExplorer-pkg.Rd @@ -2,8 +2,26 @@ % Please edit documentation in R/DeconvExplorer-pkg.R \docType{package} \name{DeconvExplorer-pkg} +\alias{DeconvExplorer-package} \alias{DeconvExplorer-pkg} \title{DeconvExplorer} \description{ DeconvExplorer Interactive user interface for the omnideconv deconvolution toolset } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/omnideconv/DeconvExplorer/} + \item Report bugs at \url{https://github.com/omnideconv/DeconvExplorer/issues} +} + +} +\author{ +\strong{Maintainer}: Constantin Zackl \email{zacklcon@uni-mainz.de} (\href{https://orcid.org/0000-0003-1991-6943}{ORCID}) + +Authors: +\itemize{ + \item Federico Marini \email{marinif@uni-mainz.de} (\href{https://orcid.org/0000-0003-3252-7758}{ORCID}) +} + +} diff --git a/man/DeconvExplorer.Rd b/man/DeconvExplorer.Rd index fe809a7..501fbe4 100644 --- a/man/DeconvExplorer.Rd +++ b/man/DeconvExplorer.Rd @@ -8,39 +8,36 @@ DeconvExplorer( deconvexp_bulk = NULL, deconvexp_singlecelldata = NULL, deconvexp_cell_annotation = NULL, - deconvexp_batch = NULL + deconvexp_batch = NULL, + maxsize_upload = 50 ) } \arguments{ -\item{deconvexp_bulk}{Bulk Sequencing data which will be deconvoluted} +\item{deconvexp_bulk}{Optional; a matrix or data frame containing bulk sequencing data to be deconvoluted. +Rows should represent genes, and columns should represent samples. The data can also be +uploaded directly in the app.} -\item{deconvexp_singlecelldata}{Single Cell Data which is used to calculate the signature matrix} +\item{deconvexp_singlecelldata}{Optional; a matrix, data frame, or SingleCellExperiment object +containing single-cell data used to calculate the signature matrix. Rows should represent genes, +and columns should represent single cells.} -\item{deconvexp_cell_annotation}{Cell Type annotations for the single cell data} +\item{deconvexp_cell_annotation}{Optional; a vector providing cell type annotations +for the single-cell data. Each entry corresponds to the cell type of the respective column +in `deconvexp_singlecelldata`.} -\item{deconvexp_batch}{Batch IDs, only for some deconvolution methods} +\item{deconvexp_batch}{Optional; a vector indicating the batch ID for each sample or cell +in `deconvexp_singlecelldata`. This is relevant for methods that can adjust for batch effects.} + +\item{maxsize_upload}{Numeric; specifies the maximum file size in MB acceptable for upload +during runtime. This is particularly important when files are uploaded directly through the +app interface. Defaults to 50 MB.} } \value{ -A Shiny app object is returned +Starts a shiny app } \description{ -Run DeconvExplorer -} -\examples{ -if (interactive()) { - DeconvExplorer::DeconvExplorer() -} - -# COSTODO: an example where the parameters are provided before starting the app -# my_deconvexp_bulk <- ... -# my_deconvexp_singlecelldata <- ... -# my_deconvexp_cell_annotation <- ... -# my_deconvexp_batch <- ... -# if (interactive()) { -# DeconvExplorer::DeconvExplorer(deconvexp_bulk = ..., -# deconvexp_singlecelldata = ..., -# deconvexp_cell_annotation = ..., -# deconvexp_batch = ... -# ) -# } +This function launches a Shiny app to facilitate cell type deconvolution using both bulk +and single-cell RNA sequencing data. It provides a comprehensive interface for data upload, +deconvolution execution, and result visualization. The app supports various deconvolution +methods and offers tools for signature matrix refinement. } diff --git a/man/errorModal.Rd b/man/errorModal.Rd new file mode 100644 index 0000000..2b3c3de --- /dev/null +++ b/man/errorModal.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Global.R +\name{errorModal} +\alias{errorModal} +\title{Modal window to print error messages or other warnings} +\usage{ +errorModal(error_message = NULL) +} +\arguments{ +\item{error_message}{} +} +\description{ +Modal window to print error messages or other warnings +} diff --git a/man/plot_signatureClustered.Rd b/man/plot_signatureClustered.Rd index 97a8317..e424df9 100644 --- a/man/plot_signatureClustered.Rd +++ b/man/plot_signatureClustered.Rd @@ -2,13 +2,17 @@ % Please edit documentation in R/SignatureExplorationPlots.R \name{plot_signatureClustered} \alias{plot_signatureClustered} -\title{Calculate Clustered Heatmap of Signature Genes} +\title{Calculate Clustered Heatmap of Signature Genes +This Heatmap displays a z-scored signature in heatmap form. The plot is annotated +by a gene scores ranking the distinctness of a gene in the signature.} \usage{ plot_signatureClustered( signature_mat, scoring_method = "entropy", annotation_type = "line", - color_palette = "Spectral" + color_palette = "Spectral", + order_rows = "cluster", + threshold = 1.5 ) } \arguments{ @@ -19,11 +23,17 @@ plot_signatureClustered( \item{annotation_type}{How the score is rendered (line, bar)} \item{color_palette}{RColorBrewer Palette name, standard = Spectral} + +\item{order_rows}{Either 'cluster' to order cell types by similarity or 'no_cluster' to order alphabeticaly} + +\item{threshold}{the threshold for the z-scored expresion in the signature matrix to consider +a gene as being differentially expressed. Default: 1.5} } \value{ A Heatmap } \description{ +Calculate Clustered Heatmap of Signature Genes This Heatmap displays a z-scored signature in heatmap form. The plot is annotated by a gene scores ranking the distinctness of a gene in the signature. } diff --git a/man/scoreEntropy.Rd b/man/scoreEntropy.Rd deleted file mode 100644 index 085af3f..0000000 --- a/man/scoreEntropy.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/SignatureRefinements.R -\name{scoreEntropy} -\alias{scoreEntropy} -\title{Score Gene Expression of a single Gene based on information entropy} -\usage{ -scoreEntropy(expression_feature) -} -\arguments{ -\item{expression_feature}{row from Gene Expression Matrix = Expression Data for a single Gene} -} -\value{ -Score for the given gene based on information entropy -Here: The lower the better -} -\description{ -Score Genes Expression of a single gene across celltypes. The function returns -the calculated entropy of the expression value distribution. -} -\examples{ -signature <- readRDS(system.file("extdata", "signature_example.rds", package = "DeconvExplorer")) - -entropy <- scoreEntropy(signature[1, ]) # scoring the first gene -}