diff --git a/.Rbuildignore b/.Rbuildignore index 873addc..52c171e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,8 @@ ^DeeDee\.Rproj$ ^\.Rproj\.user$ ^LICENSE\.md$ +^TODO\.md$ +^_pkgdown\.yml$ +^docs$ +^pkgdown$ +^\.github$ diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml new file mode 100644 index 0000000..dd0e37d --- /dev/null +++ b/.github/workflows/check-bioc.yml @@ -0,0 +1,323 @@ +## Read more about GitHub actions the features of this GitHub Actions workflow +## at https://lcolladotor.github.io/biocthis/articles/biocthis.html#use_bioc_github_action +## +## For more details, check the biocthis developer notes vignette at +## https://lcolladotor.github.io/biocthis/articles/biocthis_dev_notes.html +## +## You can add this workflow to other packages using: +## > biocthis::use_bioc_github_action() +## +## Using GitHub Actions exposes you to many details about how R packages are +## compiled and installed in several operating system.s +### If you need help, please follow the steps listed at +## https://github.com/r-lib/actions#where-to-find-help +## +## If you found an issue specific to biocthis's GHA workflow, please report it +## with the information that will make it easier for others to help you. +## Thank you! + +## Acronyms: +## * GHA: GitHub Action +## * OS: operating system + +on: + push: + branches: + - devel + pull_request: + +name: R-CMD-check-bioc + +## These environment variables control whether to run GHA code later on that is +## specific to testthat, covr, and pkgdown. +## +## If you need to clear the cache of packages, update the number inside +## cache-version as discussed at https://github.com/r-lib/actions/issues/86. +## Note that you can always run a GHA test without the cache by using the word +## "/nocache" in the commit message. +env: + has_testthat: 'true' + run_covr: 'true' + run_pkgdown: 'true' + has_RUnit: 'false' + cache-version: 'cache-v1' + run_docker: 'false' + +jobs: + build-check: + runs-on: ${{ matrix.config.os }} + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + container: ${{ matrix.config.cont }} + ## Environment variables unique to this job. + + strategy: + fail-fast: false + matrix: + config: + - { os: ubuntu-latest, r: 'devel', bioc: '3.21', cont: "bioconductor/bioconductor_docker:devel", rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest" } + - { os: macOS-latest, r: 'devel', bioc: '3.21'} + - { os: windows-latest, r: 'devel', bioc: '3.21'} + ## Check https://github.com/r-lib/actions/tree/master/examples + ## for examples using the http-user-agent + env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + RSPM: ${{ matrix.config.rspm }} + NOT_CRAN: true + TZ: UTC + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + + ## Set the R library to the directory matching the + ## R packages cache step further below when running on Docker (Linux). + - name: Set R Library home on Linux + if: runner.os == 'Linux' + run: | + mkdir /__w/_temp/Library + echo ".libPaths('/__w/_temp/Library')" > ~/.Rprofile + + ## Most of these steps are the same as the ones in + ## https://github.com/r-lib/actions/blob/master/examples/check-standard.yaml + ## If they update their steps, we will also need to update ours. + - name: Checkout Repository + uses: actions/checkout@v3 + + ## R is already included in the Bioconductor docker images + - name: Setup R from r-lib + if: runner.os != 'Linux' + uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + + ## pandoc is already included in the Bioconductor docker images + - name: Setup pandoc from r-lib + if: runner.os != 'Linux' + uses: r-lib/actions/setup-pandoc@v2 + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + shell: Rscript {0} + + - name: Restore R package cache + if: "!contains(github.event.head_commit.message, '/nocache') && runner.os != 'Linux'" + uses: actions/cache@v3 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-devel-r-devel-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-devel-r-devel- + + - name: Cache R packages on Linux + if: "!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' " + uses: actions/cache@v3 + with: + path: /home/runner/work/_temp/Library + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-devel-r-devel-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-devel-r-devel- + + - name: Install Linux system dependencies + if: runner.os == 'Linux' + run: | + sysreqs=$(Rscript -e 'cat("apt-get update -y && apt-get install -y", paste(gsub("apt-get install -y ", "", remotes::system_requirements("ubuntu", "20.04")), collapse = " "))') + echo $sysreqs + sudo -s eval "$sysreqs" + + - name: Install macOS system dependencies + if: matrix.config.os == 'macOS-latest' + run: | + ## Enable installing XML from source if needed + brew install libxml2 + echo "XML_CONFIG=/opt/homebrew/opt/libxml2/bin/xml2-config" >> $GITHUB_ENV + + ## Required to install magick as noted at + ## https://github.com/r-lib/usethis/commit/f1f1e0d10c1ebc75fd4c18fa7e2de4551fd9978f#diff-9bfee71065492f63457918efcd912cf2 + brew install imagemagick@6 + + ## For textshaping, required by ragg, and required by pkgdown + brew install harfbuzz fribidi + + ## For installing usethis's dependency gert + brew install libgit2 + + ## Required for tcltk + brew install xquartz --cask + + ## Required for terra + brew install gdal + + ## Temporary fix for freetype (https://github.com/r-lib/ragg/issues/170; Sep 2024) + #brew install --cask https://raw.githubusercontent.com/Homebrew/homebrew-core/d28afc3bfdb5d24eab02157bfffcc9e17ed6666c/Formula/f/freetype.rb + brew unlink freetype + curl -L https://raw.githubusercontent.com/Homebrew/homebrew-core/3db6dc6c4baf5a75e345f380cc4e8224c1ae5ae0/Formula/f/freetype.rb > freetype.rb && brew install freetype.rb + + - name: Install binary units for macOS + if: matrix.config.os == 'macOS-latest' + run: | + ## temporary fix due to issue in udunits (Sep 2024) + install.packages('https://cran.rstudio.com/bin/macosx/big-sur-arm64/contrib/4.4/units_0.8-5.tgz') + shell: Rscript {0} + + - name: Install Windows system dependencies + if: runner.os == 'Windows' + run: | + ## Edit below if you have any Windows system dependencies + shell: Rscript {0} + + - name: Install BiocManager + run: | + message(paste('****', Sys.time(), 'installing BiocManager ****')) + remotes::install_cran("BiocManager") + shell: Rscript {0} + + - name: Set BiocVersion + run: | + BiocManager::install(version = "${{ matrix.config.bioc }}", ask = FALSE, force = TRUE) + shell: Rscript {0} + + - name: Install dependencies pass 1 + run: | + ## Try installing the package dependencies in steps. First the local + ## dependencies, then any remaining dependencies to avoid the + ## issues described at + ## https://stat.ethz.ch/pipermail/bioc-devel/2020-April/016675.html + ## https://github.com/r-lib/remotes/issues/296 + ## Ideally, all dependencies should get installed in the first pass. + + ## Set the repos source depending on the OS + ## Alternatively use https://storage.googleapis.com/bioconductor_docker/packages/ + ## though based on https://bit.ly/bioc2021-package-binaries + ## the Azure link will be the main one going forward. + gha_repos <- if( + .Platform$OS.type == "unix" && Sys.info()["sysname"] != "Darwin" + ) c( + "AnVIL" = "https://bioconductordocker.blob.core.windows.net/packages/3.20/bioc", + BiocManager::repositories() + ) else BiocManager::repositories() + + ## For running the checks + message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****')) + install.packages(c("rcmdcheck", "BiocCheck"), repos = gha_repos) + + ## Pass #1 at installing dependencies + ## This pass uses AnVIL-powered fast binaries + ## details at https://github.com/nturaga/bioc2021-bioconductor-binaries + ## The speed gains only apply to the docker builds. + message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****')) + remotes::install_local(dependencies = TRUE, repos = gha_repos, build_vignettes = FALSE, upgrade = TRUE) + continue-on-error: true + shell: Rscript {0} + + - name: Install dependencies pass 2 + run: | + ## Pass #2 at installing dependencies + ## This pass does not use AnVIL and will thus update any packages + ## that have seen been updated in Bioconductor + message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****')) + remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE, force = TRUE) + shell: Rscript {0} + + - name: Install BiocGenerics + if: env.has_RUnit == 'true' + run: | + ## Install BiocGenerics + BiocManager::install("BiocGenerics") + shell: Rscript {0} + + - name: Install covr + if: github.ref == 'refs/heads/devel' && env.run_covr == 'true' && runner.os == 'Linux' + run: | + remotes::install_cran("covr") + shell: Rscript {0} + + - name: Install pkgdown + if: github.ref == 'refs/heads/devel' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: | + remotes::install_cran("pkgdown") + shell: Rscript {0} + + - name: Session info + run: | + options(width = 100) + pkgs <- installed.packages()[, "Package"] + sessioninfo::session_info(pkgs, include_base = TRUE) + shell: Rscript {0} + + - name: Run CMD check + env: + _R_CHECK_CRAN_INCOMING_: false + DISPLAY: 99.0 + run: | + options(crayon.enabled = TRUE) + rcmdcheck::rcmdcheck( + args = c("--no-manual", "--no-vignettes", "--timings"), + build_args = c("--no-manual", "--keep-empty-dirs", "--no-resave-data"), + error_on = "warning", + check_dir = "check" + ) + shell: Rscript {0} + + ## Might need an to add this to the if: && runner.os == 'Linux' + - name: Reveal testthat details + if: env.has_testthat == 'true' + run: find . -name testthat.Rout -exec cat '{}' ';' + + - name: Run RUnit tests + if: env.has_RUnit == 'true' + run: | + BiocGenerics:::testPackage() + shell: Rscript {0} + + - name: Run BiocCheck + env: + DISPLAY: 99.0 + run: | + BiocCheck::BiocCheck( + dir('check', 'tar.gz$', full.names = TRUE), + `quit-with-status` = FALSE, + `no-check-R-ver` = TRUE, + `no-check-bioc-help` = TRUE + ) + shell: Rscript {0} + + - name: Test coverage + if: github.ref == 'refs/heads/devel' && env.run_covr == 'true' && runner.os == 'Linux' + run: | + covr::codecov() + shell: Rscript {0} + + - name: Install package + if: github.ref == 'refs/heads/devel' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: R CMD INSTALL . + + - name: Build and deploy pkgdown site + if: github.ref == 'refs/heads/devel' && env.run_pkgdown == 'true' && runner.os == 'Linux' + run: | + git config --global user.name "$GITHUB_ACTOR" + git config --global user.email "$GITHUB_ACTOR@users.noreply.github.com" + git config --global --add safe.directory /__w/imbeimainz/DeeDee + Rscript -e "pkgdown::deploy_to_branch(new_process = FALSE)" + shell: bash {0} + ## Note that you need to run pkgdown::deploy_to_branch(new_process = FALSE) + ## at least one locally before this will work. This creates the gh-pages + ## branch (erasing anything you haven't version controlled!) and + ## makes the git history recognizable by pkgdown. + + - name: Upload check results + if: failure() + uses: actions/upload-artifact@master + with: + name: ${{ runner.os }}-biocversion-devel-r-devel-results + path: check + + # - uses: docker/build-push-action@v1 + # if: "!contains(github.event.head_commit.message, '/nodocker') && env.run_docker == 'true' && runner.os == 'Linux' " + # with: + # username: ${{ secrets.DOCKER_USERNAME }} + # password: ${{ secrets.DOCKER_PASSWORD }} + # repository: isee/isee + # tag_with_ref: true + # tag_with_sha: true + # tags: latest diff --git a/.gitignore b/.gitignore index c833a2c..138866d 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .RData .Ruserdata inst/doc +docs diff --git a/DESCRIPTION b/DESCRIPTION index c11f45a..bd5d449 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,14 @@ Package: DeeDee Title: Comparative Evaluation and Visualization of Differential Expression Analyses -Version: 0.1.0 +Version: 0.2.0 Authors@R: c( - person(given = "Lea", family = "Rothörl", role = c("aut", "cre"), + person(given = "Lea", family = "Rothörl", role = c("aut"), email = "lea.rothoerl@posteo.de", comment = c(ORCID = "0000-0003-2554-0583") ), person( - given = "Federico", family = "Marini", role = c("aut"), + given = "Federico", family = "Marini", role = c("aut", "cre"), email = "marinif@uni-mainz.de", comment = c(ORCID = "0000-0003-3252-7758") ) ) @@ -21,22 +21,26 @@ Description: DeeDee is a collection of functions to compare the results of two License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.3 Depends: - R (>= 4.1.0) + R (>= 4.3.0) Imports: AnnotationDbi, checkmate, + circlize, clusterProfiler, ComplexHeatmap, ComplexUpset, DESeq2, dplyr, + edgeR, enrichplot, ggplot2, ggvenn, InteractiveComplexHeatmap, + limma, readxl, + rmarkdown, rvest, shiny, shinydashboard, @@ -49,18 +53,20 @@ Imports: utils, viridis, writexl, - xml2 + xml2, + SummarizedExperiment, + methods, + S4Vectors, + rlang Suggests: macrophage, - methods, - rmarkdown, knitr, + BiocStyle, org.Hs.eg.db, org.Mm.eg.db, org.Rn.eg.db, org.Dm.eg.db, testthat (>= 3.0.0) -Config/testthat/edition: 3 VignetteBuilder: knitr biocViews: GUI, GeneExpression, Software, Transcription, Transcriptomics, Visualization, DifferentialExpression diff --git a/NAMESPACE b/NAMESPACE index a6c8471..e9342fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,24 +1,53 @@ # Generated by roxygen2: do not edit by hand +export("dea<-") +export(DeeDeeExperiment) +export(add_dea) +export(dea) export(deedee_app) +export(deedee_bars) export(deedee_cat) +export(deedee_deheat) export(deedee_heatmap) -export(deedee_prepare) export(deedee_qq) export(deedee_qqmult) export(deedee_scatter) export(deedee_summary) export(deedee_upset) export(deedee_venn) -exportClasses(DeeDeeObject) +export(get_dea_df) +export(get_dea_list) +export(remove_dea) +exportClasses(DeeDeeExperiment) +exportMethods("dea<-") +exportMethods(add_dea) +exportMethods(dea) +exportMethods(get_dea_df) +exportMethods(get_dea_list) +exportMethods(remove_dea) +exportMethods(show) +importClassesFrom(SummarizedExperiment,RangedSummarizedExperiment) importFrom(AnnotationDbi,keytypes) importFrom(ComplexHeatmap,Heatmap) importFrom(ComplexHeatmap,draw) +importFrom(ComplexHeatmap,rowAnnotation) importFrom(ComplexUpset,intersection_size) importFrom(ComplexUpset,upset) importFrom(DESeq2,DESeq) importFrom(DESeq2,results) +importFrom(DESeq2,vst) +importFrom(InteractiveComplexHeatmap,InteractiveComplexHeatmapOutput) importFrom(InteractiveComplexHeatmap,makeInteractiveComplexHeatmap) +importFrom(S4Vectors,"metadata<-") +importFrom(S4Vectors,DataFrame) +importFrom(S4Vectors,SimpleList) +importFrom(S4Vectors,metadata) +importFrom(S4Vectors,setValidity2) +importFrom(SummarizedExperiment,"rowData<-") +importFrom(SummarizedExperiment,SummarizedExperiment) +importFrom(SummarizedExperiment,assays) +importFrom(SummarizedExperiment,mcols) +importFrom(SummarizedExperiment,rowData) importFrom(checkmate,assertChoice) importFrom(checkmate,assertClass) importFrom(checkmate,assertDataFrame) @@ -29,26 +58,44 @@ importFrom(checkmate,assert_logical) importFrom(checkmate,assert_number) importFrom(checkmate,assert_subset) importFrom(checkmate,test_subset) +importFrom(circlize,colorRamp2) importFrom(clusterProfiler,enrichGO) importFrom(dplyr,bind_rows) importFrom(dplyr,full_join) importFrom(dplyr,inner_join) +importFrom(edgeR,topTags) importFrom(enrichplot,emapplot) importFrom(enrichplot,pairwise_termsim) importFrom(ggplot2,aes) importFrom(ggplot2,annotate) importFrom(ggplot2,coord_cartesian) +importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) +importFrom(ggplot2,geom_text) importFrom(ggplot2,ggplot) +importFrom(ggplot2,ggplot_build) importFrom(ggplot2,labs) +importFrom(ggplot2,position_dodge) importFrom(ggplot2,scale_fill_manual) +importFrom(ggplot2,theme_bw) importFrom(ggplot2,theme_light) importFrom(ggplot2,xlab) importFrom(ggplot2,ylab) importFrom(ggvenn,ggvenn) +importFrom(limma,topTable) +importFrom(methods,as) +importFrom(methods,callNextMethod) +importFrom(methods,is) +importFrom(methods,new) +importFrom(methods,show) +importFrom(methods,validObject) importFrom(readxl,excel_sheets) importFrom(readxl,read_excel) +importFrom(rlang,.data) +importFrom(rmarkdown,render) +importFrom(rvest,html_node) +importFrom(shiny,HTML) importFrom(shiny,actionButton) importFrom(shiny,addResourcePath) importFrom(shiny,brushOpts) @@ -60,8 +107,11 @@ importFrom(shiny,conditionalPanel) importFrom(shiny,downloadButton) importFrom(shiny,downloadHandler) importFrom(shiny,fileInput) +importFrom(shiny,fluidPage) importFrom(shiny,fluidRow) +importFrom(shiny,includeHTML) importFrom(shiny,includeMarkdown) +importFrom(shiny,isTruthy) importFrom(shiny,navbarPage) importFrom(shiny,need) importFrom(shiny,numericInput) @@ -69,29 +119,42 @@ importFrom(shiny,observeEvent) importFrom(shiny,plotOutput) importFrom(shiny,reactive) importFrom(shiny,reactiveValues) +importFrom(shiny,removeNotification) importFrom(shiny,renderPlot) +importFrom(shiny,renderPrint) importFrom(shiny,renderTable) importFrom(shiny,renderText) importFrom(shiny,renderUI) importFrom(shiny,req) importFrom(shiny,selectInput) importFrom(shiny,shinyApp) +importFrom(shiny,showNotification) importFrom(shiny,tabPanel) importFrom(shiny,tableOutput) +importFrom(shiny,tagList) +importFrom(shiny,tags) importFrom(shiny,textOutput) importFrom(shiny,uiOutput) importFrom(shiny,validate) +importFrom(shiny,verbatimTextOutput) importFrom(shinyBS,bsCollapse) importFrom(shinyBS,bsCollapsePanel) importFrom(shinyBS,bsModal) importFrom(shinycssloaders,withSpinner) +importFrom(shinydashboard,tabBox) importFrom(shinythemes,shinytheme) importFrom(stats,approx) importFrom(stats,complete.cases) +importFrom(stats,na.omit) importFrom(tibble,column_to_rownames) importFrom(tibble,rownames_to_column) importFrom(tools,file_ext) +importFrom(utils,browseURL) +importFrom(utils,data) +importFrom(utils,packageVersion) importFrom(utils,read.table) importFrom(viridis,scale_color_viridis) importFrom(viridis,viridis) importFrom(writexl,write_xlsx) +importFrom(xml2,read_html) +importFrom(xml2,write_html) diff --git a/NEWS.md b/NEWS.md index 2675d4e..f15acc8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,2 +1,19 @@ +# DeeDee 0.2.0 + +## New features + +* DeeDee now is using a formal class definition, with `DeeDeeExperiment` being +a structure derived by the general `SummarizedExperiment` container +* `deedee_deheat()` presents a summary of the (transformed) expression values for +the set of genes reported as DE in the contrasts + +## Other notes + +* Added some basic infrastructure for unit testing +* Entered some biocViews for compliance with Bioconductor standards + # DeeDee 0.1.0 -basic functionality in standalone functions and app available + +## New features + +* Basic functionality in standalone functions and in the app are available! diff --git a/R/AllClasses.R b/R/AllClasses.R new file mode 100644 index 0000000..c060b1e --- /dev/null +++ b/R/AllClasses.R @@ -0,0 +1,14 @@ +#' @rdname DeeDeeExperiment +#' +#' @exportClass DeeDeeExperiment +#' +#' @slot dea This slot is designed to hold the DE-related information. This is +#' internally being created upon importing from the list of DE results objects, +#' provided when instantiating the [DeeDeeExperiment]. +#' +setClass("DeeDeeExperiment", + contains = "RangedSummarizedExperiment", + slots = representation( + dea = "list" + ) +) diff --git a/R/AllGenerics.R b/R/AllGenerics.R new file mode 100644 index 0000000..2473874 --- /dev/null +++ b/R/AllGenerics.R @@ -0,0 +1,20 @@ +# DeeDeeExperiment methods ----------------------------------------------------- + +#' @export +setGeneric("dea", function(x, ...) standardGeneric("dea")) + +#' @export +setGeneric("dea<-", function(x, value) standardGeneric("dea<-")) + +#' @export +setGeneric("add_dea", function(x, dea, ...) standardGeneric("add_dea")) + +#' @export +setGeneric("remove_dea", function(x, dea_name, ...) standardGeneric("remove_dea")) + +#' @export +setGeneric("get_dea_df", function(x, dea_name, ...) standardGeneric("get_dea_df")) + +#' @export +setGeneric("get_dea_list", function(x, ...) standardGeneric("get_dea_list")) + diff --git a/R/DeeDee-app.R b/R/DeeDee-app.R new file mode 100644 index 0000000..be1ec19 --- /dev/null +++ b/R/DeeDee-app.R @@ -0,0 +1,1764 @@ +#' DeeDee App +#' +#' @description `deedee_app` opens the DeeDee Shiny web application, combining +#' the functionalities of all other DeeDee functions with a user-friendly +#' graphical user interface. +#' +#' @param deedee_obj An object of the class DeeDeeExperiment to be analyzed. +#' @param dde An object of the class DeeDeeExperiment to be analyzed. +#' +#' @return A shiny app +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' if (interactive()) { +#' deedee_app(dde = dde) +#' } +#' +#' # one can provide the DeeDeeExperiment object also at runtime +#' if (interactive()) { +#' deedee_app() +#' } +deedee_app <- function(deedee_obj = NULL, + dde = NULL) { + + + # ui definition ----------------------------------------------------------- + deedee_ui <- shiny::navbarPage( + title = "DeeDee", + id = "tabs", + theme = shinythemes::shinytheme("flatly"), + + # ui - data input ---------------------------------------------------------- + shiny::tabPanel( + title = "Input", + tags$head( + tags$style( + shiny::HTML( + ".shiny-output-error-validation { + font-size: 15px; + color: forestgreen; + text-align: center; + } + " + ) + ) + ), + + uiOutput("ui_panel_datainput"), + + # shiny::downloadButton("vignette", + # "Download DeeDee Package vignette (.html)") + ), + + # ui - scatter ------------------------------------------------------------- + shiny::tabPanel( + title = "Scatterplot", + + uiOutput("ui_panel_scatter"), + ), + + + # ui - heatmap ------------------------------------------------------------- + shiny::tabPanel( + title = "Heatmap", + id = "heatmap", + + uiOutput("ui_panel_heatmap"), + + ), + + # ui - venn ---------------------------------------------------------------- + shiny::tabPanel( + title = "Venn Diagram", + + uiOutput("ui_panel_venn"), + ), + + + # ui - upset --------------------------------------------------------------- + shiny::tabPanel( + title = "UpSet Plot", + + uiOutput("ui_panel_upset"), + ), + + + # ui - qq ------------------------------------------------------------------ + shiny::tabPanel( + title = "Quantile-Quantile Plot", + + uiOutput("ui_panel_qq"), + ), + + + # ui - cat ----------------------------------------------------------------- + shiny::tabPanel( + title = "Concordance At the Top Plot", + + uiOutput("ui_panel_cat"), + ), + + # ui - summary ------------------------------------------------------------- + shiny::tabPanel( + title = "Summary", + + uiOutput("ui_panel_summary") + ) + ) + + + + + # server definition ---------------------------------------------------------- + # nocov start + deedee_server <- function(input, output, session) { + + # initializing reactives --------------------------------------------------- + reactive_values <- reactiveValues() + + if (!is.null(dde)) { + message("DeeDeeExperiment object provided") + + reactive_values$dde <- dde + } else { + message("no DeeDeeExperiment data provided, upload at runtime expected") + reactive_values$dde <- NULL + } + + # server - data input ------------------------------------------------------ + output$ui_panel_datainput <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 8, + shiny::fileInput( + inputId = "upload_de", + label = "Upload your DEA results or DeeDee objects", + multiple = TRUE, + accept = c(".rds", ".txt", ".xlsx"), + placeholder = "No files selected" + ), + + shiny::fileInput( + inputId = "upload_deedee", + label = "Upload your DeeDeeExperiment object", + # multiple = TRUE, + multiple = FALSE, + accept = c(".rds"), + placeholder = "no DeeDeeExperiment provided" + ), + + verbatimTextOutput("print_dde"), + shiny::tableOutput("inp_infobox"), + verbatimTextOutput("print_dde_touse") + ), + shiny::column( + width = 4, + shiny::selectInput( + inputId = "in_organism", + label = "Organism", + choices = list( + "Human" = "org.Hs.eg.db", + "Mouse" = "org.Mm.eg.db", + "Fly" = "org.Dm.eg.db", + "Rat" = "org.Rn.eg.db" + ) + ), + shiny::uiOutput("ui_key_inp"), + shiny::uiOutput("ui_datasets"), + shiny::uiOutput("ui_datasets_deedee"), + shiny::conditionalPanel( + "output.inp_infobox", + shiny::downloadButton( + "btn_inp_download", + "Download DeeDee object (.RDS)" + ) + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - input", + shiny::includeMarkdown( + system.file("extdata", "input.md", package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + output$ui_key_inp <- shiny::renderUI({ + shiny::req(input$in_organism) + anno <- input$in_organism + require(anno, character.only = TRUE) + shiny::selectInput( + inputId = "in_key_type", + label = "Key type of gene IDs", + choices = keytypes(get(anno)) + ) + }) + + mydata <- shiny::reactive({ + shiny::req( + shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + ) + + ext <- c() + res <- list() + + if (!is.null(deedee_obj)) { + if (is(deedee_obj, "DeeDeeObject")) { + ext[1] <- "arg" + # df <- data.frame(filename, type, contrast, genes) + res[[1]] <- deedee_obj@DeeDeeList + } + else { + stop("Your argument input is not of type 'DeeDeeObject'. Please check your input and re-open the application.") + } + } + + k <- 0 + + # reading out input files + if (length(input$upload_de[, 1] > 0)) { + for (i in (length(ext) + 1):(length(input$upload_de[, 1]) + length(ext))) { + k <- k + 1 + ext[i] <- tools::file_ext(input$upload_de[k, "datapath"]) + shiny::validate( + shiny::need( + ext[[i]] == "rds" || + ext[[i]] == "RDS" || + ext[[i]] == "xlsx" || + ext[[i]] == "txt", + message = "Please upload only .RDS, .xlsx or .txt files" + ) + ) + + # .RDS input + if (ext[[i]] == "rds" || ext[[i]] == "RDS") { + res[[i]] <- readRDS(input$upload_de[[k, "datapath"]]) + res[[i]] <- rds_input(obj = res[[i]], + nm = input$upload_de[[k, "name"]]) + + # .xlsx input + } else if (ext[[i]] == "xlsx") { + sheets <- readxl::excel_sheets(input$upload_de[[k, "datapath"]]) + res[[i]] <- xlsx_input(obj = sheets, + path= input$upload_de[[k, "datapath"]], + nm = input$upload_de[k, "name"]) + + # .txt input + } else if (ext[[i]] == "txt") { + temp <- utils::read.table(input$upload_de[[k, "datapath"]]) + res[[i]] <- list(temp) + names(res[[i]]) <- + unlist(strsplit(input$upload_de[k, "name"], split = ".", fixed = TRUE))[1] + } else { + return(NULL) + } + } + } + + # merging input data structures + dat <- list() + for (i in seq_len(length(res))) { + for (j in seq_len(length(res[[i]]))) { + checkmate::assert_subset(names(res[[i]][[j]]), c("logFC", "pval")) + dat[[names(res[[i]])[[j]]]] <- res[[i]][[j]] + } + } + + ###### to-replace ####### obj <- DeeDeeLegacy::DeeDeeObject(DeeDeeList = dat) + obj <- dat #### TODO + + return(obj) + }) + + my_deedee <- reactive({ + # TODO: from the list to the DeeDeeExperiment + + # TODO: or directly from the uploads + + + # TODO: or as of now, passed directly from the argument + reactive_values$dde + }) + + output$ui_datasets <- shiny::renderUI({ + shiny::req( + shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + ) + shiny::checkboxGroupInput( + inputId = "select_datasets", + label = "Select datasets to be used", + choices = names(mydata()@DeeDeeList), + selected = names(mydata()@DeeDeeList) + ) + }) + + output$ui_datasets_deedee <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req( + shiny::isTruthy(reactive_values$dde) + ) + shiny::checkboxGroupInput( + inputId = "select_datasets_deedee", + label = "Select datasets to be used", + choices = names(dea(my_deedee())), + selected = names(dea(my_deedee())) + ) + }) + + mydata_use <- shiny::reactive({ + shiny::req( + shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + ) + use <- input$select_datasets + dat2 <- list() + for (i in use) { + dat2[i] <- mydata()@DeeDeeList[i] + } + return(dat2) + }) + + + output$print_dde <- renderPrint({ + my_deedee() + }) + + my_deedee_use <- reactive({ + to_use <- input$select_datasets_deedee + to_remove <- setdiff(names(dea(my_deedee())), to_use) + + dde_to_use <- remove_dea(my_deedee(), dea_name = to_remove) + dde_to_use + }) + + output$print_dde_touse <- renderPrint({ + my_deedee_use() + }) + + output$btn_inp_download <- shiny::downloadHandler( + filename = "DeeDee_object.RDS", + content = function(file) { + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + ###### to-replace ####### dl <- DeeDeeLegacy::DeeDeeObject(DeeDeeList = mydata_use()) + ###### to-replace ####### saveRDS(dl, file) + } + ) + + output$inp_infobox <- shiny::renderTable({ + shiny::validate(shiny::need( + !is.null(mydata()@DeeDeeList), + message = "Faulty input data provided." + )) + + shiny::req( + shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + ) + + input_infobox( + deedee_obj = deedee_obj, + sets = input$upload_de, + md = mydata() + ) + }) + + + # server - scatter --------------------------------------------------------- + output$ui_panel_scatter <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::uiOutput("ui_scatter_choices1"), + shiny::uiOutput("ui_scatter_choices2"), + shiny::selectInput( + inputId = "in_scatter_color_by", + label = "Color by", + choices = list( + "1st p-value" = "pval1", + "2nd p-value" = "pval2" + ), + selected = "pval1" + ), + shiny::numericInput( + inputId = "in_scatter_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ), + shiny::actionButton( + inputId = "btn_ora_button", + label = "Over-representation analysis" + ) + ), + shiny::column( + width = 8, + shinycssloaders::withSpinner( + shiny::plotOutput( + outputId = "plot_deedee_scatter", + # dblclick = "scatter_dblclick", + brush = shiny::brushOpts( + id = "scatter_brush", + resetOnNew = FALSE + ) + ) + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - scatter plot", + shiny::includeMarkdown( + system.file("extdata", "scatter.md", package = "DeeDee") + ), + style = "primary" + ) + ), + shinyBS::bsModal( + id = "modalExample", + title = "Gene Ontology over-representation analysis", + trigger = "btn_ora_button", + size = "large", + shinycssloaders::withSpinner( + shiny::plotOutput("scatter_ora") + ), + shiny::downloadButton( + outputId = "btn_ora_download", + label = "Download enrichment result object (.RDS)" + ) + ), + shiny::downloadButton( + outputId = "btn_scatter_brush_download", + label = "Download brushed genes (.xlsx)" + ), + shiny::tableOutput("scatter_brush_info") + ) + }) + + output$ui_scatter_choices1 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_scatter_select1", + label = "1st data set", + choices = names(dea(my_deedee_use())) + ) + }) + + output$ui_scatter_choices2 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_scatter_select2", + label = "2nd data set", + selected = names(dea(my_deedee_use()))[2], + choices = names(dea(my_deedee_use())) + ) + }) + + # --- plot output --- + ranges <- shiny::reactiveValues( + x = NULL, + y = NULL + ) + + output$plot_deedee_scatter <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + sel1 <- match(input$in_scatter_select1, names(dea(my_deedee_use()))) + sel2 <- match(input$in_scatter_select2, names(dea(my_deedee_use()))) + shiny::req(sel1) + shiny::req(sel2) + res <- deedee_scatter( + my_deedee_use(), + select1 = sel1, + select2 = sel2, + color_by = input$in_scatter_color_by, + pthresh = input$in_scatter_pthresh + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No common genes in input datasets.") + ) + res + + ggplot2::coord_cartesian( + xlim = ranges$x, + ylim = ranges$y, + expand = FALSE + ) + }) + + # --- brushing --- + # scatter_download_button <- shiny::renderUI( + # conditionalPanel("output.scatter_brushed()", + # downloadButton("btn_scatter_brush_download", + # "Download brushed genes (.txt)"))) + + scatter_brushed <- shiny::reactive({ + shiny::req(input$scatter_brush) + df <- data.frame( + x = mydata_use()[[input$in_scatter_select1]], + y = mydata_use()[[input$in_scatter_select2]] + ) + + df <- subset(df, x.pval < 0.05 & y.pval < 0.05) + + names(df) <- c( + paste(input$in_scatter_select1, ".logFC", sep = ""), + paste(input$in_scatter_select1, ".pval", sep = ""), + paste(input$in_scatter_select2, ".logFC", sep = ""), + paste(input$in_scatter_select2, ".pval", sep = "") + ) + shiny::brushedPoints( + df, + input$scatter_brush, + xvar = paste(input$in_scatter_select1, ".logFC", sep = ""), + yvar = paste(input$in_scatter_select2, ".logFC", sep = "") + ) + }) + + output$scatter_brush_info <- shiny::renderTable( + { + shiny::req(scatter_brushed()) + scatter_brushed() + }, + rownames = TRUE + ) + + output$btn_scatter_brush_download <- shiny::downloadHandler( + filename = "scatter_brushed_genes.xlsx", + content = function(file) { + shiny::req(input$scatter_brush) + bru <- tibble::rownames_to_column(scatter_brushed()) + first <- data.frame(bru[1], bru[2], bru[3]) + nm1 <- unlist(strsplit(names(first)[2], + split = ".", + fixed = TRUE + ))[1] + names(first) <- c("rowname", "logFC", "pval") + second <- data.frame(bru[1], bru[4], bru[5]) + nm2 <- unlist(strsplit(names(second)[2], + split = ".", + fixed = TRUE + ))[1] + names(second) <- c("rowname", "logFC", "pval") + l <- list(first, second) + names(l) <- c(nm1, nm2) + writexl::write_xlsx(l, file, col_names = TRUE) + } + ) + + # --- enrich --- + enrich <- shiny::reactive({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::validate( + shiny::need( + scatter_brushed(), + message = "No brushed genes." + ) + ) + + sel1 <- match(input$in_scatter_select1, names(mydata_use())) + sel2 <- match(input$in_scatter_select2, names(mydata_use())) + shiny::req(sel1) + shiny::req(sel2) + data <- list(mydata_use()[[sel1]], mydata_use()[[sel2]]) + + res <- ora( + geneList = scatter_brushed(), + universe = data, + orgDB = input$in_organism, + key_type = input$in_key_type + ) + shiny::validate( + shiny::need( + is(res, "enrichResult"), + message = "Not working." + ) + ) + + return(res) + }) + + output$scatter_ora <- shiny::renderPlot({ + shiny::validate( + shiny::need( + !is.null(enrich()), + message = "Something went wrong..." + ) + ) + en <- enrich() + en_df <- as.data.frame(en) + shiny::validate( + shiny::need( + nrow(en_df) > 0, + message = "No enriched terms found." + ) + ) + + options(ggrepel.max.overlaps = Inf) + plt <- enrichplot::emapplot(enrichplot::pairwise_termsim(en)) + shiny::validate( + shiny::need( + !is.null(plt), + message = "No enriched terms found." + ) + ) + return(plt) + }) + + output$btn_ora_download <- shiny::downloadHandler( + filename = "enrichment_results.RDS", + content = function(file) { + shiny::req(!is.null(enrich())) + saveRDS(enrich(), file) + } + ) + + # server - heatmap --------------------------------------------------------- + output$ui_panel_heatmap <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::numericInput( + inputId = "in_heatmap_show_first", + label = "Show first", + value = 25, + min = 1 + ), + shiny::checkboxInput( + inputId = "in_heatmap_show_gene_names", + label = "Show gene names", + value = FALSE + ), + shiny::checkboxInput( + inputId = "in_heatmap_showNA", + label = "Show NA", + value = FALSE + ), + shiny::selectInput( + inputId = "in_heatmap_dist", + label = "Distance measure", + choices = list( + "Euclidean" = "euclidean", + "Manhattan" = "manhattan", + "Pearson" = "pearson", + "Spearman" = "spearman" + ), + selected = "euclidean" + ), + shiny::selectInput( + inputId = "in_heatmap_clust", + label = "Clustering method", + choices = list( + "Single" = "single", + "Complete" = "complete", + "Average" = "average", + "Centroid" = "centroid" + ), + selected = "average" + ), + shiny::numericInput( + inputId = "in_heatmap_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ), + shiny::actionButton( + inputId = "btn_heatmap_action", + label = "Create heatmap") + ), + shiny::column( + width = 8, + shiny::textOutput("heatmap_errors"), + shiny::conditionalPanel( + "output.heatmap_errors == ''", + shinycssloaders::withSpinner( + InteractiveComplexHeatmap::InteractiveComplexHeatmapOutput() + ) + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - heatmap", + shiny::includeMarkdown( + system.file("extdata", "heatmap.md",package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + + output$heatmap_errors <- shiny::renderText({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + !is.null(heatmap_output()), + message = "No common genes in input datasets." + ) + ) + "" + }) + + heatmap_output <- shiny::reactive({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::req(input$in_heatmap_show_first) + # shiny::req(mydata_use()) + res <- deedee_heatmap( + my_deedee_use(), + show_first = input$in_heatmap_show_first, + show_gene_names = input$in_heatmap_show_gene_names, + dist = input$in_heatmap_dist, + clust = input$in_heatmap_clust, + pthresh = input$in_heatmap_pthresh, + show_na = input$in_heatmap_showNA + ) + shiny::validate( + shiny::need(!is.null(res), message = "No common genes in input datasets.") + ) + + res <- ComplexHeatmap::draw(res) + + return(res) + }) + + listen <- shiny::reactive({ + list( + input$in_heatmap_show_first, + input$in_heatmap_show_gene_names, + input$in_heatmap_dist, + input$in_heatmap_clust, + input$in_heatmap_pthresh, + input$in_heatmap_showNA, + mydata_use() + ) + }) + + global <- reactiveValues(notify = FALSE) + + shiny::observeEvent(listen(), { + global$notify <- TRUE + }) + + shiny::observeEvent(input$tabs, { + if (input$tabs == "Heatmap") { + if (global$notify == TRUE) { + shiny::showNotification( + ui = "Something changed. Click 'Create heatmap' to reload.", + duration = NULL, + type = "warning", + id = "heatmap_warning" + ) + } + } else { + shiny::removeNotification(id = "heatmap_warning") + } + }) + + shiny::observeEvent(listen(), { + req(input$tabs == "Heatmap") + shiny::showNotification( + ui = "Something changed. Click 'Create heatmap' to reload.", + duration = NULL, + type = "warning", + id = "heatmap_warning" + ) + }) + + shiny::observeEvent(input$btn_heatmap_action, { + shiny::req( + # length(mydata_use()) >= 2 + length(dea(my_deedee_use())) >= 2, + ) + global$notify <- FALSE + InteractiveComplexHeatmap::makeInteractiveComplexHeatmap( + input, + output, + session, + heatmap_output() + ) + shiny::removeNotification("heatmap_warning") + }) + + + # server - venn ------------------------------------------------------------ + output$ui_panel_venn <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::selectInput( + inputId = "in_venn_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "both" + ), + shiny::numericInput( + inputId = "in_venn_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ) + ), + shiny::column( + width = 8, + shinycssloaders::withSpinner( + shiny::plotOutput("plot_deedee_venn") + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - venn", + shiny::includeMarkdown( + system.file("extdata", "venn.md", package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + + output$plot_deedee_venn <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + res <- deedee_venn( + my_deedee_use(), + mode = input$in_venn_mode, + pthresh = input$in_venn_pthresh + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No genes in your datasets. Maybe your specified p-value threshold is too low?" + ) + ) + + res + }) + + + # server - upset ----------------------------------------------------------- + output$ui_panel_upset <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::selectInput( + inputId = "in_upset_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "both" + ), + shiny::conditionalPanel( + condition = "input.in_upset_mode == 'both'", + shiny::checkboxInput( + inputId = "in_upset_colored", + label = "Coloring", + value = TRUE + ) + ), + shiny::numericInput( + inputId = "in_upset_minset", + label = "Minimum set size", + value = 10, min = 0, step = 1 + ), + shiny::numericInput( + inputId = "in_upset_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ) + ), + shiny::column( + width = 8, + shinycssloaders::withSpinner( + shiny::plotOutput("plot_deedee_upset") + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - upset", + shiny::includeMarkdown( + system.file("extdata", "upset.md", package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + + output$plot_deedee_upset <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + if (input$in_upset_mode == "both" && input$in_upset_colored) { + mode <- "both_colored" + } else { + mode <- input$in_upset_mode + } + + res <- deedee_upset( + my_deedee_use(), + mode = mode, + pthresh = input$in_upset_pthresh, + min_setsize = input$in_upset_minset + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No genes in your datasets. Maybe your specified p-value threshold is too low?" + ) + ) + res + }) + + + # server - qq -------------------------------------------------------------- + output$ui_panel_qq <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::checkboxInput( + inputId = "in_qq_multiple", + label = "Multiple", + value = FALSE + ), + shiny::conditionalPanel( + condition = "!input.in_qq_multiple", + shiny::uiOutput("ui_qq_choices1"), + shiny::uiOutput("ui_qq_choices2"), + shiny::selectInput( + inputId = "in_qq_color_by", + label = "Color by", + choices = list( + "1st p-value" = "pval1", + "2nd p-value" = "pval2" + ), + selected = "pval1" + ), + shiny::checkboxInput( + inputId = "in_qq_line", + "As line", + value = FALSE) + ), + shiny::conditionalPanel( + condition = "input.in_qq_multiple", + shiny::uiOutput("ui_qq_ref"), + ), + shiny::numericInput( + inputId = "in_qq_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ) + ), + shiny::column( + width = 8, + shiny::conditionalPanel( + condition = "!input.in_qq_multiple", + shinycssloaders::withSpinner( + shiny::plotOutput( + outputId = "plot_deedee_qq", + brush = "qq_brush" + ) + ) + ), + shiny::conditionalPanel( + condition = "input.in_qq_multiple", + shinycssloaders::withSpinner( + shiny::plotOutput("plot_deedee_qq_mult") + ) + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - qq plot", + shiny::includeMarkdown( + system.file("extdata", "qq.md", package = "DeeDee") + ), + style = "primary" + ) + ), + shiny::conditionalPanel( + condition = "!input.in_qq_multiple", + shiny::downloadButton( + outputId = "btn_qq_brush_download", + label = "Download brushed genes (.xlsx)" + ), + shiny::tableOutput("qq_brush_info") + ) + ) + }) + + output$ui_qq_choices1 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_qq_select1", + label = "1st data set", + choices = names(dea(my_deedee_use())) + ) + }) + + output$ui_qq_choices2 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_qq_select2", + label = "2nd data set", + selected = names(dea(my_deedee_use()))[2], + choices = names(dea(my_deedee_use())) + ) + }) + + output$ui_qq_ref <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_qq_reference", + label = "Reference", + choices = names(dea(my_deedee_use())) + ) + }) + + output$plot_deedee_qq <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + sel1 <- match(input$in_qq_select1, names(dea(my_deedee_use()))) + sel2 <- match(input$in_qq_select2, names(dea(my_deedee_use()))) + shiny::req(sel1) + shiny::req(sel2) + res <- deedee_qq( + my_deedee_use(), + select1 = sel1, + select2 = sel2, + color_by = input$in_qq_color_by, + pthresh = input$in_qq_pthresh, + as_line = input$in_qq_line + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No genes in your datasets. Maybe your specified p-value threshold is too low?" + ) + ) + + res + }) + + output$plot_deedee_qq_mult <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + ref <- match(input$in_qq_reference, names(dea(my_deedee_use()))) + shiny::req(ref) + res <- deedee_qqmult( + my_deedee_use(), + ref = ref, + pthresh = input$in_qq_pthresh + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No genes in your datasets. Maybe your specified p-value threshold is too low?" + ) + ) + + res + }) + + qq_brushed <- shiny::reactive({ + shiny::req(input$qq_brush) + x <- mydata()@DeeDeeList[[input$in_qq_select1]]$logFC + y <- mydata()@DeeDeeList[[input$in_qq_select2]]$logFC + pval1 <- mydata()@DeeDeeList[[input$in_qq_select2]]$pval + pval2 <- mydata()@DeeDeeList[[input$in_qq_select2]]$pval + names(x) <- row.names(mydata()@DeeDeeList[[input$in_qq_select2]]) + names(y) <- row.names(mydata()@DeeDeeList[[input$in_qq_select2]]) + + sx_idx <- order(x) + sy_idx <- order(y) + + sx <- x[sx_idx] + sy <- y[sy_idx] + pval1 <- pval1[sx_idx] + pval2 <- pval2[sy_idx] + + lenx <- length(sx) + leny <- length(sy) + + if (leny < lenx) { + sx <- stats::approx(1L:lenx, sx, n = leny)$y + pval1 <- stats::approx(1L:lenx, pval1, n = leny)$y + } + if (leny > lenx) { + sy <- stats::approx(1L:leny, sy, n = lenx)$y + pval2 <- stats::approx(1L:leny, pval2, n = lenx)$y + } + + sx <- tibble::rownames_to_column(as.data.frame(sx)) + sx[3] <- pval1 + sy <- tibble::rownames_to_column(as.data.frame(sy)) + sy[3] <- pval2 + + qq <- data.frame( + x = sx, + y = sy + ) + + names(qq) <- c( + paste(input$in_qq_select1, "gene", sep = "."), + paste(input$in_qq_select1, "logFC", sep = "."), + paste(input$in_qq_select1, "pval", sep = "."), + paste(input$in_qq_select2, "gene", sep = "."), + paste(input$in_qq_select2, "logFC", sep = "."), + paste(input$in_qq_select2, "pval", sep = ".") + ) + + temp1 <- paste(input$in_qq_select1, "logFC", sep = ".") + temp2 <- paste(input$in_qq_select2, "logFC", sep = ".") + + shiny::brushedPoints( + df = qq, + brush = input$qq_brush, + xvar = temp1, + yvar = temp2 + ) + }) + + output$qq_brush_info <- shiny::renderTable( + { + shiny::req(qq_brushed()) + qq_brushed() + }, + rownames = FALSE + ) + + output$btn_qq_brush_download <- shiny::downloadHandler( + filename = "qq_brushed_genes.xlsx", + content = function(file) { + shiny::req(input$qq_brush) + bru <- qq_brushed() + first <- data.frame(bru[1], bru[2], bru[3]) + nm1 <- unlist(strsplit(names(first)[2], + split = ".", + fixed = TRUE + ))[1] + names(first) <- c("rowname", "logFC", "pval") + second <- data.frame(bru[4], bru[5], bru[6]) + nm2 <- unlist(strsplit(names(second)[2], + split = ".", + fixed = TRUE + ))[1] + names(second) <- c("rowname", "logFC", "pval") + l <- list(first, second) + names(l) <- c(nm1, nm2) + writexl::write_xlsx(l, file, col_names = TRUE) + } + ) + + + # server - cat ------------------------------------------------------------- + output$ui_panel_cat <- renderUI({ + tagList( + shiny::fluidRow( + shiny::column( + width = 4, + shiny::selectInput( + inputId = "in_cat_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "up" + ), + shiny::numericInput( + inputId = "in_cat_maxrank", + label = "Max rank", + value = 1000, + min = 1 + ), + shiny::uiOutput("ui_cat_choice"), + shiny::numericInput( + inputId = "in_cat_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ) + ), + shiny::column( + width = 8, + shinycssloaders::withSpinner( + shiny::plotOutput("plot_deedee_cat") + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - cat plot", + shiny::includeMarkdown( + system.file("extdata", "cat.md", package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + + output$ui_cat_choice <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "in_cat_ref", + label = "Reference contrast", + selected = names(dea(my_deedee_use()))[1], + choices = names(dea(my_deedee_use())) + ) + }) + + output$plot_deedee_cat <- shiny::renderPlot({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::req(input$in_cat_maxrank) + shiny::req(input$in_cat_ref) + + ref <- match(input$in_cat_ref, names(dea(my_deedee_use()))) + res <- deedee_cat( + my_deedee_use(), + ref = ref, + maxrank = input$in_cat_maxrank, + mode = input$in_cat_mode, + pthresh = input$in_cat_pthresh + ) + + shiny::validate( + shiny::need( + !is.null(res), + message = "No genes in your datasets. Maybe your specified p-value threshold is too low?" + ) + ) + + res + }) + + # server - summary --------------------------------------------------------- + output$ui_panel_summary <- renderUI({ + tagList( + shiny::numericInput( + inputId = "sum_pthresh", + label = "P-value threshold", + value = 0.05, min = 0.01, max = 1, step = 0.01 + ), + shiny::actionButton( + inputId = "sum_button", + label = "Create Summary" + ), + shinyBS::bsModal( + id = "sum_modal", + title = "DeeDee Summary", + trigger = "sum_button", + size = "large", + shiny::fluidPage( + shiny::downloadButton( + outputId = "sum_download", + label = "Download your DeeDee Summary (.html)" + ), + shinycssloaders::withSpinner( + shiny::uiOutput("ui_show_html_summary") + ) + ) + ), + shiny::fluidRow( + shinydashboard::tabBox( + title = "", + width = 12, + id = "sum_params", + shiny::tabPanel( + "Scatterplot", + shiny::uiOutput("ui_sum_scatter_choices1"), + shiny::uiOutput("ui_sum_scatter_choices2"), + shiny::selectInput( + inputId = "sum_scatter_color_by", + label = "Color by", + choices = list( + "1st p-value" = "pval1", + "2nd p-value" = "pval2" + ), + selected = "pval1" + ) + ), + shiny::tabPanel( + title = "Heatmap", + shiny::numericInput( + inputId = "sum_heatmap_show_first", + label = "Show first", + value = 25, + min = 1 + ), + shiny::checkboxInput( + inputId = "sum_heatmap_show_gene_names", + label = "Show gene names", + value = FALSE + ), + shiny::checkboxInput( + inputId = "sum_heatmap_show_na", + label = "Show NA", + value = FALSE + ), + shiny::selectInput( + inputId = "sum_heatmap_dist", + label = "Distance measure", + choices = list( + "Euclidean" = "euclidean", + "Manhattan" = "manhattan", + "Pearson" = "pearson", + "Spearman" = "spearman" + ), + selected = "euclidean" + ), + shiny::selectInput( + inputId = "sum_heatmap_clust", + label = "Clustering method", + choices = list( + "Single" = "single", + "Complete" = "complete", + "Average" = "average", + "Centroid" = "centroid" + ), + selected = "average" + ) + ), + shiny::tabPanel( + title = "Venn Diagram", + shiny::selectInput( + inputId = "sum_venn_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "both" + ) + ), + shiny::tabPanel( + title = "UpSet Plot", + shiny::selectInput( + inputId = "sum_upset_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "both" + ), + shiny::conditionalPanel( + condition = "input.sum_upset_mode == 'both'", + shiny::checkboxInput( + inputId = "sum_upset_colored", + label = "Coloring", + value = TRUE + ) + ), + shiny::numericInput( + inputId = "sum_upset_min_setsize", + label = "Minimum set size", + value = 10, min = 0, step = 1 + ) + ), + shiny::tabPanel( + title = "Quantile-Quantile Plot", + shiny::uiOutput("ui_sum_qq_ref"), + ), + shiny::tabPanel( + title = "Concordance At the Top Plot", + shiny::selectInput( + inputId = "sum_cat_mode", + label = "Mode", + choices = list( + "Up" = "up", + "Down" = "down", + "Both" = "both" + ), + selected = "up" + ), + shiny::numericInput( + inputId = "sum_cat_maxrank", + label = "Max rank", + value = 1000, + min = 1 + ), + shiny::uiOutput("ui_sum_cat_choice") + ) + ) + ), + shinyBS::bsCollapse( + shinyBS::bsCollapsePanel( + title = "INFO - summary", + shiny::includeMarkdown( + system.file("extdata", "summary.md", package = "DeeDee") + ), + style = "primary" + ) + ) + ) + }) + + output$ui_sum_scatter_choices1 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "sum_scatter_select1", + label = "1st data set", + choices = names(dea(my_deedee_use())) + ) + }) + + output$ui_sum_scatter_choices2 <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "sum_scatter_select2", + label = "2nd data set", + selected = names(dea(my_deedee_use()))[2], + choices = names(dea(my_deedee_use())) + ) + }) + + output$ui_sum_qq_ref <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "sum_qqmult_ref", + label = "Reference", + selected = names(mydata_use())[1], + choices = names(mydata_use()) + ) + }) + + output$ui_sum_cat_choice <- shiny::renderUI({ + # shiny::req( + # shiny::isTruthy(input$upload_de) || shiny::isTruthy(deedee_obj) + # ) + shiny::req(shiny::isTruthy(reactive_values$dde)) + shiny::selectInput( + inputId = "sum_cat_ref", + label = "Reference contrast", + selected = names(mydata_use())[1], + choices = names(mydata_use()) + ) + }) + + summary <- reactive({ + shiny::validate( + shiny::need( + # length(mydata()@DeeDeeList) >= 2, + length(dea(my_deedee())) >= 2, + message = "Please upload at least two contrasts." + ) + ) + shiny::validate( + shiny::need( + # length(mydata_use()) >= 2, + length(dea(my_deedee_use())) >= 2, + message = "Please select at least two contrasts." + ) + ) + + # TODO: update summary code from here + shiny::req(mydata_use()) + + outfile <- tempfile(fileext = ".html") + + sc_sel1 <- match(input$sum_scatter_select1, names(mydata_use())) + if (is.null(sc_sel1)) { + sc_sel1 <- 1 + } + sc_sel2 <- match(input$sum_scatter_select2, names(mydata_use())) + if (is.null(sc_sel2)) { + sc_sel2 <- 2 + } + + qq_ref <- match(input$sum_qqmult_ref, names(mydata_use())) + if (length(qq_ref) == 0) { + qq_ref <- 1 + } + + cat_ref <- match(input$sum_cat_ref, names(mydata_use())) + if (length(cat_ref) == 0) { + cat_ref <- 1 + } + + if (input$sum_upset_mode == "both" && input$sum_upset_colored) { + ups_mode <- "both_colored" + } else { + ups_mode <- input$sum_upset_mode + } + + shiny::req(sc_sel1) + shiny::req(sc_sel2) + shiny::req(qq_ref) + shiny::req(cat_ref) + + deedee_summary( + # mydata_use(), + dde = my_deedee_use(), + output_path = outfile, + overwrite = TRUE, + pthresh = input$sum_pthresh, + scatter_select1 = sc_sel1, + scatter_select2 = sc_sel2, + scatter_color_by = input$sum_scatter_color_by, + heatmap_show_first = input$sum_heatmap_show_first, + heatmap_show_gene_names = input$sum_heatmap_show_gene_names, + heatmap_dist = input$sum_heatmap_dist, + heatmap_clust = input$sum_heatmap_clust, + heatmap_show_na = input$sum_heatmap_show_na, + venn_mode = input$sum_venn_mode, + upset_mode = ups_mode, + upset_min_setsize = input$sum_upset_min_setsize, + qqmult_ref = qq_ref, + cat_ref = cat_ref, + cat_maxrank = input$sum_cat_maxrank, + cat_mode = input$sum_cat_mode, + silent = TRUE, + open_file = FALSE + ) + + return(outfile) + }) + + output$sum_download <- shiny::downloadHandler( + filename = "DeeDee_Summary.html", + content = function(file) { + shiny::req(summary()) + + file.copy(summary(), file) + } + ) + + output$ui_show_html_summary <- shiny::renderUI({ + shiny::req(summary()) + + out <- tempfile(fileext = ".html") + + xml2::write_html(rvest::html_node(xml2::read_html(summary()), "body"), + file = out + ) + + shiny::includeHTML(path = out) + }) + + + + # observers ---------------------------------------------------------------- + + observeEvent(input$upload_deedee, { + tryCatch( + { + showNotification( + "Trying to upload a DeeDeeExperiment object as an RDS file...", + id = "upload_try" + ) + + reactive_values$in_dde <- readRDS(input$upload_deedee$datapath) + + if (is(reactive_values$in_dde, "DeeDeeExperiment")) { + reactive_values$dde <- reactive_values$in_dde + showNotification( + ui = "Upload complete, enjoy exploring your dataset with DeeDee! ", + type = "message" + ) + } + }, + error = function(e) { + showNotification( + "Wrong/unexpected file format uploaded! Please check the content of your RDS file to be a DeeDeeExperiment.", + type = "error" + ) + } + ) + }) + + } + # nocov end + + # launch app ----------------------------------------------------------------- + # shiny::shinyOptions(deedee_obj = deedee_obj) + shiny::shinyApp(ui = deedee_ui, server = deedee_server) +} diff --git a/R/DeeDee-app_helpers.R b/R/DeeDee-app_helpers.R new file mode 100644 index 0000000..cf5f07e --- /dev/null +++ b/R/DeeDee-app_helpers.R @@ -0,0 +1,230 @@ +# nocov start +rds_input <- function(obj, + nm) { + + if (is(obj, "DeeDeeObject")) { + obj <- obj@DeeDeeList + } + if (is(obj, "DESeqResults")) { + ###### to-replace ####### obj <- DeeDeeLegacy::deedee_prepare(obj, "DESeq2") + obj <- list(obj) + names(obj) <- unlist(strsplit(nm, + split = ".", + fixed = TRUE + ))[1] + } else if (is(obj, "DGEExact")) { + ###### to-replace ####### obj <- DeeDeeLegacy::deedee_prepare(obj, "edgeR") + obj <- list(obj) + names(obj) <- unlist(strsplit(nm, + split = ".", + fixed = TRUE + ))[1] + } else if (is(obj, "list")) { + for (j in length(obj)) { + if (checkmate::test_subset( + names(obj[[j]]), + c("logFC", "pval") + ) == FALSE) { + return(NULL) + } + } + } else if (is(obj, "data.frame")) { + if (length(obj) == 2) { + if (checkmate::test_subset( + names(obj), + c("logFC", "pval") + ) == FALSE) { + return(NULL) + } + obj <- list(obj) + names(obj) <- unlist(strsplit(nm, + split = ".", + fixed = TRUE + ))[1] + } else if (length(obj) == 6) { + if (checkmate::test_subset(names(obj), c( + "logFC", + "AveExpr", + "t", + "P.Value", + "adj.P.Val", + "B" + )) == FALSE) { + return(NULL) + } + ###### to-replace ####### obj <- DeeDeeLegacy::deedee_prepare(obj, "limma") + obj <- list(obj) + names(obj) <- unlist(strsplit(nm, + split = ".", + fixed = TRUE + ))[1] + } else { + return(NULL) + } + } + + return(obj) +} + + +xlsx_input <- function(obj, + path, + nm) { + + if (length(obj) > 1) { + out <- lapply(obj, + readxl::read_excel, + path = path + ) + names(out) <- obj + for (j in seq_len(length(obj))) { + out[[obj[j]]] <- as.data.frame(out[[obj[j]]]) + out[[obj[j]]] <- tibble::column_to_rownames( + out[[obj[j]]], "rowname" + ) + if (checkmate::test_subset( + names(out[[j]]) == FALSE, + c("logFC", "pval") + )) { + return(NULL) + } + } + } else { + out <- readxl::read_excel(path = path) + out <- tibble::column_to_rownames(out, "rowname") + out <- list(out) + names(out) <- unlist(strsplit(nm, + split = ".", + fixed = TRUE + ))[1] + } + return(out) +} + + + + + +ora <- function(geneList, + universe, + orgDB, + key_type) { + + # ---------------------------- data preparation ----------------------------- + genes <- geneList[1] + genes <- row.names(genes) + genes <- genes[!is.na(genes)] + + universe[[1]] <- tibble::rownames_to_column(universe[[1]]) + universe[[2]] <- tibble::rownames_to_column(universe[[2]]) + univ <- dplyr::inner_join(universe[[1]], universe[[2]], by = "rowname") + univ <- univ[["rowname"]] + + # ---------------------------------- GSEA ----------------------------------- + res <- clusterProfiler::enrichGO( + gene = genes, + universe = univ, + OrgDb = get(orgDB), + ont = "BP", + keyType = key_type, + pAdjustMethod = "BH", + pvalueCutoff = 0.01, + qvalueCutoff = 0.05, + readable = TRUE + ) + + # --------------------------------- return ---------------------------------- + return(res) +} + + + +input_infobox <- function(deedee_obj, + sets, + md) { + + ext <- c() + filename <- c() + res <- list() + type <- c() + contrast <- c() + genes <- c() + count <- 0 + + if (!is.null(deedee_obj)) { + for (j in seq_len(length(deedee_obj@DeeDeeList))) { + count <- count + 1 + type[count] <- "DeeDee object" + filename[count] <- "input as argument" + contrast[count] <- names(deedee_obj@DeeDeeList)[j] + genes[count] <- length(deedee_obj@DeeDeeList[j] + [[contrast[count]]][["logFC"]]) + } + } + + # reading out input files + if (length(sets[, 1] > 0)) { + for (i in seq_len((length(sets[, 1])))) { + ext[i] <- tools::file_ext(sets[i, "datapath"]) + + if (ext[[i]] == "rds" || ext[[i]] == "RDS") { + res[[i]] <- readRDS(sets[[i, "datapath"]]) + } else if (ext[[i]] == "xlsx") { + sheets <- readxl::excel_sheets(sets[[i, "datapath"]]) + res[[i]] <- lapply(sheets, + readxl::read_excel, + path = sets[[i, "datapath"]] + ) + names(res[[i]]) <- sheets + for (j in seq_len(length(sheets))) { + res[[i]][[sheets[j]]] <- as.data.frame(res[[i]][[sheets[j]]]) + res[[i]][[sheets[j]]] <- tibble::column_to_rownames( + res[[i]][[sheets[j]]], "rowname" + ) + } + } else if (ext[[i]] == "txt") { + temp <- utils::read.table(sets[[i, "datapath"]]) + res[[i]] <- list(temp) + names(res[[i]]) <- unlist(strsplit(sets[i, "name"], + split = ".", + fixed = TRUE + ))[1] + } + + if (is(res[[i]], "DESeqResults") || + is(res[[i]], "DGEExact") || + length(names(res[[i]])) == 6 || + is(res[[i]], "DeeDeeObject")) { + count <- count + 1 + type[count] <- class(res[[i]]) + filename[count] <- sets[i, "name"] + contrast[count] <- unlist(strsplit(filename[count], + split = ".", + fixed = TRUE + ))[1] + genes[count] <- length(md@DeeDeeList + [[contrast[count]]][["logFC"]]) + } else { + if (is.data.frame(res[[i]])) { + res[[i]] <- list(res[[i]]) + names(res[[i]]) <- unlist(strsplit(sets[i, "name"], + split = ".", + fixed = TRUE + ))[1] + } + for (j in seq_len(length(res[[i]]))) { + count <- count + 1 + type[count] <- "DeeDee object" + filename[count] <- sets[i, "name"] + contrast[count] <- names(res[[i]])[j] + genes[count] <- length(res[[i]][j] + [[contrast[count]]][["logFC"]]) + } + } + } + } + + df <- data.frame(filename, type, contrast, genes) + return(df) +} +# nocov end diff --git a/R/deedee-data.R b/R/DeeDee-data.R similarity index 78% rename from R/deedee-data.R rename to R/DeeDee-data.R index 3e28001..7efae2f 100644 --- a/R/deedee-data.R +++ b/R/DeeDee-data.R @@ -10,6 +10,8 @@ #' The code to create said object can be found in the folder `/inst/scripts` in #' the DeeDee package, the file is called `generate_data.R`. #' +#' @return A sample `DESeqResults` object, generated with `DESeq2` +#' #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene #' expression indicate a role for enhancer priming in immune response", #' Nature Genetics, January 2018 doi: 10.1038/s41588-018-0046-7. @@ -31,6 +33,8 @@ NULL #' The code to create said object can be found in the folder `/inst/scripts` in #' the DeeDee package, the file is called `generate_data.R`. #' +#' @return A sample `DESeqResults` object, generated with `DESeq2` +#' #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene #' expression indicate a role for enhancer priming in immune response", #' Nature Genetics, January 2018 doi: 10.1038/s41588-018-0046-7. @@ -52,6 +56,8 @@ NULL #' The code to create said object can be found in the folder `/inst/scripts` in #' the DeeDee package, the file is called `generate_data.R`. #' +#' @return A sample `DESeqResults` object, generated with `DESeq2` +#' #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene #' expression indicate a role for enhancer priming in immune response", #' Nature Genetics, January 2018 doi: 10.1038/s41588-018-0046-7. @@ -74,6 +80,8 @@ NULL #' The code to create said object can be found in the folder `/inst/scripts` in #' the DeeDee package, the file is called `generate_data.R`. #' +#' @return A sample `DESeqResults` object, generated with `DESeq2` +#' #' @references Alasoo, et al. "Shared genetic effects on chromatin and gene #' expression indicate a role for enhancer priming in immune response", #' Nature Genetics, January 2018 doi: 10.1038/s41588-018-0046-7. @@ -81,3 +89,33 @@ NULL #' @name Salm_both #' @docType data NULL + + + + +#' dd_list_original +#' +#' A list of `deedee_prepare`d DE results. +#' +#' @return A list of DE results +#' +#' @details documented creation in ... script +#' +#' @name dd_list_original +#' @docType data +NULL + + + +#' de_named_list +#' +#' A named list of DE results, in their original format (from DESeq2, edgeR or limma) +#' +#' @return A named list of DE results, in their original format +#' +#' @details documented creation in the `create_dataset_example.R` script in the +#' `scripts` package folder +#' +#' @name de_named_list +#' @docType data +NULL diff --git a/R/deedee-pkg.R b/R/DeeDee-pkg.R similarity index 53% rename from R/deedee-pkg.R rename to R/DeeDee-pkg.R index 69cc19d..8d6e14a 100644 --- a/R/deedee-pkg.R +++ b/R/DeeDee-pkg.R @@ -11,32 +11,48 @@ #' @importFrom AnnotationDbi keytypes #' @importFrom checkmate assert_choice assert_data_frame assert_list assert_logical #' assert_number assert_subset assertChoice assertClass assertDataFrame test_subset +#' @importFrom circlize colorRamp2 #' @importFrom clusterProfiler enrichGO -#' @importFrom ComplexHeatmap draw Heatmap +#' @importFrom ComplexHeatmap draw Heatmap rowAnnotation #' @importFrom ComplexUpset intersection_size upset -#' @importFrom DESeq2 results DESeq +#' @importFrom DESeq2 results DESeq vst #' @importFrom dplyr bind_rows full_join inner_join +#' @importFrom edgeR topTags #' @importFrom enrichplot emapplot pairwise_termsim -#' @importFrom ggplot2 aes annotate coord_cartesian geom_line geom_point ggplot labs -#' scale_fill_manual theme_light xlab ylab +#' @importFrom ggplot2 aes annotate coord_cartesian geom_bar geom_line geom_point +#' geom_text ggplot labs position_dodge scale_fill_manual theme_bw theme_light +#' xlab ylab ggplot_build #' @importFrom ggvenn ggvenn #' @importFrom InteractiveComplexHeatmap makeInteractiveComplexHeatmap +#' InteractiveComplexHeatmapOutput +#' @importFrom limma topTable #' @importFrom writexl write_xlsx #' @importFrom readxl excel_sheets read_excel +#' @importFrom rlang .data +#' @importFrom rmarkdown render +#' @importFrom rvest html_node #' @importFrom shiny actionButton brushedPoints brushOpts checkboxGroupInput -#' checkboxInput column conditionalPanel downloadButton downloadHandler -#' fileInput fluidRow includeMarkdown navbarPage need numericInput -#' observeEvent plotOutput reactive reactiveValues renderPlot renderTable -#' renderText renderUI req selectInput shinyApp tableOutput tabPanel -#' textOutput uiOutput validate +#' checkboxInput column conditionalPanel downloadButton downloadHandler fileInput +#' fluidPage fluidRow HTML includeHTML includeMarkdown isTruthy navbarPage need +#' numericInput observeEvent plotOutput reactive reactiveValues removeNotification +#' renderPlot renderPrint renderTable renderText renderUI req selectInput +#' shinyApp showNotification tableOutput tabPanel tagList tags textOutput +#' uiOutput validate verbatimTextOutput +#' @importFrom shinydashboard tabBox #' @importFrom shinyBS bsCollapse bsCollapsePanel bsModal #' @importFrom shinycssloaders withSpinner #' @importFrom shinythemes shinytheme -#' @importFrom stats approx complete.cases +#' @importFrom stats approx complete.cases na.omit +#' @importClassesFrom SummarizedExperiment RangedSummarizedExperiment +#' @importFrom S4Vectors metadata metadata<- DataFrame SimpleList +#' @importFrom SummarizedExperiment rowData rowData<- mcols assays +#' rowData rowData<- SummarizedExperiment #' @importFrom tibble column_to_rownames rownames_to_column #' @importFrom tools file_ext -#' @importFrom utils read.table +#' @importFrom utils read.table data packageVersion browseURL #' @importFrom viridis scale_color_viridis viridis +#' @importFrom xml2 read_html write_html +#' @importFrom methods show as callNextMethod is new validObject #' #' @name DeeDee-pkg #' @docType package diff --git a/R/DeeDeeExperiment-methods.R b/R/DeeDeeExperiment-methods.R new file mode 100644 index 0000000..e7115cf --- /dev/null +++ b/R/DeeDeeExperiment-methods.R @@ -0,0 +1,263 @@ +#' @name DeeDeeExperiment-methods +#' +#' @title Methods for [DeeDeeExperiment] objects +#' +#' @aliases +#' dea +#' dea<- +#' add_dea +#' remove_dea +#' get_dea_df +#' get_dea_list +#' +#' @description +#' The [DeeDeeExperiment()] class provides a family of methods to get +#' and set DE-related information in [DeeDeeExperiment] objects. +#' +#' @param x A [DeeDeeExperiment()] object +#' @param value Replacement value for replacement methods. +#' @param dea A named list of DE results, in any of the formats supported by +#' the `DeeDee` package (currently: results from DESeq2, edgeR, limma). +#' @param dea_name Character value, specifying the name of the DE analysis to +#' get or remove +#' +#' @return Return value varies depending on the individual methods, as described +#' below. +#' +#' @details +#' * `dea` and `dea<-` are the methods to get and set the `dea` information as a +#' whole. These methods return `DeeDeeExperiment` objects. +#' * `add_dea` and `remove_dea` are used to respectively add or remove DE-results +#' items. These methods also return `DeeDeeExperiment` objects, with updated +#' content in the `dea` slot. +#' * `get_dea_df` and `get_dea_list` retrieve the `dea` information and provide +#' this as a `DataFrame` object (for a specific analysis) or as a list, with one +#' element for each reported analysis. +#' * `show` is the method to nicely print out the information of a `DeeDeeExperiment` +#' object. +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' +#' # creating a `DeeDeeExperiment` +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' new_del <- list( +#' ifng2 = de_named_list$ifng_vs_naive, +#' ifngsalmo2 = de_named_list$ifngsalmo_vs_naive +#' ) +#' +#' # add a new (set of) DE result(s) +#' dde_new <- add_dea(dde, new_del) +#' dde_new +#' +#' # removing DEAs +#' dde_removed <- remove_dea(dde, "ifng_vs_naive") +#' dde_removed +NULL + + +# dea slot - get & set --------------------------------------------------------- + +#' @rdname DeeDeeExperiment-methods +#' @export +setMethod("dea", + signature = "DeeDeeExperiment", + definition = function(x) { + x@dea + }) + + +#' @rdname DeeDeeExperiment-methods +#' @export +setReplaceMethod("dea", + c("DeeDeeExperiment", "list"), + definition = function(x, value) { + x@dea <- value + validObject(x) + x + }) + + +# dea info - add, remove, get -------------------------------------------------- + +#' @rdname DeeDeeExperiment-methods +#' @export +setMethod("add_dea", + signature = c("DeeDeeExperiment", "list"), + definition = function(x, dea) { + # dde must be a DeeDeeExp + # dea must be named list + + # check that names are all unique, and do not overlap with the existing ones + names(dea) + names(dea(x)) + + dea_contrasts <- dea(x) + dde_ids <- rownames(x) + + # update rowData, naming them correctly + for (i in names(dea)){ + this_de <- dea[[i]] + + # do different things according to what these objects are + if(is(this_de, "DESeqResults")) { + matched_ids <- match(rownames(x), dde_ids) + + # if not tested, add NA - everywhere? -> pre-fill? + rowData(x)[[paste0(i,"_log2FoldChange")]] <- NA + rowData(x)[[paste0(i,"_pvalue")]] <- NA + rowData(x)[[paste0(i,"_padj")]] <- NA + + rowData(x)[[paste0(i,"_log2FoldChange")]][matched_ids] <- this_de$log2FoldChange + rowData(x)[[paste0(i,"_pvalue")]][matched_ids] <- this_de$pvalue + rowData(x)[[paste0(i,"_padj")]][matched_ids] <- this_de$padj + + dea_contrasts[[i]] <- list( + alpha = metadata(this_de)$alpha, + lfcThreshold = metadata(this_de)$lfcThreshold, + metainfo_logFC = mcols(this_de)$description[colnames(this_de) == "log2FoldChange"], + metainfo_pvalue = mcols(this_de)$description[colnames(this_de) == "pvalue"], + original_object = this_de, + package = "DESeq2" + ) + } + } + + # update the deslot + dea(x) <- dea_contrasts + + # check here the validity + validObject(x) + + # return the object + return(x) + } +) + +# TODO: might need one where I also simply add ONE single DE object, and that gets autoconverted to a named list (of length 1) + + + +#' @rdname DeeDeeExperiment-methods +#' @export +setMethod("remove_dea", + signature = c("DeeDeeExperiment", "character"), + definition = function(x, dea_name) { + # x must be a DeeDeeExp + + # dea must be char vector + deas <- names(dea(x)) + + deas_to_remove <- intersect(dea_name, deas) + # warning() if nothing to remove + + for (i in deas_to_remove) { + cols_to_remove <- c(paste0(i, c("_log2FoldChange", "_pvalue", "_padj"))) + rowData(x) <- rowData(x)[, !(colnames(rowData(x)) %in% cols_to_remove)] + # update the deslot + dea(x)[[i]] <- NULL + } + + # here check some validity? + validObject(x) + + # return the object + return(x) + } +) + + + + +#' @rdname DeeDeeExperiment-methods +#' @export +setMethod("get_dea_df", + signature = c("DeeDeeExperiment", "character"), + definition = function(x, + dea_name) { + deas <- dea(x) + dea_names <- names(deas) + + if (!(dea_name %in% dea_names)) { + stop("dea not found") + } + + rd_info <- paste0(dea_name, + c("_log2FoldChange", "_pvalue", "_padj")) + + if (! all(rd_info %in% colnames(rowData(x)))) { + stop("Columns not found") + } + + out <- rowData(x)[, rd_info] + + return(out) + } +) + +#' @rdname DeeDeeExperiment-methods +#' @export +setMethod("get_dea_list", + signature = c("DeeDeeExperiment"), + definition = function(x) { + deas <- dea(x) + dea_names <- names(deas) + + dea_list <- list() + + for (i in dea_names) { + dea_list[[i]] <- as.data.frame(get_dea_df(x, i)) + colnames(dea_list[[i]]) <- c("log2FoldChange", "pvalue", "padj") + } + + return(dea_list) + } +) + + + + +# misc - show & more ------------------------------------------------------ + +#' @name DeeDeeExperiment-misc +#' +#' @title Miscellaneous DeeDeeExperiment methods +#' +#' @description +#' Miscellaneous methods for the \code{\link{DeeDeeExperiment}} class and its +#' descendants that do not fit into any other documentation category such as, +#' for example, show methods. +#' +#' @param object a \code{\link{DeeDeeExperiment}} object +#' +#' @return Returns NULL +NULL + + +#' @rdname DeeDeeExperiment-misc +#' @export +setMethod("show", + signature = signature(object = "DeeDeeExperiment"), + definition = function(object) { + + callNextMethod() + cat( + "Including ", length(object@dea), " DE analyses:\n", + paste(names(object@dea), collapse = ", "), + sep="" + ) + }) diff --git a/R/DeeDeeExperiment.R b/R/DeeDeeExperiment.R new file mode 100644 index 0000000..2a54d6b --- /dev/null +++ b/R/DeeDeeExperiment.R @@ -0,0 +1,446 @@ +#' @name DeeDeeExperiment +#' +#' @title The DeeDeeExperiment class +#' +#' @aliases +#' DeeDeeExperiment +#' DeeDeeExperiment-class +#' +#' @description +#' The `DeeDeeExperiment` class is designed to represent +#' It inherits from the SummarizedExperiment class, and additionally stores +#' DE-related information via dedicated slots and `colData`. +#' +#' @param se A `SummarizedExperiment` object, that will be used as a scaffold to +#' store the DE related information. +#' @param de_results A named list of DE results, in any of the formats supported by +#' the `DeeDee` package (currently: results from DESeq2, edgeR, limma). +#' +#' @details +#' The `se` parameter can be optionally left unspecified. If this is the case, +#' the resulting `DeeDeeExperiment` object will contain as features the ones +#' specified by the provided components of the object supplied via the +#' `de_results` parameter. +#' +#' The conversion of the components of the `de_results` list will be handled via +#' conversion functions to uniform the names and set of information which will +#' be stored in the returned `DeeDeeExperiment` object. +#' The names of the list will be used to define the `contrasts` for the different +#' DE analyses included, which will determine the way to access the information +#' stored in the `dea` slot of the `DeeDeeExperiment` object +#' +#' Since a `DeeDeeExperiment` is also a `SummarizedExperiment` object, it can be +#' seamlessly provided downstream for visualization and in-depth exploration to +#' packages such as `iSEE` or similar. +#' +#' @return A `DeeDeeExperiment` object. +#' @export +#' +#' @author Lea Rothörl and Federico Marini +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' +#' dde_onlyde <- DeeDeeExperiment( +#' de_results = de_named_list +#' ) +#' +#' # or, with a SE object as support - even without assay data available +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +DeeDeeExperiment <- function(se = NULL, + de_results = NULL) { + + # old <- S4Vectors:::disableValidity() + # if (!isTRUE(old)) { + # S4Vectors:::disableValidity(TRUE) + # on.exit(S4Vectors:::disableValidity(old)) + # } + + if (!is.null(de_results)) + .check_de_results(de_results) + + # se <- SummarizedExperiment(...) + if(!is.null(se)) { + if (!is(se, "RangedSummarizedExperiment")) { + if (is(se, "SummarizedExperiment")) { + se <- as(se, "RangedSummarizedExperiment") + } else { + stop("'se' must be a RangedSummarizedExperiment object") + } + } + } else { + if(is.null(de_results)) + stop("You have to provide at least an se object or a de_results object") + + message("creating a mock SE from the rows of the DE result objects") + # mock up the se from the de_results + first_de <- de_results[[1]] + + # independently of the class, the feature names are in the + # rownames slot, TODO: check + ids <- rownames(first_de) + + rd_mock <- DataFrame( + gene_id = ids, + row.names = ids) + + # way1 + se_mock <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_mock + ) + # se_mock@NAMES <- NULL + # rownames(se_mock) <- ids + + # no clue why this is strictly needed, but still it seems it is, if mocking up + se <- as(se_mock, "RangedSummarizedExperiment") + } + + # TODO: if no SE is really provided, instantiate some rownames, at least directly + # from the rownames of the result objects + # TODO: the row names are taken from the FIRST object in the de results then - or + # from the union of all of them? + + if (is.null(de_results)) { + object <- new("DeeDeeExperiment", + se, + dea = list() + ) + + # stash the package version + metadata(object)[["version"]] <- packageVersion("DeeDee") + + return(object) + } + + # TODO: does not have to relate to an SE which has all the slots and all + # ... + + + # TODO: additional checks + se_out <- se + + # here is where I add the names in the rowData to make all info matched + # checks on the names + names(de_results) + # if not there, "force add" + # TODO + + dde_ids <- rownames(se_out) + + dea_contrasts <- list() + + for (i in names(de_results)){ + this_de <- de_results[[i]] + + # do different things according to what these objects are + if(is(this_de, "DESeqResults")) { + + + input_deseq2 <- .importDE_DESeq2(se_out, this_de, i) + se_out <- input_deseq2$se + dea_contrasts[[i]] <- input_deseq2$dea_contrast + + # matched_ids <- match(rownames(se_out), rownames(this_de)) + # + # # if not tested, add NA - everywhere? -> pre-fill? + # rowData(se_out)[[paste0(i,"_log2FoldChange")]] <- NA + # rowData(se_out)[[paste0(i,"_pvalue")]] <- NA + # rowData(se_out)[[paste0(i,"_padj")]] <- NA + # + # rowData(se_out)[[paste0(i,"_log2FoldChange")]][matched_ids] <- this_de$log2FoldChange + # rowData(se_out)[[paste0(i,"_pvalue")]][matched_ids] <- this_de$pvalue + # rowData(se_out)[[paste0(i,"_padj")]][matched_ids] <- this_de$padj + # + # dea_contrasts[[i]] <- list( + # alpha = metadata(this_de)$alpha, + # lfcThreshold = metadata(this_de)$lfcThreshold, + # metainfo_logFC = mcols(this_de)$description[colnames(this_de) == "log2FoldChange"], + # metainfo_pvalue = mcols(this_de)$description[colnames(this_de) == "pvalue"], + # original_object = this_de, + # package = "DESeq2" + # ) is(res_de, "DGEExact") | is(res_de, "DGELRT") + } else if (is(this_de, "DGEExact") | is(this_de, "DGELRT")) { + input_edgeR <- .importDE_edgeR(se_out, this_de, i) + se_out <- input_edgeR$se + dea_contrasts[[i]] <- input_edgeR$dea_contrast + } else if (is(this_de, "MArrayLM")) { + input_limma <- .importDE_limma(se_out, this_de, i) + se_out <- input_limma$se + dea_contrasts[[i]] <- input_limma$dea_contrast + } + } + + # rowData(dde)[["new_rd"]] <- de_name + + object <- new("DeeDeeExperiment", + se_out, + dea = dea_contrasts + ) + + # stash the package version + metadata(object)[["version"]] <- packageVersion("DeeDee") + + return(object) +} + + + + + +# extends the rowData slot of the provided SE and returns also metadata + +#' Import from `DESeq2` DE results +#' +#' @param se A `SummarizedExperiment` object +#' @param res_de A set of DE results, provided as `DESeqResults` as in the `DESeq2` +#' framework +#' @param de_name A character value, describing the contrast of interest. Will be +#' used to compose the column names in the `rowData` slot. +#' +#' @return A list, containing the updated `SummarizedExperiment` object, and the +#' standardized information on the DE analysis, as these are to be used in the +#' `DeeDee` framework. +#' +#' @noRd +#' +#' @examples +#' # TODO example +.importDE_DESeq2 <- function(se, res_de, de_name) { + # checks TODO: + # correct object format + stopifnot( + is(res_de, "DESeqResults") + ) + # contain the right columns + stopifnot( + all(c("log2FoldChange", "pvalue", "padj") %in% colnames(res_de)) + ) + + # contain the feature ids + + # p value different from NA respect the 0-1 interval + stopifnot( + all(na.omit(res_de$pvalue <= 1)) & all(na.omit(res_de$pvalue > 0)) + ) + + + matched_ids <- match(rownames(res_de), rownames(se)) + + # if not tested, add NA - everywhere? -> pre-fill? + rowData(se)[[paste0(de_name,"_log2FoldChange")]] <- NA + rowData(se)[[paste0(de_name,"_pvalue")]] <- NA + rowData(se)[[paste0(de_name,"_padj")]] <- NA + + rowData(se)[[paste0(de_name,"_log2FoldChange")]][matched_ids] <- res_de$log2FoldChange + rowData(se)[[paste0(de_name,"_pvalue")]][matched_ids] <- res_de$pvalue + rowData(se)[[paste0(de_name,"_padj")]][matched_ids] <- res_de$padj + + dea_contrast <- list( + alpha = metadata(res_de)$alpha, + lfcThreshold = metadata(res_de)$lfcThreshold, + metainfo_logFC = mcols(res_de)$description[colnames(res_de) == "log2FoldChange"], + metainfo_pvalue = mcols(res_de)$description[colnames(res_de) == "pvalue"], + original_object = res_de, + # object_name = deparse(substitute(res_de)), + package = "DESeq2" + ) + + return( + list( + se = se, + dea_contrast = dea_contrast + ) + ) +} + + +#' Import from edgeR DE results +#' +#' @param se A SummarizedExperiment object +#' @param res_de A set of DE results, provided by the `edgeR` framework (either a +#' `DGEExact` or a `DGELRT` object). +#' @param de_name A character value, describing the contrast of interest. Will be +#' used to compose the column names in the rowData slot. +#' +#' @return A list, containing the updated SummarizedExperiment object, and the +#' standardized information on the DE analysis, as these are to be used in the +#' DeeDee framework. +#' +#' @noRd +#' +#' @examples +#' # TODO example +.importDE_edgeR <- function(se, res_de, de_name) { + # checks object + stopifnot( + is(res_de, "DGEExact") | is(res_de, "DGELRT") + ) + + # extract columns + res_tbl <- topTags(res_de, n = nrow(res_de), sort.by = "none") + + + matched_ids <- match(rownames(res_tbl), rownames(se)) + + # if not tested, add NA - everywhere? -> pre-fill? + rowData(se)[[paste0(de_name,"_log2FoldChange")]] <- NA + rowData(se)[[paste0(de_name,"_pvalue")]] <- NA + rowData(se)[[paste0(de_name,"_padj")]] <- NA + + rowData(se)[[paste0(de_name,"_log2FoldChange")]][matched_ids] <- res_tbl$table$logFC + rowData(se)[[paste0(de_name,"_pvalue")]][matched_ids] <- res_tbl$table$PValue + rowData(se)[[paste0(de_name,"_padj")]][matched_ids] <- res_tbl$table$FDR + + dea_contrast <- list( + alpha = NA, + lfcThreshold = NA, + metainfo_logFC = res_tbl$comparison, + metainfo_pvalue = NA, + original_object = res_de, + # object_name = deparse(substitute(res_tbl)), + package = "edgeR" + ) + + return( + list( + se = se, + dea_contrast = dea_contrast + ) + ) +} + + + +#' Import from `limma` DE results +#' +#' @param se A `SummarizedExperiment` object +#' @param res_de A set of DE results, provided in the `limma` framework (a `MArrayLM` +#' object). +#' @param de_name A character value, describing the contrast of interest. Will be +#' used to compose the column names in the `rowData` slot. +#' +#' @return A list, containing the updated `SummarizedExperiment` object, and the +#' standardized information on the DE analysis, as these are to be used in the +#' `DeeDee` framework. +#' +#' @noRd +#' +#' @examples +#' # TODO example +#' # ... limma_de <- lmFit +#' # will provide the outout of lmFit - see its examples +.importDE_limma <- function(se, res_de, de_name) { + # checks object + stopifnot(is(res_de, "MArrayLM")) + + # extract columns + res_tbl <- topTable(res_de, + coef = 2, + number = nrow(res_de), + sort.by = "none") + + + matched_ids <- match(rownames(res_tbl), rownames(se)) + + # if not tested, add NA - everywhere? -> pre-fill? + rowData(se)[[paste0(de_name,"_log2FoldChange")]] <- NA + rowData(se)[[paste0(de_name,"_pvalue")]] <- NA + rowData(se)[[paste0(de_name,"_padj")]] <- NA + + rowData(se)[[paste0(de_name,"_log2FoldChange")]][matched_ids] <- res_tbl$logFC + rowData(se)[[paste0(de_name,"_pvalue")]][matched_ids] <- res_tbl$P.Value + rowData(se)[[paste0(de_name,"_padj")]][matched_ids] <- res_tbl$adj.P.Val + + dea_contrast <- list( + alpha = NA, + lfcThreshold = NA, + metainfo_logFC = res_tbl$comparison, + metainfo_pvalue = NA, + original_object = res_de, + # object_name = deparse(substitute(res_tbl)), + package = "limma" + ) + + return( + list( + se = se, + dea_contrast = dea_contrast + ) + ) + + + # returns info (in the standardized manner) + +} + + +.importDE_custom <- function(x) { + +} + + + +.check_de_results <- function(x) { + # checks that: + # it is a list + # its component are either of the expected/accepted elements + # checks their columns? + + stopifnot(is.list(x)) + stopifnot(length(x) > 0) + + ok_types <- unlist(lapply(x, function(arg) { + is(arg, "DESeqResults") | is(arg, "DGEExact") | is(arg, "DGELRT") | is(arg, "MArrayLM") + })) + + stopifnot(all(ok_types)) + + return(TRUE) +} + + +deedee_import <- function(x) { + + # legacy code: + + # # ----------------------------- argument check ------------------------------ + # choices <- c("DESeq2", "edgeR", "limma") + # checkmate::assertChoice(input_type, choices) + # + # if (input_type == "DESeq2") { + # checkmate::assertClass(data, "DESeqResults") + # logFC <- data$log2FoldChange + # pval <- data$padj + # input <- data.frame(logFC, pval) + # rownames(input) <- data@rownames + # } else if (input_type == "edgeR") { + # checkmate::assertClass(data, "DGEExact") + # logFC <- data[["table"]][["logFC"]] + # pval <- data[["table"]][["PValue"]] + # input <- data.frame(logFC, pval) + # rownames(input) <- data[["genes"]][["genes"]] + # } else if (input_type == "limma") { + # checkmate::assertDataFrame(data, types = "numeric") + # logFC <- data$logFC + # pval <- data$adj.P.Val + # input <- data.frame(logFC, pval) + # rownames(input) <- rownames(data) + # } + # return(input) +} + + diff --git a/R/DeeDeeObject.R b/R/DeeDeeObject.R deleted file mode 100644 index f4c733b..0000000 --- a/R/DeeDeeObject.R +++ /dev/null @@ -1,68 +0,0 @@ -#' DeeDeeObject (S4 class) -#' -#' @slot DeeDeeList -#' -#' @description DeeDeeObject is the format that the DeeDee App works on. It -#' holds a slot for your list of DeeDee tables. More functionality -#' to come. -#' @export -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' # obj <- DeeDeeObject(DeeDeeList = dd_list) -#' - -DeeDeeObject <- setClass( - - "DeeDeeObject", - slots = c( - DeeDeeList = "list" - ), - prototype = list( - DeeDeeList = NULL - ), - validity = function(object) { - res <- object@DeeDeeList - if (class(res) != "list") { - return("DeeDeeList must be a list of DeeDee data.frames.") - } - for (i in 1:length(res)) { - if (class(res[[i]]) != "data.frame") { - return("DeeDeeList must be a list of DeeDee data.frames.") - } - if (checkmate::test_subset(names(res[[i]]), c("logFC", "pval")) == FALSE) { - return("DeeDeeList must be a list of DeeDee data.frames.") - } - if (class(res[[i]]$logFC) != "numeric") { - return("LogFC values must be a vector of type 'numeric'.") - } - if (class(res[[i]]$pval) != "numeric") { - return("P-values must be a vector of type 'numeric'.") - } - if (max(res[[i]]$pval) > 1) { - return("A p-value cannot be greater than 1.") - } - if (min(res[[i]]$pval) < 0) { - return("A p-value cannot be lower than 0.") - } - } - return(TRUE) - } -) diff --git a/R/DeeDee_bars.R b/R/DeeDee_bars.R new file mode 100644 index 0000000..de28e20 --- /dev/null +++ b/R/DeeDee_bars.R @@ -0,0 +1,81 @@ +#' Title +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param p_thresh Numeric value, corresponding to the threshold used to call a +#' feature as differentially expressed. +#' @param show_DEnumbers Logical value; +#' +#' @return A `ggplot` plot object, summarizing the amount of DE genes in each +#' comparison performed. +#' +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library(SummarizedExperiment) +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_bars(dde) +deedee_bars <- function(dde, + p_thresh = 0.05, + show_DEnumbers = TRUE) { + # checks and all + # TODO + + + # extract the summary infos + dea_list <- get_dea_list(dde) + + dea_summary <- lapply(names(dea_list), function(dea) { + this_dea <- dea_list[[dea]] + dea_tally_up <- sum(this_dea$log2FoldChange >= 0 & this_dea$padj <= p_thresh) + dea_tally_down <- sum(this_dea$log2FoldChange <= 0 & this_dea$padj <= p_thresh) + + dea_df <- data.frame( + dea = dea, + direction = c("Up", "Down"), + value = c(dea_tally_up, dea_tally_down) + ) + }) |> bind_rows() + dea_summary$direction <- factor(dea_summary$direction, levels = c("Up", "Down")) + + res <- ggplot(dea_summary, + aes(x = .data$dea, + y = .data$value, + fill = .data$direction)) + + geom_bar(position = "dodge", + stat="identity") + + scale_fill_manual(values = c("#D62728FF", "#1F77B4FF")) + + labs(x = "", + y = "Number of DE genes", + fill = "Direction of\nregulation", + title = "DeeDeeExperiment summary", + subtitle = paste0("Including ", length(dea(dde)), " DE analyses") + ) + + theme_bw() + + if (show_DEnumbers) { + res <- res + + geom_text( + aes(label = .data$value), + vjust = -0.7, position = position_dodge(width = 0.9) + ) + } + + # alternatively: return the df itself + + return(res) +} + diff --git a/R/DeeDee_cat.R b/R/DeeDee_cat.R new file mode 100644 index 0000000..b9dfdc0 --- /dev/null +++ b/R/DeeDee_cat.R @@ -0,0 +1,133 @@ +#' deedee_cat +#' +#' CAT plot - Concordance At the Top +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param ref A numeric value, corresponding to the order of the element in the +#' `dde` object to be used as a reference. +#' @param maxrank A numeric value. Indicates the maximum ranked feature to +#' include when computing the Concordance At the Top. Defaults to 1000. +#' @param mode A character value, could be one of "up", "down", or "both". Defines +#' which features to include in the computations. Defaults to "up". +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. Defaults sensibly to 0.05. +#' +#' @return A `ggplot` plot object. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_cat(dde, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) +#' +deedee_cat <- function(dde, + ref = 1, + maxrank = 1000, + mode = "up", + pthresh = 0.05) { + + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(ref) | !(ref > 0 & ref <= length(dea(dde)))) + stop("Please specify a valid entry to use as reference") + + if (!is.numeric(maxrank) | !(maxrank > 1)) + stop("Please specify a positive integer (larger than 1) for the maximum rank") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + mode <- match.arg(mode, c("up", "down", "both")) + + + dea_list <- get_dea_list(dde) + + for (i in seq_along(dea_list)) { + dea_list[i][[1]] <- subset( + dea_list[i][[1]], + dea_list[i][[1]]$padj < pthresh + ) + + if (length(dea_list[i][[1]][[1]]) == 0) { + return(NULL) + } + + dea_list[i][[1]] <- dea_list[i][[1]]["log2FoldChange"] # remove p-value column + colnames(dea_list[i][[1]]) <- c(paste("log2FoldChange", i, sep = "")) + dea_list[i][[1]] <- as.matrix(dea_list[i][[1]]) # conversion to matrix + names <- rownames(dea_list[i][[1]]) + dea_list[i][[1]] <- as.vector(dea_list[i][[1]]) # conversion to vector + names(dea_list[i][[1]]) <- names + if (mode == "up") { + dea_list[i][[1]] <- sort(dea_list[i][[1]], decreasing = TRUE) + } else if (mode == "down") { + dea_list[i][[1]] <- sort(dea_list[i][[1]], decreasing = FALSE) + } else if (mode == "both") { + dea_list[i][[1]] <- abs(dea_list[i][[1]]) + dea_list[i][[1]] <- sort(dea_list[i][[1]], decreasing = TRUE) + } + + dea_list[i][[1]] <- names(dea_list[i][[1]]) + } + + output <- list() + nm <- c() + + for (i in seq_len(length(dea_list))) { + if (i != ref) { + output[[i]] <- data.frame( + rank = seq_len(min(maxrank, length(dea_list[i][[1]]))), + concordance = NA + ) + + for (j in seq_len(nrow(output[[i]]))) { + intsec <- intersect( + dea_list[ref][[1]][seq_len(j)], + dea_list[i][[1]][seq_len(j)] + ) + output[[i]][[j, "concordance"]] <- length(intsec) / j + } + nm[[i]] <- names(dea_list[i]) + } + } + + names(output) <- nm + + out_aggr <- dplyr::bind_rows(output, .id = "contrast") + + res <- ggplot2::ggplot( + out_aggr, + ggplot2::aes(.data$rank, .data$concordance, colour = .data$contrast) + ) + + ggplot2::geom_line() + + ggplot2::theme_light() + + viridis::scale_color_viridis( + option = "magma", discrete = TRUE, + begin = 0, end = 0.9 + ) + + ggplot2::annotate("text", + label = paste("reference: ", + names(dea_list)[ref], + sep = "" + ), + x = maxrank * 0.8, + y = max(out_aggr[["concordance"]]) * 1.1 + ) + + return(res) +} diff --git a/R/DeeDee_heatmap.R b/R/DeeDee_heatmap.R new file mode 100644 index 0000000..3895f30 --- /dev/null +++ b/R/DeeDee_heatmap.R @@ -0,0 +1,233 @@ +#' deedee_heatmap +#' +#' Construct a logFC heatmap on a subset of features +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param show_first Numeric value, specifying the number of features to include. +#' The ranking is done according to ... TODO +#' @param show_gene_names Logical value, whether to display the gene names on the +#' heatmap's side. +#' @param dist Character value, specifying the distance type to use in the call +#' to `ComplexHeatmap`. Accordingly, it can be a pre-defined character +#' ("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", +#' "pearson", "spearman", "kendall"). +#' @param clust Character value. Defines the method to perform hierarchical +#' clustering, passed to `hclust`, as used in `ComplexHeatmap`. +#' @param show_na Logical value, whether to include features that have `NA` value +#' for the log fold change. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A plot object generated via the `ComplexHeatmap` package. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_heatmap(dde, +#' pthresh = 0.05, show_first = 25, +#' show_gene_names = FALSE, dist = "euclidean", +#' clust = "average", show_na = FALSE +#' ) +#' +deedee_heatmap <- function(dde, + show_first = 25, + show_gene_names = FALSE, + dist = "euclidean", + clust = "average", + show_na = FALSE, + pthresh = 0.05) { + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(show_first) | !(show_first > 0)) + stop("Please specify a positive integer for the show_first parameter") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + stopifnot(is.logical(show_gene_names)) + stopifnot(is.logical(show_na)) + + stopifnot(is.character(dist)) + stopifnot(is.character(clust)) + + + dea_list <- get_dea_list(dde) + # and then proceed as for the old implementation + + for (i in seq_len(length(dea_list))) { + dea_list[[i]] <- subset(dea_list[[i]], dea_list[[i]]$padj < pthresh) # pthresh + dea_list[[i]] <- dea_list[[i]]["log2FoldChange"] # removing p-value column + colnames(dea_list[[i]]) <- names(dea_list)[[i]] # creating unique colnames + dea_list[[i]] <- tibble::rownames_to_column(dea_list[[i]]) + } + + comp <- dplyr::full_join(dea_list[[1]], + dea_list[[2]], + by = "rowname", + copy = FALSE + ) + if (length(dea_list) > 2) { + for (i in 3:length(dea_list)) { + comp <- dplyr::full_join(comp, dea_list[[i]], by = "rowname", copy = FALSE) + } + } + + + row.names(comp) <- comp$rowname + + # comp <- subset(comp, select = -c(rowname)) # removing column with rownames + comp <- comp[, !(names(comp) %in% "rowname")] + + comp <- comp[rowSums(!is.na(comp)) >= floor(length(comp) / 2) + 1, ] + if (show_na == FALSE) { + comp <- comp[stats::complete.cases(comp[colnames(comp)]), ] + } + comp <- as.matrix(comp) + + if (length(comp[, 1]) == 0) { + return(NULL) + } + + if (show_gene_names == FALSE) { + rownames(comp) <- c() + } + + col <- viridis::viridis(n = 15, option = "magma") + + res <- ComplexHeatmap::Heatmap( + comp[seq_len(min(show_first, length(comp[, 1]))), ], + name = "logFC", + col = col, + clustering_distance_rows = dist, + clustering_method_rows = clust + ) + + # ComplexHeatmap::draw(res) + + return(res) + +} + + + +#' deedee_heatmap(dd_list_original, +#' pthresh = 0.05, show_first = 25, +#' show_gene_names = FALSE, dist = "euclidean", +#' clust = "average", show_na = FALSE +#' ) + +# deedee_heatmap(dde = dde, +# pthresh = 0.05, show_first = 25, +# show_gene_names = FALSE, dist = "euclidean", +# clust = "average", show_na = FALSE +# ) +# +# deedee_heatmap(dde = dde, +# pthresh = 0.05, show_first = 25, +# show_gene_names = TRUE, dist = "euclidean", +# clust = "average", show_na = TRUE +# ) +# TODOs: better scale, blue to red +# TODOs: do this by overriding the selection of genes +# TODOs: add option to return the data frame instead of the plotted object + +#' Title +#' +#' @param dde TODO +#' @param assay_name TODO +#' @param pvalue_threshold TODO +#' @param logfc_threshold TODO +#' @param custom_genelist TODO +#' +#' @return TODO +#' @export +#' +#' @examples +#' # TODO +#' NULL ## TODO: this needs to be fully in +deedee_deheat <- function(dde, + assay_name = "vst", + pvalue_threshold = 0.05, + logfc_threshold = 5, + custom_genelist = NULL) { + + # checks: need an assay to plot the expression values + + # extract DE genes in any contrast + dea_list <- get_dea_list(dde) + + dea_features <- lapply(names(dea_list), function(dea) { + this_dea <- dea_list[[dea]] + + this_de_features <- + rownames(this_dea[(abs(this_dea$log2FoldChange) >= logfc_threshold) & + (this_dea$padj <= pvalue_threshold), ]) + }) + names(dea_features) <- names(dea_list) + + # merge them + de_features <- unique(unlist(dea_features)) + + + # also using the custom genelist + if (!is.null(custom_genelist)) { + custom_genelist_present <- intersect(rownames(dde), custom_genelist) + de_features <- unique(c(de_features, custom_genelist_present)) + } + + # prepare annotation columns + logfc_df <- data.frame(matrix(nrow = length(de_features), + ncol = length(dea_list))) + rownames(logfc_df) <- de_features + colnames(logfc_df) <- names(dea_list) + + # matching the logFC info into it + for (i in names(dea_list)) { + this_dea <- dea_list[[i]] + logfc_vector <- this_dea[rownames(logfc_df), ]$log2FoldChange + logfc_df[, i] <- logfc_vector + } + + # annotation for the samples as well? + + # take out a sensible assay - and vst that? + assay_to_use <- assays(dde)[[assay_name]] + assay_to_use <- vst(assay_to_use) + assay_to_use_de <- assay_to_use[de_features , ] + + # TODO if centered? + assay_to_use_de <- assay_to_use_de - rowMeans(assay_to_use_de) + + # create the heatmap itself + # pheatmap(assay_to_use_de, scale = "row", annotation_row = logfc_df) + + max_logfc <- max(abs(logfc_df)) + col_fun <- circlize::colorRamp2(c(-max_logfc, 0, max_logfc), c("blue", "white", "red")) + + col_fun_list <- vector("list", length = length(dea_list)) + names(col_fun_list) <- names(dea_list) + for (i in names(dea_list)) col_fun_list[[i]] <- col_fun + + ha <- Heatmap(assay_to_use_de, + name = "Z-score\nexpression\nvalues", + left_annotation = rowAnnotation(df = logfc_df, col = col_fun_list), + show_row_names = FALSE) + + return(ha) +} diff --git a/R/DeeDee_qq.R b/R/DeeDee_qq.R new file mode 100644 index 0000000..175a9b7 --- /dev/null +++ b/R/DeeDee_qq.R @@ -0,0 +1,140 @@ +#' deedee_qq +#' +#' Q-Q plot for comparing DE analyses +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param select1 Numeric value, corresponding to the order of the element in the +#' `dde` object to be selected first. +#' @param select2 Numeric value, corresponding to the order of the element in the +#' `dde` object to be selected as second. +#' @param color_by Character value, either "pval1" or "pval2" to color the +#' individual points mapping them to the p-value of either DE result set. +#' @param as_line Logical value, whether to plot the Q-Q information as a line - +#' defaults to FALSE. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A `ggplot` plot object. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_qq(dde) +#' +deedee_qq <- function(dde, + select1 = 1, + select2 = 2, + color_by = "pval1", + as_line = FALSE, + pthresh = 0.05) { + + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(select1) | !(select1 > 0 & select1 <= length(dea(dde)))) + stop("Please specify a valid entry to use as 1st selection") + if (!is.numeric(select2) | !(select2 > 0 & select2 <= length(dea(dde)))) + stop("Please specify a valid entry to use as 2nd selection") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + stopifnot(is.logical(as_line)) + + color_by <- match.arg(color_by, c("pval1", "pval2")) + + + dea_list <- get_dea_list(dde) + + data_red <- list(dea_list[[select1]], dea_list[[select2]]) + + for (i in seq_len(length(data_red))) { + colnames(data_red[[i]]) <- c( + paste("log2FoldChange", i, sep = ""), + paste("pval", i, sep = ""), + paste("padj", i, sep = "") + ) + } + + x <- data_red[[1]]$log2FoldChange + y <- data_red[[2]]$log2FoldChange + pval1 <- data_red[[1]]$padj + pval2 <- data_red[[2]]$padj + names(x) <- row.names(data_red[[1]]) + names(y) <- row.names(data_red[[2]]) + + sx_idx <- order(x) + sy_idx <- order(y) + + sx <- x[sx_idx] + sy <- y[sy_idx] + pval1 <- pval1[sx_idx] + pval2 <- pval2[sy_idx] + + lenx <- length(sx) + leny <- length(sy) + + if (leny < lenx) { + sx <- stats::approx(1L:lenx, sx, n = leny)$y + pval1 <- stats::approx(1L:lenx, pval1, n = leny)$y + } + if (leny > lenx) { + sy <- stats::approx(1L:leny, sy, n = lenx)$y + pval2 <- stats::approx(1L:leny, pval2, n = lenx)$y + } + + qq <- data.frame(x = sx, y = sy, pval1 = pval1, pval2 = pval2) + + qq_f <- qq[qq$pval1 <= pthresh | qq$pval2 <= pthresh, ] + + if (length(qq_f[[1]]) == 0 || length(qq_f[[2]]) == 0) { + return(NULL) + } + + if (as_line == FALSE) { + res <- ggplot2::ggplot(qq_f, ggplot2::aes(x, y, col = -log10(get(color_by)))) + + ggplot2::geom_point() + + viridis::scale_color_viridis(option = "magma") + + ggplot2::xlab(names(dea(dde))[select1]) + + ggplot2::ylab(names(dea(dde))[select2]) + + ggplot2::labs(color = paste("-log10(", color_by, ")", sep = "")) + + ggplot2::theme_light() + } else { + res <- ggplot2::ggplot(qq_f, ggplot2::aes(x, y, col = -log10(get(color_by)))) + + ggplot2::geom_line() + + viridis::scale_color_viridis(option = "magma") + + ggplot2::xlab(names(data)[select1]) + + ggplot2::ylab(names(data)[select2]) + + ggplot2::labs(color = paste("-log10(", color_by, ")", sep = "")) + + ggplot2::theme_light() + } + + return(res) +} + +# deedee_qq(dde, +# pthresh = 0.05, +# select = 1, +# select2 = 2, +# color_by = "pval1") + +# compare the outputs + + + + diff --git a/R/DeeDee_qqmult.R b/R/DeeDee_qqmult.R new file mode 100644 index 0000000..a520c68 --- /dev/null +++ b/R/DeeDee_qqmult.R @@ -0,0 +1,84 @@ +#' deedee_qqmult +#' +#' Q-Q plot for multiple comparisons of DE analyses +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param ref A numeric value, corresponding to the order of the element in the +#' `dde` object to be used as a reference. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A `ggplot` plot object. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_qqmult(dde, pthresh = 0.05, ref = 1) +#' +deedee_qqmult <- function(dde, + ref = 1, + pthresh = 0.05) { + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(ref) | !(ref > 0 & ref <= length(dea(dde)))) + stop("Please specify a valid entry to use as reference") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + + dea_list <- get_dea_list(dde) + + output <- list() + nm <- c() + + for (i in seq_len(length(dea_list))) { + if (i != ref) { + output[[i]] <- data.frame( + ggplot2::ggplot_build(deedee_qq( + dde = dde, + select1 = ref, + select2 = i, + as_line = TRUE + ))$plot$data) + + nm[[i]] <- names(dea_list[i]) + } + } + + names(output) <- nm + + res <- ggplot2::ggplot( + dplyr::bind_rows(output, .id = "contrast"), + ggplot2::aes(.data$x, .data$y, colour = .data$contrast) + ) + + ggplot2::xlab(names(dea_list)[ref]) + + ggplot2::ylab("Contrasts") + + ggplot2::geom_line() + + ggplot2::theme_light() + + viridis::scale_color_viridis( + option = "magma", discrete = TRUE, + begin = 0, end = 0.9 + ) + + return(res) +} + + + diff --git a/R/DeeDee_scatter.R b/R/DeeDee_scatter.R new file mode 100644 index 0000000..966e761 --- /dev/null +++ b/R/DeeDee_scatter.R @@ -0,0 +1,124 @@ +#' deedee_scatter +#' +#' Scatter plot for the log fold change in the different DE analyses +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param select1 Numeric value, corresponding to the order of the element in the +#' `dde` object to be selected first. +#' @param select2 Numeric value, corresponding to the order of the element in the +#' `dde` object to be selected as second. +#' @param color_by Character value, either "pval1" or "pval2" to color the +#' individual points mapping them to the p-value of either DE result set. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A `ggplot` plot object. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_scatter(dde, 1, 3, color_by = "pval2") +#' deedee_scatter(dde, 1, 2) +#' deedee_scatter(dde, 1, 4) +#' deedee_scatter(dde, 3, 2) +#' +deedee_scatter <- function(dde, + select1 = 1, + select2 = 2, + color_by = "pval1", + pthresh = 0.05) { + + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(select1) | !(select1 > 0 & select1 <= length(dea(dde)))) + stop("Please specify a valid entry to use as 1st selection") + if (!is.numeric(select2) | !(select2 > 0 & select2 <= length(dea(dde)))) + stop("Please specify a valid entry to use as 2nd selection") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + color_by <- match.arg(color_by, c("pval1", "pval2")) + + + dea_names <- names(dea(dde)) + names1 <- dea_names[select1] + names2 <- dea_names[select2] + + de_1 <- get_dea_df(dde, names1) + de_2 <- get_dea_df(dde, names2) + data_red <- list( + tibble::rownames_to_column(as.data.frame(de_1)), + tibble::rownames_to_column(as.data.frame(de_2))) # selected samples + + # 928 + # 2692 + # 185 + + comp <- dplyr::inner_join(data_red[[1]], + data_red[[2]], + by = "rowname", + copy = FALSE + ) + + # for (i in 1:length(data_red)) { + # data_red[i][[1]] <- subset( + # data_red[i][[1]], + # data_red[i][[1]]$pval < pthresh + # ) + # data_red[i][[1]] <- tibble::rownames_to_column(data_red[i][[1]]) + # } + # comp <- dplyr::inner_join(data_red[1][[1]], + # data_red[2][[1]], + # by = "rowname", + # copy = FALSE + # ) + # comp <- comp[stats::complete.cases(comp[colnames(comp)]), ] + + names(comp) <- c("gene_id", + "logFC1", "punadj1", "pval1", + "logFC2", "punadj2", "pval2") + + + comp_sel <- comp[(comp$pval1 <= pthresh) & (comp$pval2 <= pthresh), ] + + comp_sel$info <- paste0( + comp_sel$gene_id,": ", comp_sel$logFC1, ", ", comp_sel$logFC2, "\n something else\nanother line" + ) + + if (length(comp[, 1]) == 0) { + return(NULL) + } + + res <- ggplot2::ggplot( + data = comp_sel, + aes(.data[["logFC1"]], .data[["logFC2"]], + col = .data[[color_by]], + label = .data[["gene_id"]], + info = .data[["info"]] + )) + + ggplot2::geom_point() + + viridis::scale_color_viridis(option = "magma") + + ggplot2::xlab(names1) + + ggplot2::ylab(names2) + + ggplot2::labs(color = color_by) + + ggplot2::theme_light() + + return(res) +} diff --git a/R/DeeDee_summary.R b/R/DeeDee_summary.R new file mode 100644 index 0000000..725cc23 --- /dev/null +++ b/R/DeeDee_summary.R @@ -0,0 +1,201 @@ +#' deedee_summary +#' +#' Generates a comprehensive summary on the DE analyses, in one command +#' +#' Most parameters in this function call are related to a specific function of the +#' `DeeDee` package. Please refer to the individual help pages for more details, +#' reminding that the parameter naming scheme is mirroring the pattern +#' `function_parameter`, e.g. `scatter_color_by` controlling the `color_by` +#' value in the [deedee_scatter()] function. +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param template Character value. Defines the location of the Rmd template to use +#' for generating the summary +#' @param output_path Character value, name of the file the report will be saved +#' to. Defaults to `DeeDeeSummary.html`, in the current working directory. +#' @param overwrite Logical value, whether to overwrite an existing file if +#' choosing the exact same name. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. This parameter is shared across +#' a number of individual `DeeDee` functions. +#' @param scatter_select1 From [deedee_scatter()] - Numeric value, corresponding +#' to the order of the element in the dde object to be selected first. +#' @param scatter_select2 From [deedee_scatter()] - Numeric value, corresponding +#' to the order of the element in the dde object to be selected as second. +#' @param scatter_color_by From [deedee_scatter()] - Character value, either +#' "pval1" or "pval2" to color the individual points mapping them to the p-value +#' of either DE result set. +#' @param heatmap_show_first From [deedee_heatmap()] - Numeric value, specifying +#' the number of features to include. +#' @param heatmap_show_gene_names From [deedee_heatmap()] - Logical value, +#' whether to display the gene names on the heatmap's side. +#' @param heatmap_dist From [deedee_heatmap()] - Character value, specifying the +#' distance type to use in the call to ComplexHeatmap. +#' @param heatmap_clust From [deedee_heatmap()] - Character value. Defines the +#' method to perform hierarchical clustering, passed to `hclust`, as used in +#' `ComplexHeatmap`. +#' @param heatmap_show_na From [deedee_heatmap()] - Logical value, whether to +#' include features that have `NA` value for the log fold change. +#' @param venn_mode From [deedee_venn()] - Character value, one of "both", "up", +#' or "down". Specifies which set of features to focus on for the overlap +#' calculations. +#' @param upset_mode From [deedee_upset()] - Character value, specifies which +#' subset of features to include in the overlap computations. +#' Can be either of the following: "both", "up", "down", or "both_colored". +#' @param upset_min_setsize From [deedee_upset()] - Numeric value, specifying +#' the minimal number of observations in an intersection for it to be included +#' in the upset plot. +#' @param qqmult_ref From [deedee_qqmult()] - A numeric value, corresponding to +#' the order of the element in the `dde` object to be used as a reference for the +#' multi Q-Q plot. +#' @param cat_ref From [deedee_cat()] - A numeric value, corresponding to the +#' order of the element in the dde object to be used as a reference in the CAT +#' plot. +#' @param cat_maxrank From [deedee_cat()] - A numeric value. Indicates the +#' maximum ranked feature to include when computing the Concordance At the Top. +#' @param cat_mode From [deedee_cat()] - A character value, could be one of "up", +#' "down", or "both". Defines which features to include in the computations. +#' @param render_quiet Logical value. Whether to render the report quietly when +#' calling `rmarkdown::render()`. +#' @param silent Logical value, prints a message once completed if set to TRUE. +#' @param open_file Logical value, if set to TRUE opens up the report once +#' generated into a browser window. +#' +#' @seealso +#' [deedee_cat()], [deedee_heatmap()], [deedee_qq()], [deedee_qqmult()], +#' [deedee_scatter()], [deedee_upset()], and [deedee_venn()] +#' +#' @return Generates a fully fledged report in the location specified by +#' `output_path`, and returns (invisibly) the name of the generated report. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' # deedee_summary(dde) +deedee_summary <- function(dde, + template = system.file("extdata", + "summary_template.Rmd", + package = "DeeDee"), + output_path = "DeeDee_Summary.html", + overwrite = FALSE, + pthresh = 0.05, + scatter_select1 = 1, + scatter_select2 = 2, + scatter_color_by = "pval1", + heatmap_show_first = 25, + heatmap_show_gene_names = FALSE, + heatmap_dist = "euclidean", + heatmap_clust = "average", + heatmap_show_na = FALSE, + venn_mode = "both", + upset_mode = "both_colored", + upset_min_setsize = 10, + qqmult_ref = 1, + cat_ref = 1, + cat_maxrank = 1000, + cat_mode = "up", + render_quiet = TRUE, + silent = FALSE, + open_file = TRUE) { + + # checkmate::assert_list(deedee_list, type = "data.frame", min.len = 2) + # for (i in 1:length(deedee_list)) { + # checkmate::assert_data_frame(deedee_list[[i]], type = "numeric") + # } + # checkmate::assert_number(pthresh, lower = 0, upper = 1) + # + # checkmate::assert_logical(overwrite) + # + # checkmate::assert_number(scatter_select1, lower = 1, upper = length(deedee_list)) + # checkmate::assert_number(scatter_select2, lower = 1, upper = length(deedee_list)) + # choices <- c("pval1", "pval2") + # checkmate::assert_choice(scatter_color_by, choices) + # + # checkmate::assert_number(heatmap_show_first, lower = 1) + # checkmate::assert_logical(heatmap_show_gene_names) + # choices1 <- c("euclidean", "manhattan", "pearson", "spearman") + # checkmate::assert_choice(heatmap_dist, choices1) + # choices2 <- c("single", "complete", "average", "centroid") + # checkmate::assert_choice(heatmap_clust, choices2) + # checkmate::assert_logical(heatmap_show_na) + # + # choices <- c("up", "down", "both") + # checkmate::assert_choice(venn_mode, choices) + # + # choices <- c("up", "down", "both", "both_colored") + # checkmate::assert_choice(upset_mode, choices) + # checkmate::assert_number(upset_min_setsize, lower = 0) + # + # checkmate::assert_number(qqmult_ref, lower = 1, upper = length(deedee_list)) + # + # checkmate::assert_number(cat_ref, lower = 1, upper = length(deedee_list)) + # checkmate::assert_number(cat_maxrank, lower = 1) + # choices <- c("up", "down", "both") + # checkmate::assert_choice(cat_mode, choices) + + # template <- system.file("extdata", + # "summary_template.Rmd", + # package = "DeeDee" + # ) + + + + file.exists(template) + + if (file.exists(output_path)) { + if (!overwrite) { + stop("Your declared output file already exists. ", + "Set overwrite = TRUE to proceed anyway.", + call. = FALSE + ) + } + } + + output_rmd <- paste(unlist(strsplit(output_path, + split = ".", + fixed = TRUE + ))[1], ".Rmd", sep = "") + + file.copy(from = template, to = output_rmd, overwrite = TRUE) + + args <- list() + args$input <- output_rmd + args$output_format <- "html_document" + args$output_path <- output_path + + output_path <- rmarkdown::render(output_rmd, + params = args, + quiet = render_quiet + ) + if (open_file == TRUE) { + utils::browseURL(output_path) + } + + file.remove(output_rmd) + + if (silent == FALSE) { + message("Your summary has been generated in ", output_path) + } + + invisible(output_path) +} + +# deedee_summary(dde, +# template = "inst/extdata/summary_template.Rmd", output_path = "v2.html") + + diff --git a/R/DeeDee_upset.R b/R/DeeDee_upset.R new file mode 100644 index 0000000..386bc49 --- /dev/null +++ b/R/DeeDee_upset.R @@ -0,0 +1,163 @@ +#' deedee_upset +#' +#' Upset plot on the sets of DE features for the different analyses included +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param mode Character value, specifies which subset of features to include +#' in the overlap computations. Can be either of the following: "both", "up", +#' "down", or "both_colored". +#' @param min_setsize Numeric value, specifying the minimal number of +#' observations in an intersection for it to be included in the upset plot. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A plot object, drawn with the `ComplexUpset` package. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' deedee_upset(dde, pthresh = 0.05, mode = "both_colored", min_setsize = 10) +#' +deedee_upset <- function(dde, + mode = "both_colored", + min_setsize = 10, + pthresh = 0.05) { + + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(min_setsize) | !(min_setsize > 0)) + stop("Please specify a positive integer for the min_setsize parameter") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + mode <- match.arg(mode, c("up", "down", "both", "both_colored")) + + + dea_list <- get_dea_list(dde) + for (i in seq_len(length(dea_list))) { + dea_list[[i]] <- subset(dea_list[[i]], dea_list[[i]]$padj < pthresh) # pthresh + + if (length(dea_list[[i]][[1]]) == 0) { + return(NULL) + } + + dea_list[[i]] <- dea_list[[i]]["log2FoldChange"] # removing p-value column + dea_list[[i]]$log2FoldChange[dea_list[[i]]$log2FoldChange < 0] <- -1 # 1/0/-1 distinction + dea_list[[i]]$log2FoldChange[dea_list[[i]]$log2FoldChange > 0] <- 1 + + if (mode == "both" || mode == "both_colored") { + dea_list[[i]] <- subset(dea_list[[i]], dea_list[[i]]$log2FoldChange != 0) + } + + if (mode == "up") { + dea_list[[i]] <- subset(dea_list[[i]], dea_list[[i]]$log2FoldChange == 1) + } + + if (mode == "down") { + dea_list[[i]] <- subset(dea_list[[i]], dea_list[[i]]$log2FoldChange == -1) + } + dea_list[[i]] <- tibble::rownames_to_column(dea_list[[i]]) + names(dea_list[[i]]) <- c("rowname", names(dea_list[i])) + } + + comp <- dplyr::full_join(dea_list[[1]], dea_list[[2]], + by = "rowname", + copy = FALSE + ) + + if (length(dea_list) > 2) { + for (i in 3:length(dea_list)) { + comp <- dplyr::full_join(comp, dea_list[[i]], by = "rowname", copy = FALSE) + } + } + comp <- tibble::column_to_rownames(comp) + contrasts <- colnames(comp) + + if (mode == "both_colored") { + count <- vector(mode = "numeric", length = length(comp[[1]])) + comp <- cbind(comp, count) + comp["count"] <- rowSums(comp, na.rm = TRUE) + + na_count <- vector(mode = "numeric", length = length(comp[[1]])) + comp <- cbind(comp, na_count) + comp["na_count"] <- rowSums(is.na(comp)) + + dr <- vector(mode = "character", length = length(comp[[1]])) + comp <- cbind(comp, dr) + + nsets <- length(dea_list) + + for (i in seq_len(length(comp[[1]]))) { + if ((comp[i, "count"] + comp[i, "na_count"]) == nsets) { + comp[i, "dr"] <- "up" + } else if ((comp[i, "count"] - comp[i, "na_count"]) == -nsets) { + comp[i, "dr"] <- "down" + } else { + comp[i, "dr"] <- "different" + } + } + + comp <- subset(comp, select = -c(count, na_count)) + comp[is.na(comp)] <- FALSE + comp[comp == -1 | comp == 1] <- TRUE + } + + if (mode == "both_colored") { + col_up <- viridis::viridis(n = 1, begin = 0.4, option = "magma") + col_down <- viridis::viridis(n = 1, begin = 0.9, option = "magma") + res <- ComplexUpset::upset(comp, + contrasts, + guide = NULL, + base_annotations = list( + "Intersection of genes" = ComplexUpset::intersection_size( + counts = FALSE, + mapping = ggplot2::aes(fill = dr) + ) + + ggplot2::scale_fill_manual( + values = c( + "different" = "dark grey", + "down" = col_down, + "up" = col_up + ), + name = "Regulation direction" + ) + ), + width_ratio = 0.1, + min_size = min_setsize + ) + } else { + comp <- (comp != 0 & !is.na(comp)) + comp <- as.data.frame(comp) + res <- ComplexUpset::upset(comp, + contrasts, + guide = NULL, + width_ratio = 0.1, + min_size = min_setsize + ) + } + + return(res) +} + + +# deedee_upset(dde, +# pthresh = 0.05, +# mode = "both_colored", +# min_setsize = 10) diff --git a/R/DeeDee_venn.R b/R/DeeDee_venn.R new file mode 100644 index 0000000..7b81399 --- /dev/null +++ b/R/DeeDee_venn.R @@ -0,0 +1,104 @@ +#' deedee_venn +#' +#' A Venn diagram on the DE features from different analyses +#' +#' @param dde A [DeeDeeExperiment] object. +#' @param mode Character value, one of "both", "up", or "down". Specifies which +#' set of features to focus on for the overlap calculations. +#' @param pthresh Numeric value, corresponding to the p-value to use as a +#' threshold to subset the features to include. +#' +#' @return A `ggplot` plot object. +#' @export +#' +#' @examples +#' data("de_named_list", package = "DeeDee") +#' library("SummarizedExperiment") +#' +#' rd_macrophage <- DataFrame( +#' gene_id = rownames(de_named_list$ifng_vs_naive)) +#' rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +#' se_macrophage_noassays <- SummarizedExperiment( +#' assays = SimpleList(), +#' rowData = rd_macrophage +#' ) +#' dde <- DeeDeeExperiment( +#' se_macrophage_noassays, +#' de_results = de_named_list +#' ) +#' dde +#' +#' library("dplyr") ## to have the inner_join, needed by ggvenn +#' deedee_venn(dde, pthresh = 0.05, mode = "both") +#' +deedee_venn <- function(dde, + mode = "both", + pthresh = 0.05) { + + if (length(dea(dde)) < 2) + stop("Please provide a dde object including at least two DE analyses") + + if (!is.numeric(pthresh) | !(pthresh > 0 & pthresh <= 1)) + stop("Please specify a valid p-value threshold") + + mode <- match.arg(mode, c("up", "down", "both")) + + + dea_list <- get_dea_list(dde) + for (i in seq_len(length(dea_list))) { + dea_list[[i]] <- subset( + dea_list[[i]], + dea_list[[i]]$padj < pthresh + ) + + if (length(dea_list[[i]][[1]]) == 0) { + return(NULL) + } + + if (mode == "up") { + dea_list[[i]] <- subset( + dea_list[[i]], + dea_list[[i]]$log2FoldChange > 0 + ) + } + if (mode == "down") { + dea_list[[i]] <- subset( + dea_list[[i]], + dea_list[[i]]$log2FoldChange < 0 + ) + } + dea_list[[i]] <- dea_list[[i]]["log2FoldChange"] # removing p-value column + colnames(dea_list[[i]]) <- c(paste("log2FoldChange", i, sep = "")) + dea_list[[i]] <- as.matrix(dea_list[[i]]) # conversion to matrix + names <- rownames(dea_list[[i]]) + dea_list[[i]] <- as.vector(dea_list[[i]]) # conversion to vector + names(dea_list[[i]]) <- names + dea_list[[i]] <- sort(dea_list[[i]], decreasing = TRUE) + dea_list[[i]] <- names(dea_list[[i]]) + } + + pal <- c(viridis::viridis(length(dea_list), option = "magma")) + + res <- ggvenn::ggvenn(dea_list, + fill_alpha = 0.2, + fill_color = pal, + show_percentage = FALSE, + stroke_color = "grey80", + set_name_size = 4 + ) + + return(res) +} + +# deedee_venn(dde, pthresh = 0.05, mode = "both") + + + + + + + + + + + diff --git a/R/deedee_app.R b/R/deedee_app.R deleted file mode 100644 index d6b9638..0000000 --- a/R/deedee_app.R +++ /dev/null @@ -1,1392 +0,0 @@ -#' DeeDee App -#' -#' @description `deedee_app` opens the DeeDee Shiny web application, combining -#' the functionalities of all other DeeDee functions with a user-friendly -#' graphical user interface. -#' -#' @param deedee_obj An object of the class DeeDeeObject to be analyzed. -#' -#' @return A shiny app -#' @export -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' if (interactive()) { -#' deedee_app(dd_list) -#' } -deedee_app <- function(deedee_obj = NULL) { - - # ---------------------------------------------------------------------------- - # --------------------------------- U I -------------------------------------- - # ---------------------------------------------------------------------------- - - deedee_ui <- shiny::navbarPage("DeeDee", - id = "tabs", - theme = shinythemes::shinytheme("flatly"), - - - # ----------------------------- data input --------------------------------- - shiny::tabPanel( - "Input", - shiny::fluidRow( - shiny::column( - 8, - shiny::fileInput("inp", "Upload your DEA results or DeeDee objects", - multiple = TRUE, - accept = c(".rds", ".txt", ".xlsx"), - placeholder = "No files selected" - ), - shiny::tableOutput("inp_infobox") - ), - shiny::column( - 4, - shiny::selectInput("organism", "Organism", - choices = list( - "Human" = "org.Hs.eg.db", - "Mouse" = "org.Mm.eg.db", - "Fly" = "org.Dm.eg.db", - "Rat" = "org.Rn.eg.db" - ) - ), - shiny::uiOutput("key_inp"), - shiny::uiOutput("datasets"), - shiny::conditionalPanel( - "output.inp_infobox", - shiny::downloadButton( - "inp_download", - "Download DeeDee object (.RDS)" - ) - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "input.md", - package = "DeeDee" - )), - style = "primary" - ) - ), - - # shiny::downloadButton("vignette", - # "Download DeeDee Package vignette (.html)") - ), - - - # ------------------------------- scatter ---------------------------------- - shiny::tabPanel( - "Scatterplot", - shiny::fluidRow( - shiny::column( - 4, - shiny::uiOutput("scatter_choices1"), - shiny::uiOutput("scatter_choices2"), - shiny::selectInput("scatter_color_by", "Color by", - choices = list( - "1st p-value" = "pval1", - "2nd p-value" = "pval2" - ), - selected = "pval1" - ), - shiny::numericInput("scatter_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ), - shiny::actionButton("ora_button", "Over-representation analysis") - ), - shiny::column( - 8, - shinycssloaders::withSpinner( - shiny::plotOutput("scatter", - # dblclick = "scatter_dblclick", - brush = shiny::brushOpts( - id = "scatter_brush", - resetOnNew = FALSE - ) - ) - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "scatter.md", - package = "DeeDee" - )), - style = "primary" - ) - ), - shinyBS::bsModal( - id = "modalExample", - title = "Gene Ontology over-representation analysis", - trigger = "ora_button", - size = "large", - shinycssloaders::withSpinner(shiny::plotOutput("scatter_ora")), - shiny::downloadButton( - "ora_download", - "Download enrichment result object (.RDS)" - ) - ), - shiny::downloadButton( - "scatter_brush_download", - "Download brushed genes (.xlsx)" - ), - shiny::tableOutput("scatter_brush_info") - ), - - - # ------------------------------- heatmap ---------------------------------- - shiny::tabPanel( - "Heatmap", - id = "heatmap", - shiny::fluidRow( - shiny::column( - 4, - shiny::numericInput("heatmap_show_first", - "Show first", - value = 25, - min = 1 - ), - shiny::checkboxInput("heatmap_show_gene_names", - "Show gene names", - value = FALSE - ), - shiny::checkboxInput("heatmap_showNA", - "Show NA", - value = FALSE - ), - shiny::selectInput("heatmap_dist", "Distance measure", - choices = list( - "Euclidean" = "euclidean", - "Manhattan" = "manhattan", - "Pearson" = "pearson", - "Spearman" = "spearman" - ), - selected = "euclidean" - ), - shiny::selectInput("heatmap_clust", "Clustering method", - choices = list( - "Single" = "single", - "Complete" = "complete", - "Average" = "average", - "Centroid" = "centroid" - ), - selected = "average" - ), - shiny::numericInput("heatmap_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ), - shiny::actionButton("heatmap_action", "Create heatmap") - ), - shiny::column( - 8, - shiny::textOutput("heatmap_errors"), - shiny::conditionalPanel( - "output.heatmap_errors == ''", - shinycssloaders::withSpinner( - InteractiveComplexHeatmap:: - InteractiveComplexHeatmapOutput() - ) - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "heatmap.md", - package = "DeeDee" - )), - style = "primary" - ) - ) - ), - - - # -------------------------------- venn ------------------------------------ - shiny::tabPanel( - "Venn Diagram", - shiny::fluidRow( - shiny::column( - 4, - shiny::selectInput("venn_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "both" - ), - shiny::numericInput("venn_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ) - ), - shiny::column( - 8, - shinycssloaders::withSpinner( - shiny::plotOutput("venn") - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "venn.md", - package = "DeeDee" - )), - style = "primary" - ) - ) - ), - - - # -------------------------------- upSet ----------------------------------- - shiny::tabPanel( - "UpSet Plot", - shiny::fluidRow( - shiny::column( - 4, - shiny::selectInput("upset_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "both" - ), - shiny::conditionalPanel( - condition = "input.upset_mode == 'both'", - shiny::checkboxInput( - "upset_colored", - "Coloring", - TRUE - ) - ), - shiny::numericInput("upset_minset", "Minimum set size", - value = 10, min = 0, step = 1 - ), - shiny::numericInput("upset_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ) - ), - shiny::column( - 8, - shinycssloaders::withSpinner( - shiny::plotOutput("upset") - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "upset.md", - package = "DeeDee" - )), - style = "primary" - ) - ) - ), - - - # --------------------------------- qq ------------------------------------- - shiny::tabPanel( - "Quantile-Quantile Plot", - shiny::fluidRow( - shiny::column( - 4, - shiny::checkboxInput("qq_multiple", "Multiple", value = FALSE), - shiny::conditionalPanel( - condition = "!input.qq_multiple", - shiny::uiOutput("qq_choices1"), - shiny::uiOutput("qq_choices2"), - shiny::selectInput("qq_color_by", "Color by", - choices = list( - "1st p-value" = "pval1", - "2nd p-value" = "pval2" - ), - selected = "pval1" - ), - shiny::checkboxInput("qq_line", "As line", value = FALSE) - ), - shiny::conditionalPanel( - condition = "input.qq_multiple", - shiny::uiOutput("qq_ref"), - ), - shiny::numericInput("qq_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ) - ), - shiny::column( - 8, - shiny::conditionalPanel( - condition = "!input.qq_multiple", - shinycssloaders::withSpinner( - shiny::plotOutput("qq", - brush = "qq_brush" - ) - ) - ), - shiny::conditionalPanel( - condition = "input.qq_multiple", - shinycssloaders::withSpinner( - shiny::plotOutput("qq_mult") - ) - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "qq.md", - package = "DeeDee" - )), - style = "primary" - ) - ), - shiny::conditionalPanel( - condition = "!input.qq_multiple", - shiny::downloadButton( - "qq_brush_download", - "Download brushed genes (.xlsx)" - ), - shiny::tableOutput("qq_brush_info") - ) - ), - - - # --------------------------------- cat ------------------------------------ - shiny::tabPanel( - "Concordance At the Top Plot", - shiny::fluidRow( - shiny::column( - 4, - shiny::selectInput("cat_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "up" - ), - shiny::numericInput("cat_maxrank", - "Max rank", - value = 1000, - min = 1 - ), - shiny::uiOutput("cat_choice"), - shiny::numericInput("cat_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ) - ), - shiny::column( - 8, - shinycssloaders::withSpinner( - shiny::plotOutput("cat") - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "cat.md", - package = "DeeDee" - )), - style = "primary" - ) - ) - ), - - # ------------------------------- summary ---------------------------------- - shiny::tabPanel( - "Summary", - shiny::numericInput("sum_pthresh", "P-value threshold", - value = 0.05, min = 0.01, max = 1, step = 0.01 - ), - shiny::actionButton("sum_button", "Create Summary"), - shinyBS::bsModal( - id = "sum_modal", - title = "DeeDee Summary", - trigger = "sum_button", - size = "large", - shiny::fluidPage( - shiny::downloadButton( - "sum_download", - "Download your DeeDee Summary (.html)" - ), - shinycssloaders::withSpinner(shiny::uiOutput("show_html_summary")) - ) - ), - shiny::fluidRow( - shinydashboard::tabBox( - title = "", - width = 12, - id = "sum_params", - shiny::tabPanel( - "Scatterplot", - shiny::uiOutput("sum_scatter_choices1"), - shiny::uiOutput("sum_scatter_choices2"), - shiny::selectInput("sum_scatter_color_by", "Color by", - choices = list( - "1st p-value" = "pval1", - "2nd p-value" = "pval2" - ), - selected = "pval1" - ) - ), - shiny::tabPanel( - "Heatmap", - shiny::numericInput("sum_heatmap_show_first", - "Show first", - value = 25, - min = 1 - ), - shiny::checkboxInput("sum_heatmap_show_gene_names", - "Show gene names", - value = FALSE - ), - shiny::checkboxInput("sum_heatmap_show_na", - "Show NA", - value = FALSE - ), - shiny::selectInput("sum_heatmap_dist", "Distance measure", - choices = list( - "Euclidean" = "euclidean", - "Manhattan" = "manhattan", - "Pearson" = "pearson", - "Spearman" = "spearman" - ), - selected = "euclidean" - ), - shiny::selectInput("sum_heatmap_clust", "Clustering method", - choices = list( - "Single" = "single", - "Complete" = "complete", - "Average" = "average", - "Centroid" = "centroid" - ), - selected = "average" - ) - ), - shiny::tabPanel( - "Venn Diagram", - shiny::selectInput("sum_venn_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "both" - ) - ), - shiny::tabPanel( - "UpSet Plot", - shiny::selectInput("sum_upset_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "both" - ), - shiny::conditionalPanel( - condition = "input.sum_upset_mode == 'both'", - shiny::checkboxInput( - "sum_upset_colored", - "Coloring", - TRUE - ) - ), - shiny::numericInput("sum_upset_min_setsize", "Minimum set size", - value = 10, min = 0, step = 1 - ) - ), - shiny::tabPanel( - "Quantile-Quantile Plot", - shiny::uiOutput("sum_qq_ref"), - ), - shiny::tabPanel( - "Concordance At the Top Plot", - shiny::selectInput("sum_cat_mode", "Mode", - choices = list( - "Up" = "up", - "Down" = "down", - "Both" = "both" - ), - selected = "up" - ), - shiny::numericInput("sum_cat_maxrank", - "Max rank", - value = 1000, - min = 1 - ), - shiny::uiOutput("sum_cat_choice") - ) - ) - ), - shinyBS::bsCollapse( - shinyBS::bsCollapsePanel("INFO", - shiny::includeMarkdown(system.file("extdata", - "summary.md", - package = "DeeDee" - )), - style = "primary" - ) - ) - ) - ) - - - - # ---------------------------------------------------------------------------- - # ----------------------------- S E R V E R ---------------------------------- - # ---------------------------------------------------------------------------- - - deedee_server <- function(input, output, session) { - - # ----------------------------- data input --------------------------------- - output$key_inp <- shiny::renderUI({ - shiny::req(input$organism) - anno <- input$organism - require(anno, character.only = TRUE) - shiny::selectInput("key_type", - "Key type of gene IDs", - choices = keytypes(get(anno)) - ) - }) - - mydata <- shiny::reactive({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - - ext <- c() - res <- list() - - if (!is.null(deedee_obj)) { - if (class(deedee_obj) == "DeeDeeObject") { - ext[1] <- "arg" - # df <- data.frame(filename, type, contrast, genes) - res[[1]] <- deedee_obj@DeeDeeList - } - else { - stop("Your argument input is not of type 'DeeDeeObject'. Please check your input and re-open the application.") - } - } - - k <- 0 - - # reading out input files - if (length(input$inp[, 1] > 0)) { - for (i in (length(ext) + 1):(length(input$inp[, 1]) + length(ext))) { - k <- k + 1 - ext[i] <- tools::file_ext(input$inp[k, "datapath"]) - shiny::validate(shiny::need( - ext[[i]] == "rds" || - ext[[i]] == "RDS" || - ext[[i]] == "xlsx" || - ext[[i]] == "txt", - "Please upload only .RDS, .xlsx or .txt files" - )) - - # .RDS input - if (ext[[i]] == "rds" || ext[[i]] == "RDS") { - res[[i]] <- readRDS(input$inp[[k, "datapath"]]) - res[[i]] <- rds_input(obj = res[[i]], - nm = input$inp[[k, "name"]]) - - # .xlsx input - } else if (ext[[i]] == "xlsx") { - sheets <- readxl::excel_sheets(input$inp[[k, "datapath"]]) - res[[i]] <- xlsx_input(obj = sheets, - path= input$inp[[k, "datapath"]], - nm = input$inp[k, "name"]) - - # .txt input - } else if (ext[[i]] == "txt") { - temp <- utils::read.table(input$inp[[k, "datapath"]]) - res[[i]] <- list(temp) - names(res[[i]]) <- unlist(strsplit(input$inp[k, "name"], - split = ".", - fixed = TRUE - ))[1] - } else { - return(NULL) - } - } - } - - # merging input data structures - dat <- list() - for (i in 1:length(res)) { - for (j in 1:length(res[[i]])) { - checkmate::assert_subset(names(res[[i]][[j]]), c("logFC", "pval")) - dat[[names(res[[i]])[[j]]]] <- res[[i]][[j]] - } - } - - obj <- DeeDeeObject(DeeDeeList = dat) - - return(obj) - }) - - output$datasets <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::checkboxGroupInput("select_datasets", - "Select datasets to be used", - choices = names(mydata()@DeeDeeList), - selected = names(mydata()@DeeDeeList) - ) - }) - - mydata_use <- shiny::reactive({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - use <- input$select_datasets - dat2 <- list() - for (i in use) { - dat2[i] <- mydata()@DeeDeeList[i] - } - return(dat2) - }) - - output$inp_download <- shiny::downloadHandler( - filename = "DeeDee_object.RDS", - content = function(file) { - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - dl <- DeeDeeObject(DeeDeeList = mydata_use()) - saveRDS(dl, file) - } - ) - - output$inp_infobox <- shiny::renderTable({ - shiny::validate(shiny::need( - !is.null(mydata()@DeeDeeList), - "Faulty input data provided." - )) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - - input_infobox(deedee_obj = deedee_obj, - sets = input$inp, - md = mydata()) - }) - - - # ------------------------------- scatter ---------------------------------- - # --- selectors --- - output$scatter_choices1 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("scatter_select1", - "1st data set", - choices = names(mydata_use()) - ) - }) - - output$scatter_choices2 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("scatter_select2", - "2nd data set", - selected = names(mydata_use())[2], - choices = names(mydata_use()) - ) - }) - - # --- plot output --- - ranges <- shiny::reactiveValues(x = NULL, y = NULL) - - output$scatter <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - sel1 <- match(input$scatter_select1, names(mydata_use())) - sel2 <- match(input$scatter_select2, names(mydata_use())) - shiny::req(sel1) - shiny::req(sel2) - res <- deedee_scatter(mydata_use(), - select1 = sel1, - select2 = sel2, - color_by = input$scatter_color_by, - pthresh = input$scatter_pthresh - ) - shiny::validate( - shiny::need(!is.null(res), "No common genes in input datasets.") - ) - res + - ggplot2::coord_cartesian( - xlim = ranges$x, - ylim = ranges$y, - expand = FALSE - ) - }) - - # --- brushing --- - # scatter_download_button <- shiny::renderUI( - # conditionalPanel("output.scatter_brushed()", - # downloadButton("scatter_brush_download", - # "Download brushed genes (.txt)"))) - - scatter_brushed <- shiny::reactive({ - shiny::req(input$scatter_brush) - df <- data.frame( - x = mydata_use()[[input$scatter_select1]], - y = mydata_use()[[input$scatter_select2]] - ) - - df <- subset(df, x.pval < 0.05 & y.pval < 0.05) - - names(df) <- c( - paste(input$scatter_select1, ".logFC", sep = ""), - paste(input$scatter_select1, ".pval", sep = ""), - paste(input$scatter_select2, ".logFC", sep = ""), - paste(input$scatter_select2, ".pval", sep = "") - ) - shiny::brushedPoints(df, - input$scatter_brush, - xvar = paste(input$scatter_select1, ".logFC", sep = ""), - yvar = paste(input$scatter_select2, ".logFC", sep = "") - ) - }) - - output$scatter_brush_info <- shiny::renderTable( - { - shiny::req(scatter_brushed()) - scatter_brushed() - }, - rownames = TRUE - ) - - output$scatter_brush_download <- shiny::downloadHandler( - filename = "scatter_brushed_genes.xlsx", - content = function(file) { - shiny::req(input$scatter_brush) - bru <- tibble::rownames_to_column(scatter_brushed()) - first <- data.frame(bru[1], bru[2], bru[3]) - nm1 <- unlist(strsplit(names(first)[2], - split = ".", - fixed = TRUE - ))[1] - names(first) <- c("rowname", "logFC", "pval") - second <- data.frame(bru[1], bru[4], bru[5]) - nm2 <- unlist(strsplit(names(second)[2], - split = ".", - fixed = TRUE - ))[1] - names(second) <- c("rowname", "logFC", "pval") - l <- list(first, second) - names(l) <- c(nm1, nm2) - writexl::write_xlsx(l, file, col_names = TRUE) - } - ) - - # --- enrich --- - enrich <- shiny::reactive({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::validate(shiny::need( - scatter_brushed(), - "No brushed genes." - )) - sel1 <- match(input$scatter_select1, names(mydata_use())) - sel2 <- match(input$scatter_select2, names(mydata_use())) - shiny::req(sel1) - shiny::req(sel2) - data <- list(mydata_use()[[sel1]], mydata_use()[[sel2]]) - res <- ora( - geneList = scatter_brushed(), - universe = data, - orgDB = input$organism, - key_type = input$key_type - ) - shiny::validate(shiny::need( - class(res) == "enrichResult", - "Not working." - )) - - return(res) - }) - - output$scatter_ora <- shiny::renderPlot({ - shiny::validate(shiny::need( - !is.null(enrich()), - "Something went wrong..." - )) - en <- enrich() - en_df <- as.data.frame(en) - shiny::validate(shiny::need( - nrow(en_df) > 0, - "No enriched terms found." - )) - options(ggrepel.max.overlaps = Inf) - plt <- enrichplot::emapplot(enrichplot::pairwise_termsim(en)) - shiny::validate(shiny::need( - !is.null(plt), - "No enriched terms found." - )) - print(plt) - }) - - output$ora_download <- shiny::downloadHandler( - filename = "enrichment_results.RDS", - content = function(file) { - shiny::req(!is.null(enrich())) - saveRDS(enrich(), file) - } - ) - - # ------------------------------- heatmap ---------------------------------- - output$heatmap_errors <- shiny::renderText({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - !is.null(heatmap_output()), - "No common genes in input datasets." - ) - ) - "" - }) - - heatmap_output <- shiny::reactive({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::req(input$heatmap_show_first) - shiny::req(mydata_use()) - res <- deedee_heatmap(mydata_use(), - show_first = input$heatmap_show_first, - show_gene_names = input$heatmap_show_gene_names, - dist = input$heatmap_dist, - clust = input$heatmap_clust, - pthresh = input$heatmap_pthresh, - show_na = input$heatmap_showNA - ) - shiny::validate( - shiny::need(!is.null(res), "No common genes in input datasets.") - ) - - res <- ComplexHeatmap::draw(res) - - return(res) - }) - - listen <- shiny::reactive({ - list( - input$heatmap_show_first, - input$heatmap_show_gene_names, - input$heatmap_dist, - input$heatmap_clust, - input$heatmap_pthresh, - input$heatmap_showNA, - mydata_use() - ) - }) - - global <- reactiveValues(notify = FALSE) - - shiny::observeEvent(listen(), { - global$notify <- TRUE - }) - - shiny::observeEvent(input$tabs, { - if (input$tabs == "Heatmap") { - if (global$notify == TRUE) { - shiny::showNotification("Something changed. Click 'Create heatmap' to reload.", - duration = NULL, - type = "warning", - id = "heatmap_warning" - ) - } - } else { - shiny::removeNotification("heatmap_warning") - } - }) - - shiny::observeEvent(listen(), { - req(input$tabs == "Heatmap") - shiny::showNotification("Something changed. Click 'Create heatmap' to reload.", - duration = NULL, - type = "warning", - id = "heatmap_warning" - ) - }) - - shiny::observeEvent(input$heatmap_action, { - shiny::req(length(mydata_use()) >= 2) - global$notify <- FALSE - InteractiveComplexHeatmap::makeInteractiveComplexHeatmap( - input, - output, - session, - heatmap_output() - ) - shiny::removeNotification("heatmap_warning") - }) - - - # -------------------------------- venn ------------------------------------ - output$venn <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - res <- deedee_venn(mydata_use(), - mode = input$venn_mode, - pthresh = input$venn_pthresh - ) - - shiny::validate( - shiny::need( - !is.null(res), - "No genes in your datasets. Maybe your specified p-value threshold is too low?" - ) - ) - - res - }) - - - # -------------------------------- upset ----------------------------------- - output$upset <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - if (input$upset_mode == "both" && input$upset_colored) { - mode <- "both_colored" - } else { - mode <- input$upset_mode - } - res <- deedee_upset(mydata_use(), - mode = mode, - pthresh = input$upset_pthresh, - min_setsize = input$upset_minset - ) - - shiny::validate( - shiny::need( - !is.null(res), - "No genes in your datasets. Maybe your specified p-value threshold is too low?" - ) - ) - res - }) - - - # --------------------------------- qq ------------------------------------- - output$qq_choices1 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("qq_select1", - "1st data set", - choices = names(mydata_use()) - ) - }) - - output$qq_choices2 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("qq_select2", - "2nd data set", - selected = names(mydata_use())[2], - choices = names(mydata_use()) - ) - }) - - output$qq_ref <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("qq_reference", - "Reference", - choices = names(mydata_use()) - ) - }) - - output$qq <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - sel1 <- match(input$qq_select1, names(mydata_use())) - sel2 <- match(input$qq_select2, names(mydata_use())) - shiny::req(sel1) - shiny::req(sel2) - res <- deedee_qq(mydata_use(), - select1 = sel1, - select2 = sel2, - color_by = input$qq_color_by, - pthresh = input$qq_pthresh, - as_line = input$qq_line - ) - - shiny::validate( - shiny::need( - !is.null(res), - "No genes in your datasets. Maybe your specified p-value threshold is too low?" - ) - ) - - res - }) - - output$qq_mult <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - ref <- match(input$qq_reference, names(mydata_use())) - shiny::req(ref) - res <- deedee_qqmult(mydata_use(), - ref = ref, - pthresh = input$qq_pthresh - ) - - shiny::validate( - shiny::need( - !is.null(res), - "No genes in your datasets. Maybe your specified p-value threshold is too low?" - ) - ) - - res - }) - - qq_brushed <- shiny::reactive({ - shiny::req(input$qq_brush) - x <- mydata()@DeeDeeList[[input$qq_select1]]$logFC - y <- mydata()@DeeDeeList[[input$qq_select2]]$logFC - pval1 <- mydata()@DeeDeeList[[input$qq_select2]]$pval - pval2 <- mydata()@DeeDeeList[[input$qq_select2]]$pval - names(x) <- row.names(mydata()@DeeDeeList[[input$qq_select2]]) - names(y) <- row.names(mydata()@DeeDeeList[[input$qq_select2]]) - - sx_idx <- order(x) - sy_idx <- order(y) - - sx <- x[sx_idx] - sy <- y[sy_idx] - pval1 <- pval1[sx_idx] - pval2 <- pval2[sy_idx] - - lenx <- length(sx) - leny <- length(sy) - - if (leny < lenx) { - sx <- stats::approx(1L:lenx, sx, n = leny)$y - pval1 <- stats::approx(1L:lenx, pval1, n = leny)$y - } - if (leny > lenx) { - sy <- stats::approx(1L:leny, sy, n = lenx)$y - pval2 <- stats::approx(1L:leny, pval2, n = lenx)$y - } - - sx <- tibble::rownames_to_column(as.data.frame(sx)) - sx[3] <- pval1 - sy <- tibble::rownames_to_column(as.data.frame(sy)) - sy[3] <- pval2 - - qq <- data.frame( - x = sx, - y = sy - ) - - names(qq) <- c( - paste(input$qq_select1, "gene", sep = "."), - paste(input$qq_select1, "logFC", sep = "."), - paste(input$qq_select1, "pval", sep = "."), - paste(input$qq_select2, "gene", sep = "."), - paste(input$qq_select2, "logFC", sep = "."), - paste(input$qq_select2, "pval", sep = ".") - ) - - temp1 <- paste(input$qq_select1, "logFC", sep = ".") - temp2 <- paste(input$qq_select2, "logFC", sep = ".") - - shiny::brushedPoints(qq, - input$qq_brush, - xvar = temp1, - yvar = temp2 - ) - }) - - output$qq_brush_info <- shiny::renderTable( - { - shiny::req(qq_brushed()) - qq_brushed() - }, - rownames = FALSE - ) - - output$qq_brush_download <- shiny::downloadHandler( - filename = "qq_brushed_genes.xlsx", - content = function(file) { - shiny::req(input$qq_brush) - bru <- qq_brushed() - first <- data.frame(bru[1], bru[2], bru[3]) - nm1 <- unlist(strsplit(names(first)[2], - split = ".", - fixed = TRUE - ))[1] - names(first) <- c("rowname", "logFC", "pval") - second <- data.frame(bru[4], bru[5], bru[6]) - nm2 <- unlist(strsplit(names(second)[2], - split = ".", - fixed = TRUE - ))[1] - names(second) <- c("rowname", "logFC", "pval") - l <- list(first, second) - names(l) <- c(nm1, nm2) - writexl::write_xlsx(l, file, col_names = TRUE) - } - ) - - - # --------------------------------- cat ------------------------------------ - output$cat_choice <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("cat_ref", - "Reference contrast", - selected = names(mydata_use())[1], - choices = names(mydata_use()) - ) - }) - - output$cat <- shiny::renderPlot({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::req(input$cat_maxrank) - shiny::req(input$cat_ref) - - ref <- match(input$cat_ref, names(mydata_use())) - res <- deedee_cat(mydata_use(), - ref = ref, - maxrank = input$cat_maxrank, - mode = input$cat_mode, - pthresh = input$cat_pthresh - ) - - shiny::validate( - shiny::need( - !is.null(res), - "No genes in your datasets. Maybe your specified p-value threshold is too low?" - ) - ) - - res - }) - - # ------------------------------- summary ---------------------------------- - output$sum_scatter_choices1 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("sum_scatter_select1", - "1st data set", - choices = names(mydata_use()) - ) - }) - - output$sum_scatter_choices2 <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("sum_scatter_select2", - "2nd data set", - selected = names(mydata_use())[2], - choices = names(mydata_use()) - ) - }) - - output$sum_qq_ref <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("sum_qqmult_ref", - "Reference", - selected = names(mydata_use())[1], - choices = names(mydata_use()) - ) - }) - - output$sum_cat_choice <- shiny::renderUI({ - shiny::req(shiny::isTruthy(input$inp) || shiny::isTruthy(deedee_obj)) - shiny::selectInput("sum_cat_ref", - "Reference contrast", - selected = names(mydata_use())[1], - choices = names(mydata_use()) - ) - }) - - summary <- reactive({ - shiny::validate( - shiny::need( - length(mydata()@DeeDeeList) >= 2, - "Please upload at least two contrasts." - ) - ) - shiny::validate( - shiny::need( - length(mydata_use()) >= 2, - "Please select at least two contrasts." - ) - ) - - shiny::req(mydata_use()) - - outfile <- tempfile(fileext = ".html") - - sc_sel1 <- match(input$sum_scatter_select1, names(mydata_use())) - if (is.null(sc_sel1)) { - sc_sel1 <- 1 - } - sc_sel2 <- match(input$sum_scatter_select2, names(mydata_use())) - if (is.null(sc_sel2)) { - sc_sel2 <- 2 - } - - qq_ref <- match(input$sum_qqmult_ref, names(mydata_use())) - if (length(qq_ref) == 0) { - qq_ref <- 1 - } - - cat_ref <- match(input$sum_cat_ref, names(mydata_use())) - if (length(cat_ref) == 0) { - cat_ref <- 1 - } - - if (input$sum_upset_mode == "both" && input$sum_upset_colored) { - ups_mode <- "both_colored" - } else { - ups_mode <- input$sum_upset_mode - } - - shiny::req(sc_sel1) - shiny::req(sc_sel2) - shiny::req(qq_ref) - shiny::req(cat_ref) - - deedee_summary(mydata_use(), - output_path = outfile, - overwrite = TRUE, - pthresh = input$sum_pthresh, - scatter_select1 = sc_sel1, - scatter_select2 = sc_sel2, - scatter_color_by = input$sum_scatter_color_by, - heatmap_show_first = input$sum_heatmap_show_first, - heatmap_show_gene_names = input$sum_heatmap_show_gene_names, - heatmap_dist = input$sum_heatmap_dist, - heatmap_clust = input$sum_heatmap_clust, - heatmap_show_na = input$sum_heatmap_show_na, - venn_mode = input$sum_venn_mode, - upset_mode = ups_mode, - upset_min_setsize = input$sum_upset_min_setsize, - qqmult_ref = qq_ref, - cat_ref = cat_ref, - cat_maxrank = input$sum_cat_maxrank, - cat_mode = input$sum_cat_mode, - silent = TRUE, - open_file = FALSE - ) - - return(outfile) - }) - - output$sum_download <- shiny::downloadHandler( - filename = "DeeDee_Summary.html", - content = function(file) { - shiny::req(summary()) - - file.copy(summary(), file) - } - ) - - output$show_html_summary <- shiny::renderUI({ - shiny::req(summary()) - - out <- tempfile(fileext = ".html") - - xml2::write_html(rvest::html_node(xml2::read_html(summary()), "body"), - file = out - ) - - shiny::includeHTML(path = out) - }) - } - - - # ------------------------------ run application ------------------------------- - shiny::shinyOptions(deedee_obj = deedee_obj) - shiny::shinyApp(ui = deedee_ui, server = deedee_server) -} diff --git a/R/deedee_cat.R b/R/deedee_cat.R deleted file mode 100644 index 2f03ac2..0000000 --- a/R/deedee_cat.R +++ /dev/null @@ -1,130 +0,0 @@ -#' DeeDee Concordance At the Top Plot -#' -#' @description `deedee_cat` creates a Concordance at the Top plot depicting -#' the concordance of genes in the first n elements of the logFC-ranked lists -#' for the given (non-reference) input contrasts against a chosen reference -#' contrast from the input list. -#' -#' @param data named list of results from deedee_prepare() -#' @param ref index of the contrast in data to be used as reference contrast -#' (default = 1) -#' @param mode sort by highest logFC (`up`, default), lowest logFC (`down`) or -#' greatest deviation from zero (`both`) -#' @param maxrank highest rank that should be displayed (default = 1000) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return ggplot object (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' deedee_cat(dd_list, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) -#' @export -#' - -deedee_cat <- function(data, - ref = 1, - maxrank = 1000, - mode = "up", - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(ref, lower = 1, upper = length(data)) - checkmate::assert_number(pthresh, lower = 0, upper = 1) - checkmate::assert_number(maxrank, lower = 1) - choices <- c("up", "down", "both") - checkmate::assert_choice(mode, choices) - - # ---------------------------- data preparation ----------------------------- - for (i in 1:length(data)) { - data[i][[1]] <- subset( - data[i][[1]], - data[i][[1]]$pval < pthresh - ) - - if (length(data[i][[1]][[1]]) == 0) { - return(NULL) - } - - data[i][[1]] <- data[i][[1]]["logFC"] # remove p-value column - colnames(data[i][[1]]) <- c(paste("logFC", i, sep = "")) - data[i][[1]] <- as.matrix(data[i][[1]]) # conversion to matrix - names <- rownames(data[i][[1]]) - data[i][[1]] <- as.vector(data[i][[1]]) # conversion to vector - names(data[i][[1]]) <- names - if (mode == "up") { - data[i][[1]] <- sort(data[i][[1]], decreasing = TRUE) - } else if (mode == "down") { - data[i][[1]] <- sort(data[i][[1]], decreasing = FALSE) - } else if (mode == "both") { - data[i][[1]] <- abs(data[i][[1]]) - data[i][[1]] <- sort(data[i][[1]], decreasing = TRUE) - } - - data[i][[1]] <- names(data[i][[1]]) - } - - # ----------------------- calculation of concordance ------------------------ - output <- list() - nm <- c() - - for (i in 1:length(data)) { - if (i != ref) { - output[[i]] <- data.frame( - rank = 1:min(maxrank, length(data[i][[1]])), - concordance = NA - ) - - for (j in 1:nrow(output[[i]])) { - intsec <- intersect(data[ref][[1]][1:j], data[i][[1]][1:j]) - output[[i]][[j, "concordance"]] <- length(intsec) / j - } - nm[[i]] <- names(data[i]) - } - } - - names(output) <- nm - - # ------------------- creation of the resulting CAT plot -------------------- - res <- ggplot2::ggplot( - dplyr::bind_rows(output, .id = "contrast"), - ggplot2::aes_string("rank", "concordance", colour = "contrast") - ) + - ggplot2::geom_line() + - ggplot2::theme_light() + - viridis::scale_color_viridis( - option = "magma", discrete = TRUE, - begin = 0, end = 0.9 - ) + - ggplot2::annotate("text", - label = paste("reference: ", - names(data)[ref], - sep = "" - ), - x = maxrank * 0.8, - y = max(output[[i]][["concordance"]]) * 1.1 - ) - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_heatmap.R b/R/deedee_heatmap.R deleted file mode 100644 index 9a13544..0000000 --- a/R/deedee_heatmap.R +++ /dev/null @@ -1,125 +0,0 @@ -#' @title DeeDee Heatmap -#' -#' @description `deedee_heatmap` creates a heatmap depicting the logFC as a -#' measure of the differential expression of the first genes in the given -#' datasets. -#' -#' @param data named list of results from deedee_prepare() -#' @param show_first indicating the number of genes depicted (default = 25) -#' @param show_gene_names boolean, show row names next to heatmap -#' (default = FALSE) -#' @param dist select the distance measure (`euclidean`, `manhattan`, `pearson`, -#' `spearman`) -#' @param clust select the clustering method (`single`, `complete`, `average`, -#' `centroid`) -#' @param show_na boolean, include genes with NA values in heatmap -#' (default = FALSE) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return Heatmap object (plottable with show()/print()). The resulting heatmap -#' (`res`) can be opened in a Shiny App with interactive functionality by -#' running the command `ht_shiny(res)` (see package `InteractiveComplexHeatmap`). -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' deedee_heatmap(dd_list, -#' pthresh = 0.05, show_first = 25, -#' show_gene_names = FALSE, dist = "euclidean", -#' clust = "average", show_na = FALSE -#' ) -#' @export -#' - -deedee_heatmap <- function(data, - show_first = 25, - show_gene_names = FALSE, - dist = "euclidean", - clust = "average", - show_na = FALSE, - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - checkmate::assert_number(show_first, lower = 1) - checkmate::assert_logical(show_gene_names) - choices1 <- c("euclidean", "manhattan", "pearson", "spearman") - checkmate::assert_choice(dist, choices1) - choices2 <- c("single", "complete", "average", "centroid") - checkmate::assert_choice(clust, choices2) - checkmate::assert_logical(show_na) - - # ---------------------------- data preparation ----------------------------- - for (i in 1:length(data)) { - data[i][[1]] <- subset(data[i][[1]], data[i][[1]]$pval < pthresh) # pthresh - data[i][[1]] <- data[i][[1]]["logFC"] # removing p-value column - colnames(data[i][[1]]) <- names(data)[i] # creating unique colnames - data[i][[1]] <- tibble::rownames_to_column(data[i][[1]]) - } - - # ----- creation of a comp matrix with the modified results from above ------ - comp <- dplyr::full_join(data[1][[1]], - data[2][[1]], - by = "rowname", - copy = FALSE - ) - if (length(data) > 2) { - for (i in 3:length(data)) { - comp <- dplyr::full_join(comp, data[i][[1]], by = "rowname", copy = FALSE) - } - } - - row.names(comp) <- comp$rowname - comp <- subset(comp, select = -c(rowname)) # removing column with rownames - comp <- comp[rowSums(!is.na(comp)) >= floor(length(comp) / 2) + 1, ] - if (show_na == FALSE) { - comp <- comp[stats::complete.cases(comp[colnames(comp)]), ] - } - comp <- as.matrix(comp) - - if (length(comp[, 1]) == 0) { - return(NULL) - } - - # ------------------- creation of the resulting heatmap --------------------- - if (show_gene_names == FALSE) { - rownames(comp) <- c() - } - - col <- viridis::viridis(n = 15, option = "magma") - - res <- ComplexHeatmap::Heatmap(comp[1:min( - show_first, - length(comp[, 1]) - ), ], - name = "logFC", - col = col, - clustering_distance_rows = dist, - clustering_method_rows = clust - ) - - # ComplexHeatmap::draw(res) - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_prepare.R b/R/deedee_prepare.R deleted file mode 100644 index 0bd7591..0000000 --- a/R/deedee_prepare.R +++ /dev/null @@ -1,46 +0,0 @@ -#' DeeDee Prepare -#' -#' @description `deedee_prepare` creates a DeeDee table from a DEA result -#' -#' @param data result from DESeq2, limma or edgeR -#' @param input_type the program the data comes from (`DESeq2`, `limma` or -#' `edgeR`) -#' -#' @return DeeDee table, to be used as part of the input for the other DeeDee -#' functions -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' -#' deedee_table <- deedee_prepare(IFNg_naive, "DESeq2") -#' @export -#' - -deedee_prepare <- function(data, input_type) { - - # ----------------------------- argument check ------------------------------ - choices <- c("DESeq2", "edgeR", "limma") - checkmate::assertChoice(input_type, choices) - - if (input_type == "DESeq2") { - checkmate::assertClass(data, "DESeqResults") - logFC <- data$log2FoldChange - pval <- data$padj - input <- data.frame(logFC, pval) - rownames(input) <- data@rownames - } else if (input_type == "edgeR") { - checkmate::assertClass(data, "DGEExact") - logFC <- data[["table"]][["logFC"]] - pval <- data[["table"]][["PValue"]] - input <- data.frame(logFC, pval) - rownames(input) <- data[["genes"]][["genes"]] - } else if (input_type == "limma") { - checkmate::assertDataFrame(data, types = "numeric") - logFC <- data$logFC - pval <- data$adj.P.Val - input <- data.frame(logFC, pval) - rownames(input) <- rownames(data) - } - return(input) -} diff --git a/R/deedee_qq.R b/R/deedee_qq.R deleted file mode 100644 index 34208ea..0000000 --- a/R/deedee_qq.R +++ /dev/null @@ -1,125 +0,0 @@ -#' DeeDee QQ Plot -#' -#' @description `deedee_qq` creates a Q-Q-plot comparing the statistical -#' distribution of the logFC of the genes in two input datasets. To compare more -#' than two contrasts against a reference, have a look at `deedee_qqmult`. -#' -#' @param data named list of results from deedee_prepare() -#' @param select1 index of first data-list element to be used (default = 1) -#' @param select2 index of second data-list element to be used (default = 2) -#' @param color_by indicates which set of values the output should be colored by -#' (possible values = `pval1` (default), `pval2`) -#' @param as_line logical value specifying if the resulting plot should be a -#' line (TRUE) or points (FALSE, default) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return ggplot object (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' deedee_qq(dd_list, pthresh = 0.05, select = 1, select2 = 2, color_by = "pval1") -#' @export -#' - -deedee_qq <- function(data, - select1 = 1, - select2 = 2, - color_by = "pval1", - as_line = FALSE, - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - checkmate::assert_number(select1, lower = 1, upper = length(data)) - checkmate::assert_number(select2, lower = 1, upper = length(data)) - choices <- c("pval1", "pval2") - checkmate::assert_choice(color_by, choices) - - # ---------------------------- data preparation ----------------------------- - data_red <- list(data[[select1]], data[[select2]]) - - for (i in 1:length(data_red)) { - colnames(data_red[i][[1]]) <- c( - paste("logFC", i, sep = ""), - paste("pval", i, sep = "") - ) - } - - # ------------------- creation of the resulting qq plot --------------------- - x <- data_red[1][[1]]$logFC - y <- data_red[2][[1]]$logFC - pval1 <- data_red[1][[1]]$pval - pval2 <- data_red[2][[1]]$pval - names(x) <- row.names(data_red[1][[1]]) - names(y) <- row.names(data_red[2][[1]]) - - sx_idx <- order(x) - sy_idx <- order(y) - - sx <- x[sx_idx] - sy <- y[sy_idx] - pval1 <- pval1[sx_idx] - pval2 <- pval2[sy_idx] - - lenx <- length(sx) - leny <- length(sy) - - if (leny < lenx) { - sx <- stats::approx(1L:lenx, sx, n = leny)$y - pval1 <- stats::approx(1L:lenx, pval1, n = leny)$y - } - if (leny > lenx) { - sy <- stats::approx(1L:leny, sy, n = lenx)$y - pval2 <- stats::approx(1L:leny, pval2, n = lenx)$y - } - - qq <- data.frame(x = sx, y = sy, pval1 = pval1, pval2 = pval2) - - qq_f <- qq[qq$pval1 <= pthresh | qq$pval2 <= pthresh, ] - - if (length(qq_f[[1]]) == 0 || length(qq_f[[2]]) == 0) { - return(NULL) - } - - if (as_line == FALSE) { - res <- ggplot2::ggplot(qq_f, ggplot2::aes(x, y, col = -log10(get(color_by)))) + - ggplot2::geom_point() + - viridis::scale_color_viridis(option = "magma") + - ggplot2::xlab(names(data)[select1]) + - ggplot2::ylab(names(data)[select2]) + - ggplot2::labs(color = paste("-log10(", color_by, ")", sep = "")) + - ggplot2::theme_light() - } else { - res <- ggplot2::ggplot(qq_f, ggplot2::aes(x, y, col = -log10(get(color_by)))) + - ggplot2::geom_line() + - viridis::scale_color_viridis(option = "magma") + - ggplot2::xlab(names(data)[select1]) + - ggplot2::ylab(names(data)[select2]) + - ggplot2::labs(color = paste("-log10(", color_by, ")", sep = "")) + - ggplot2::theme_light() - } - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_qqmult.R b/R/deedee_qqmult.R deleted file mode 100644 index 320e3b0..0000000 --- a/R/deedee_qqmult.R +++ /dev/null @@ -1,84 +0,0 @@ -#' DeeDee QQ Plot with Multiple Contrasts -#' -#' @description `deedee_qqmult` creates a plot containing Q-Q-lines comparing -#' the statistical distribution of the logFC of the genes in each input datasets -#' to a contrast chosen from the input data. For a Q-Q plot comparing two -#' contrasts in a p-value-colored manner, have a look at `deedee_qq`. -#' -#' @param data named list of results from deedee_prepare() -#' @param ref index of the contrast in data to be used as reference contrast -#' (default = 1) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return ggplot object (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' deedee_qqmult(dd_list, pthresh = 0.05, ref = 1) -#' @export -#' - -deedee_qqmult <- function(data, - ref = 1, - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - checkmate::assert_number(ref, lower = 1, upper = length(data)) - - # ------------------- creation of the resulting qq plot --------------------- - output <- list() - nm <- c() - - for (i in 1:length(data)) { - if (i != ref) { - output[[i]] <- data.frame(ggplot2::ggplot_build(deedee_qq( - data = data, - select1 = ref, - select2 = i, - as_line = TRUE - ))$plot$data) - nm[[i]] <- names(data[i]) - } - } - - names(output) <- nm - - res <- ggplot2::ggplot( - dplyr::bind_rows(output, .id = "contrast"), - ggplot2::aes_string("x", "y", colour = "contrast") - ) + - ggplot2::xlab(names(data)[ref]) + - ggplot2::ylab("see legend") + - ggplot2::geom_line() + - ggplot2::theme_light() + - viridis::scale_color_viridis( - option = "magma", discrete = TRUE, - begin = 0, end = 0.9 - ) - - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_scatter.R b/R/deedee_scatter.R deleted file mode 100644 index bb55ba6..0000000 --- a/R/deedee_scatter.R +++ /dev/null @@ -1,96 +0,0 @@ -#' DeeDee logFC Scatter Plot -#' -#' @description `deedee_scatter` creates a scatterplot of the genes in two input -#' datasets based on their logFC values. -#' -#' @param data named list of results from deedee_prepare() -#' @param select1 index of first data-list element to be used (default = 1) -#' @param select2 index of second data-list element to be used (default = 2) -#' @param color_by indicates which set of values the output should be colored by -#' (possible values = `pval1` (default), `pval2`) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return ggplot object (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, -#' IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, -#' Salm_both = Salm_both -#' ) -#' -#' deedee_scatter(dd_list, -#' pthresh = 0.05, select1 = 1, select2 = 2, -#' color_by = "pval1" -#' ) -#' @export -#' - -deedee_scatter <- function(data, - select1 = 1, - select2 = 2, - color_by = "pval1", - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - checkmate::assert_number(select1, lower = 1, upper = length(data)) - checkmate::assert_number(select2, lower = 1, upper = length(data)) - choices <- c("pval1", "pval2") - checkmate::assert_choice(color_by, choices) - - # ---------------------------- data preparation ----------------------------- - data_red <- list(data[[select1]], data[[select2]]) # selected samples - - for (i in 1:length(data_red)) { - data_red[i][[1]] <- subset( - data_red[i][[1]], - data_red[i][[1]]$pval < pthresh - ) - data_red[i][[1]] <- tibble::rownames_to_column(data_red[i][[1]]) - } - comp <- dplyr::inner_join(data_red[1][[1]], - data_red[2][[1]], - by = "rowname", - copy = FALSE - ) - comp <- comp[stats::complete.cases(comp[colnames(comp)]), ] - - names(comp) <- c("rowname", "logFC1", "pval1", "logFC2", "pval2") - - if (length(comp[, 1]) == 0) { - return(NULL) - } - - # ----------------- creation of the resulting scatter plot ------------------ - res <- ggplot2::ggplot(data = comp, ggplot2::aes(logFC1, logFC2, - col = get(color_by) - )) + - ggplot2::geom_point() + - viridis::scale_color_viridis(option = "magma") + - ggplot2::xlab(names(data)[select1]) + - ggplot2::ylab(names(data)[select2]) + - ggplot2::labs(color = color_by) + - ggplot2::theme_light() - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_summary.R b/R/deedee_summary.R deleted file mode 100644 index a3994ba..0000000 --- a/R/deedee_summary.R +++ /dev/null @@ -1,174 +0,0 @@ -#' DeeDee Summary -#' -#' @param deedee_list named list of results from deedee_prepare() -#' @param output_path the path to save the resulting report in. must end with -#' a filename.html (default = "DeeDee_Summary.html" in the -#' working directory) -#' @param overwrite logical value specifying if the output is supposed to -#' overwrite a potential existing file at the location of -#' output_path (default = FALSE) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' @param scatter_select1 index of first data-list element to be used -#' (default = 1) -#' @param scatter_select2 index of second data-list element to be used -#' (default = 2) -#' @param scatter_color_by indicates which set of values the output should be -#' colored by (possible values = `pval1` (default), -#' `pval2`) -#' @param heatmap_show_first indicating the number of genes depicted -#' (default = 25) -#' @param heatmap_show_gene_names boolean, show row names next to heatmap -#' (default = FALSE) -#' @param heatmap_dist select the distance measure (`euclidean`, `manhattan`, -#' `pearson`, `spearman`) -#' @param heatmap_clust select the clustering method (`single`, `complete`, -#' `average`, `centroid`) -#' @param heatmap_show_na boolean, include genes with NA values in heatmap -#' (default = FALSE) -#' @param venn_mode show all overlapping DE genes (`both`, default), -#' only conjointly up-regulated (`up`) -#' or only conjointly down-regulated (`down`) genes -#' @param upset_mode show all overlapping DE genes (`both`), -#' all overlapping genes colored by DE direction -#' (`both_colored`, default), -#' only conjointly up-regulated (`up`) -#' or only conjointly down-regulated (`down`) genes -#' @param upset_min_setsize the minimum size of intersections to be displayed in -#' the UpSet plot (default = 10) -#' @param qqmult_ref index of the contrast in data to be used as reference -#' contrast (default = 1) -#' @param cat_ref index of the contrast in data to be used as reference contrast -#' (default = 1) -#' @param cat_maxrank highest rank that should be displayed (default = 1000) -#' @param cat_mode sort by highest logFC (`up`, default), lowest logFC (`down`) -#' or greatest deviation from zero (`both`) -#' @param silent logical, specifying if success message shall be suppressed -#' (default = FALSE) -#' @param open_file logical, specifying if the output file is supposed to be -#' opened after successful creation (default = TRUE) -#' -#' @return Creates a html document containing the results of running the DeeDee -#' functions on your input data and params. TODO where -#' -#' @export -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' \dontrun{ -#' deedee_summary(dd_list) -#' } -#' -deedee_summary <- function(deedee_list, - output_path = "DeeDee_Summary.html", - overwrite = FALSE, - pthresh = 0.05, - scatter_select1 = 1, - scatter_select2 = 2, - scatter_color_by = "pval1", - heatmap_show_first = 25, - heatmap_show_gene_names = FALSE, - heatmap_dist = "euclidean", - heatmap_clust = "average", - heatmap_show_na = FALSE, - venn_mode = "both", - upset_mode = "both_colored", - upset_min_setsize = 10, - qqmult_ref = 1, - cat_ref = 1, - cat_maxrank = 1000, - cat_mode = "up", - silent = FALSE, - open_file = TRUE) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(deedee_list, type = "data.frame", min.len = 2) - for (i in 1:length(deedee_list)) { - checkmate::assert_data_frame(deedee_list[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - - checkmate::assert_logical(overwrite) - - checkmate::assert_number(scatter_select1, lower = 1, upper = length(deedee_list)) - checkmate::assert_number(scatter_select2, lower = 1, upper = length(deedee_list)) - choices <- c("pval1", "pval2") - checkmate::assert_choice(scatter_color_by, choices) - - checkmate::assert_number(heatmap_show_first, lower = 1) - checkmate::assert_logical(heatmap_show_gene_names) - choices1 <- c("euclidean", "manhattan", "pearson", "spearman") - checkmate::assert_choice(heatmap_dist, choices1) - choices2 <- c("single", "complete", "average", "centroid") - checkmate::assert_choice(heatmap_clust, choices2) - checkmate::assert_logical(heatmap_show_na) - - choices <- c("up", "down", "both") - checkmate::assert_choice(venn_mode, choices) - - choices <- c("up", "down", "both", "both_colored") - checkmate::assert_choice(upset_mode, choices) - checkmate::assert_number(upset_min_setsize, lower = 0) - - checkmate::assert_number(qqmult_ref, lower = 1, upper = length(deedee_list)) - - checkmate::assert_number(cat_ref, lower = 1, upper = length(deedee_list)) - checkmate::assert_number(cat_maxrank, lower = 1) - choices <- c("up", "down", "both") - checkmate::assert_choice(cat_mode, choices) - - # ---------------------------- R Markdown output ----------------------------- - template <- system.file("extdata", - "summary_template.Rmd", - package = "DeeDee" - ) - - if (file.exists(output_path)) { - if (!overwrite) { - stop("Your declared output file already exists. ", - "Set overwrite = TRUE to proceed anyway.", - call. = FALSE - ) - } - } - - output_rmd <- paste(unlist(strsplit(output_path, - split = ".", - fixed = TRUE - ))[1], ".Rmd", sep = "") - - file.copy(from = template, to = output_rmd, overwrite = TRUE) - - args <- list() - args$input <- output_rmd - args$output_format <- "html_document" - args$output_path <- output_path - - output_path <- rmarkdown::render(output_rmd, - params = args - ) - if (open_file == TRUE) { - utils::browseURL(output_path) - } - - file.remove(output_rmd) - - if (silent == FALSE) { - print("Your summary has been generated!") - } -} diff --git a/R/deedee_upset.R b/R/deedee_upset.R deleted file mode 100644 index dea6f44..0000000 --- a/R/deedee_upset.R +++ /dev/null @@ -1,161 +0,0 @@ -#' DeeDee UpSet Plot -#' -#' @description `deedee_upset` creates an UpSet plot depicting the overlaps of -#' differentially expressed genes in the input datasets. -#' -#' @param data named list of results from deedee_prepare() -#' @param mode show all overlapping DE genes (`both`), -#' all overlapping genes colored by DE direction (`both_colored`, -#' default), -#' only conjointly up-regulated (`up`) -#' or only conjointly down-regulated (`down`) genes -#' @param min_setsize the minimum size of intersections to be displayed in the -#' UpSet plot (default = 10) -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return upset element (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' deedee_upset(dd_list, pthresh = 0.05, mode = "both_colored", min_setsize = 10) -#' @export -#' - -deedee_upset <- function(data, - mode = "both_colored", - min_setsize = 10, - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - choices <- c("up", "down", "both", "both_colored") - checkmate::assert_choice(mode, choices) - checkmate::assert_number(min_setsize, lower = 0) - - # ---------------------------- data preparation ----------------------------- - for (i in 1:length(data)) { - data[i][[1]] <- subset(data[i][[1]], data[i][[1]]$pval < pthresh) # pthresh - - if (length(data[i][[1]][[1]]) == 0) { - return(NULL) - } - - data[i][[1]] <- data[i][[1]]["logFC"] # removing p-value column - data[i][[1]]$logFC[data[i][[1]]$logFC < 0] <- -1 # 1/0/-1 distinction - data[i][[1]]$logFC[data[i][[1]]$logFC > 0] <- 1 - - if (mode == "both" || mode == "both_colored") { - data[i][[1]] <- subset(data[i][[1]], data[i][[1]]$logFC != 0) - } - - if (mode == "up") { - data[i][[1]] <- subset(data[i][[1]], data[i][[1]]$logFC == 1) - } - - if (mode == "down") { - data[i][[1]] <- subset(data[i][[1]], data[i][[1]]$logFC == -1) - } - data[i][[1]] <- tibble::rownames_to_column(data[i][[1]]) - names(data[i][[1]]) <- c("rowname", names(data[i])) - } - - comp <- dplyr::full_join(data[1][[1]], data[2][[1]], - by = "rowname", - copy = FALSE - ) - - if (length(data) > 2) { - for (i in 3:length(data)) { - comp <- dplyr::full_join(comp, data[i][[1]], by = "rowname", copy = FALSE) - } - } - comp <- tibble::column_to_rownames(comp) - contrasts <- colnames(comp) - - # -------------------------------- coloring --------------------------------- - if (mode == "both_colored") { - count <- vector(mode = "numeric", length = length(comp[[1]])) - comp <- cbind(comp, count) - comp["count"] <- rowSums(comp, na.rm = TRUE) - - na_count <- vector(mode = "numeric", length = length(comp[[1]])) - comp <- cbind(comp, na_count) - comp["na_count"] <- rowSums(is.na(comp)) - - dr <- vector(mode = "character", length = length(comp[[1]])) - comp <- cbind(comp, dr) - - nsets <- length(data) - - for (i in 1:length(comp[[1]])) { - if ((comp[i, "count"] + comp[i, "na_count"]) == nsets) { - comp[i, "dr"] <- "up" - } else if ((comp[i, "count"] - comp[i, "na_count"]) == -nsets) { - comp[i, "dr"] <- "down" - } else { - comp[i, "dr"] <- "different" - } - } - - comp <- subset(comp, select = -c(count, na_count)) - comp[is.na(comp)] <- FALSE - comp[comp == -1 | comp == 1] <- TRUE - } - - # ------------------ creation of the resulting UpSet plot ------------------- - if (mode == "both_colored") { - col_up <- viridis::viridis(n = 1, begin = 0.4, option = "magma") - col_down <- viridis::viridis(n = 1, begin = 0.9, option = "magma") - res <- ComplexUpset::upset(comp, - contrasts, - guide = NULL, - base_annotations = list( - "Intersection of genes" = ComplexUpset::intersection_size( - counts = FALSE, - mapping = ggplot2::aes(fill = dr) - ) - + ggplot2::scale_fill_manual( - values = c( - "different" = "dark grey", - "down" = col_down, - "up" = col_up - ), - name = "Regulation direction" - ) - ), - width_ratio = 0.1, - min_size = min_setsize - ) - } else { - comp <- (comp != 0 & !is.na(comp)) - comp <- as.data.frame(comp) - res <- ComplexUpset::upset(comp, - contrasts, - guide = NULL - ) - } - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/deedee_venn.R b/R/deedee_venn.R deleted file mode 100644 index 0037319..0000000 --- a/R/deedee_venn.R +++ /dev/null @@ -1,96 +0,0 @@ -#' DeeDee Venn Diagram -#' -#' @description `deedee_venn` creates a Venn diagram depicting the overlaps of -#' differentially expressed genes in the input datasets. -#' -#' @param data named list of results from deedee_prepare() -#' @param mode show all overlapping DE genes (`both`, default), -#' only conjointly up-regulated (`up`) -#' or only conjointly down-regulated (`down`) genes -#' @param pthresh threshold for p-values to be in-/excluded (default = 0.05) -#' -#' @return ggplot object (plottable with show()/print()) -#' -#' @examples -#' -#' data(DE_results_IFNg_naive, package = "DeeDee") -#' IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") -#' -#' data(DE_results_IFNg_both, package = "DeeDee") -#' IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") -#' -#' data(DE_results_Salm_naive, package = "DeeDee") -#' Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") -#' -#' data(DE_results_Salm_both, package = "DeeDee") -#' Salm_both <- deedee_prepare(Salm_both, "DESeq2") -#' -#' dd_list <- list( -#' IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, -#' Salm_naive = Salm_naive, Salm_both = Salm_both -#' ) -#' -#' # deedee_venn(dd_list, pthresh = 0.05, mode = "both") -#' @export -#' - -deedee_venn <- function(data, - mode = "both", - pthresh = 0.05) { - - # ----------------------------- argument check ------------------------------ - checkmate::assert_list(data, type = "data.frame", min.len = 2) # , max.len = 4) - for (i in 1:length(data)) { - checkmate::assert_data_frame(data[[i]], type = "numeric") - } - checkmate::assert_number(pthresh, lower = 0, upper = 1) - choices <- c("up", "down", "both") - checkmate::assert_choice(mode, choices) - - # ---------------------------- data preparation ----------------------------- - for (i in 1:length(data)) { - data[i][[1]] <- subset( - data[i][[1]], - data[i][[1]]$pval < pthresh - ) - - if (length(data[i][[1]][[1]]) == 0) { - return(NULL) - } - - if (mode == "up") { - data[i][[1]] <- subset( - data[i][[1]], - data[i][[1]]$logFC > 0 - ) - } - if (mode == "down") { - data[i][[1]] <- subset( - data[i][[1]], - data[i][[1]]$logFC < 0 - ) - } - data[i][[1]] <- data[i][[1]]["logFC"] # removing p-value column - colnames(data[i][[1]]) <- c(paste("logFC", i, sep = "")) - data[i][[1]] <- as.matrix(data[i][[1]]) # conversion to matrix - names <- rownames(data[i][[1]]) - data[i][[1]] <- as.vector(data[i][[1]]) # conversion to vector - names(data[i][[1]]) <- names - data[i][[1]] <- sort(data[i][[1]], decreasing = TRUE) - data[i][[1]] <- names(data[i][[1]]) - } - - # ----------------- creation of the resulting venn diagram ------------------ - pal <- c(viridis::viridis(length(data), option = "magma")) - - res <- ggvenn::ggvenn(data, - fill_alpha = 0.2, - fill_color = pal, - show_percentage = FALSE, - stroke_color = "grey80", - set_name_size = 4 - ) - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/input_infobox.R b/R/input_infobox.R deleted file mode 100644 index 5e54e62..0000000 --- a/R/input_infobox.R +++ /dev/null @@ -1,89 +0,0 @@ - -input_infobox <- function(deedee_obj, - sets, - md) { - - ext <- c() - filename <- c() - res <- list() - type <- c() - contrast <- c() - genes <- c() - count <- 0 - - if (!is.null(deedee_obj)) { - for (j in 1:length(deedee_obj@DeeDeeList)) { - count <- count + 1 - type[count] <- "DeeDee object" - filename[count] <- "input as argument" - contrast[count] <- names(deedee_obj@DeeDeeList)[j] - genes[count] <- length(deedee_obj@DeeDeeList[j] - [[contrast[count]]][["logFC"]]) - } - } - - # reading out input files - if (length(sets[, 1] > 0)) { - for (i in 1:(length(sets[, 1]))) { - ext[i] <- tools::file_ext(sets[i, "datapath"]) - - if (ext[[i]] == "rds" || ext[[i]] == "RDS") { - res[[i]] <- readRDS(sets[[i, "datapath"]]) - } else if (ext[[i]] == "xlsx") { - sheets <- readxl::excel_sheets(sets[[i, "datapath"]]) - res[[i]] <- lapply(sheets, - readxl::read_excel, - path = sets[[i, "datapath"]] - ) - names(res[[i]]) <- sheets - for (j in 1:length(sheets)) { - res[[i]][[sheets[j]]] <- as.data.frame(res[[i]][[sheets[j]]]) - res[[i]][[sheets[j]]] <- tibble::column_to_rownames( - res[[i]][[sheets[j]]], "rowname" - ) - } - } else if (ext[[i]] == "txt") { - temp <- utils::read.table(sets[[i, "datapath"]]) - res[[i]] <- list(temp) - names(res[[i]]) <- unlist(strsplit(sets[i, "name"], - split = ".", - fixed = TRUE - ))[1] - } - - if (class(res[[i]]) == "DESeqResults" || - class(res[[i]]) == "DGEExact" || - length(names(res[[i]])) == 6 || - class(res[[i]]) == "DeeDeeObject") { - count <- count + 1 - type[count] <- class(res[[i]]) - filename[count] <- sets[i, "name"] - contrast[count] <- unlist(strsplit(filename[count], - split = ".", - fixed = TRUE - ))[1] - genes[count] <- length(md@DeeDeeList - [[contrast[count]]][["logFC"]]) - } else { - if (class(res[[i]]) == "data.frame") { - res[[i]] <- list(res[[i]]) - names(res[[i]]) <- unlist(strsplit(sets[i, "name"], - split = ".", - fixed = TRUE - ))[1] - } - for (j in 1:length(res[[i]])) { - count <- count + 1 - type[count] <- "DeeDee object" - filename[count] <- sets[i, "name"] - contrast[count] <- names(res[[i]])[j] - genes[count] <- length(res[[i]][j] - [[contrast[count]]][["logFC"]]) - } - } - } - } - - df <- data.frame(filename, type, contrast, genes) - return(df) -} diff --git a/R/ora.R b/R/ora.R deleted file mode 100644 index 0979875..0000000 --- a/R/ora.R +++ /dev/null @@ -1,32 +0,0 @@ - -ora <- function(geneList, - universe, - orgDB, - key_type) { - - # ---------------------------- data preparation ----------------------------- - genes <- geneList[1] - genes <- row.names(genes) - genes <- genes[!is.na(genes)] - - universe[[1]] <- tibble::rownames_to_column(universe[[1]]) - universe[[2]] <- tibble::rownames_to_column(universe[[2]]) - univ <- dplyr::inner_join(universe[[1]], universe[[2]], by = "rowname") - univ <- univ[["rowname"]] - - # ---------------------------------- GSEA ----------------------------------- - res <- clusterProfiler::enrichGO( - gene = genes, - universe = univ, - OrgDb = get(orgDB), - ont = "BP", - keyType = key_type, - pAdjustMethod = "BH", - pvalueCutoff = 0.01, - qvalueCutoff = 0.05, - readable = TRUE - ) - - # --------------------------------- return ---------------------------------- - return(res) -} diff --git a/R/rds_input.R b/R/rds_input.R deleted file mode 100644 index 012ddfd..0000000 --- a/R/rds_input.R +++ /dev/null @@ -1,67 +0,0 @@ - -rds_input <- function(obj, - nm) { - - if (class(obj) == "DeeDeeObject") { - obj <- obj@DeeDeeList - } - if (class(obj) == "DESeqResults") { - obj <- deedee_prepare(obj, "DESeq2") - obj <- list(obj) - names(obj) <- unlist(strsplit(nm, - split = ".", - fixed = TRUE - ))[1] - } else if (class(obj) == "DGEExact") { - obj <- deedee_prepare(obj, "edgeR") - obj <- list(obj) - names(obj) <- unlist(strsplit(nm, - split = ".", - fixed = TRUE - ))[1] - } else if (class(obj) == "list") { - for (j in length(obj)) { - if (checkmate::test_subset( - names(obj[[j]]), - c("logFC", "pval") - ) == FALSE) { - return(NULL) - } - } - } else if (class(obj) == "data.frame") { - if (length(obj) == 2) { - if (checkmate::test_subset( - names(obj), - c("logFC", "pval") - ) == FALSE) { - return(NULL) - } - obj <- list(obj) - names(obj) <- unlist(strsplit(nm, - split = ".", - fixed = TRUE - ))[1] - } else if (length(obj) == 6) { - if (checkmate::test_subset(names(obj), c( - "logFC", - "AveExpr", - "t", - "P.Value", - "adj.P.Val", - "B" - )) == FALSE) { - return(NULL) - } - obj <- deedee_prepare(obj, "limma") - obj <- list(obj) - names(obj) <- unlist(strsplit(nm, - split = ".", - fixed = TRUE - ))[1] - } else { - return(NULL) - } - } - - return(obj) -} diff --git a/R/validity.R b/R/validity.R new file mode 100644 index 0000000..6fedf3d --- /dev/null +++ b/R/validity.R @@ -0,0 +1,43 @@ +validDeeDeeExperiment <- function(object) { + msg <- NULL + + if (!is(dea(object), "list")) { + msg <- c(msg, "'dea' must be a list") + } + + # if (length(dea(object)) == 0) { + # msg <- c(msg, "'dea' must be a non-empty list") + # } + + if (length(dea(object)) > 0) { + if (any(is.null(names(dea(object))))) { + msg <- c(msg, "'dea' must be a named list") + } + + dea_names <- names(dea(object)) + + required_rowdata <- unlist( + lapply( + dea_names, function(arg) + c( + paste0(arg, "_log2FoldChange"), + paste0(arg, "_pvalue"), + paste0(arg, "_padj") + ) + ) + ) + if (!all(required_rowdata %in% colnames(rowData(object)))) { + msg <- c(msg, "some required columns were not found in the rowData") + } + } + + if (is.null(msg)) { + TRUE + } else msg + + +} + +#' @importFrom S4Vectors setValidity2 +S4Vectors::setValidity2("DeeDeeExperiment", validDeeDeeExperiment) + diff --git a/R/xlsx_input.R b/R/xlsx_input.R deleted file mode 100644 index 4cdc6d7..0000000 --- a/R/xlsx_input.R +++ /dev/null @@ -1,35 +0,0 @@ - -xlsx_input <- function(obj, - path, - nm) { - - if (length(obj) > 1) { - out <- lapply(obj, - readxl::read_excel, - path = path - ) - names(out) <- obj - for (j in 1:length(obj)) { - out[[obj[j]]] <- as.data.frame(out[[obj[j]]]) - out[[obj[j]]] <- tibble::column_to_rownames( - out[[obj[j]]], "rowname" - ) - if (checkmate::test_subset( - names(out[[j]]) == FALSE, - c("logFC", "pval") - )) { - return(NULL) - } - } - } else { - out <- readxl::read_excel(path = path) - out <- tibble::column_to_rownames(out, "rowname") - out <- list(out) - names(out) <- unlist(strsplit(nm, - split = ".", - fixed = TRUE - ))[1] - } - return(out) -} - diff --git a/_pkgdown.yml b/_pkgdown.yml new file mode 100644 index 0000000..498fbde --- /dev/null +++ b/_pkgdown.yml @@ -0,0 +1,38 @@ +authors: + Lea Rothörl: + href: https://github.com/lea-rothoerl + Federico Marini: + href: https://federicomarini.github.io + +template: + params: + bootswatch: cosmo + +navbar: + structure: + left: + - home + - intro + - reference + - articles + - news + right: github + components: + home: + icon: fa-home fa-lg + href: index.html + reference: + text: Reference + href: reference/index.html + articles: + text: Articles + menu: + - text: | + The `DeeDee` User's Guide + href: articles/deedee_manual.html + news: + text: Changelog + href: news/index.html + github: + icon: fab fa-github fa-lg + href: https://github.com/lea-rothoerl/DeeDee diff --git a/data/dd_list_original.RData b/data/dd_list_original.RData new file mode 100644 index 0000000..ee77180 Binary files /dev/null and b/data/dd_list_original.RData differ diff --git a/data/de_named_list.RData b/data/de_named_list.RData new file mode 100644 index 0000000..c787931 Binary files /dev/null and b/data/de_named_list.RData differ diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..33f2568 --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,18 @@ +citHeader("DeeDeeExperiment is described in the following publication:") + +citEntry( + entry = "Article", + title = "TODO", + author = personList( + as.person("Lea Rothörl"), + as.person("Federico Marini")), + journal = "TODO", + year = "TODO", + volume = "TODO", + number = "TODO", + pages = "TODO", + doi = "https://doi.org/TODO", + textVersion = paste0( + "TODO" + ) +) diff --git a/inst/extdata/summary_template.Rmd b/inst/extdata/summary_template.Rmd index a72beae..d1b5edf 100644 --- a/inst/extdata/summary_template.Rmd +++ b/inst/extdata/summary_template.Rmd @@ -15,10 +15,12 @@ always_allow_html: yes --- ```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE, - warning = FALSE, - message = FALSE, - error = TRUE) +knitr::opts_chunk$set( + echo = TRUE, + warning = FALSE, + message = FALSE, + error = TRUE +) ``` ## About this document @@ -27,24 +29,25 @@ This document contains the results of running all main DeeDee functions on your Your contrasts: ```{r echo = TRUE} -names(deedee_list) +dea(dde) ``` - ```{r echo = FALSE, results = FALSE} -library(DeeDee) +library("DeeDee") ``` ## DeeDee scatter plot + ```{r echo = TRUE} - deedee_scatter(data = deedee_list, - pthresh = pthresh, - select1 = scatter_select1, - select2 = scatter_select2, - color_by = scatter_color_by) +deedee_scatter(dde = dde, + pthresh = pthresh, + select1 = scatter_select1, + select2 = scatter_select2, + color_by = scatter_color_by) ``` + Your parameters: * pthresh = `r pthresh` @@ -55,15 +58,17 @@ Your parameters: *** ## DeeDee heatmap + ```{r echo = TRUE} - deedee_heatmap(data = deedee_list, - pthresh = pthresh, - show_first = heatmap_show_first, - show_gene_names = heatmap_show_gene_names, - dist = heatmap_dist, - clust = heatmap_clust, - show_na = heatmap_show_na) +deedee_heatmap(dde = dde, + pthresh = pthresh, + show_first = heatmap_show_first, + show_gene_names = heatmap_show_gene_names, + dist = heatmap_dist, + clust = heatmap_clust, + show_na = heatmap_show_na) ``` + Your parameters: * pthresh = `r pthresh` @@ -76,11 +81,13 @@ Your parameters: *** ## DeeDee Venn diagram + ```{r echo = TRUE} - deedee_venn(data = deedee_list, - pthresh = pthresh, - mode = venn_mode) +deedee_venn(dde = dde, + pthresh = pthresh, + mode = venn_mode) ``` + Your parameters: * pthresh = `r pthresh` @@ -89,12 +96,14 @@ Your parameters: *** ## DeeDee UpSet plot + ```{r echo = TRUE} - deedee_upset(data = deedee_list, - pthresh = pthresh, - mode = upset_mode, - min_setsize = upset_min_setsize) +deedee_upset(dde = dde, + pthresh = pthresh, + mode = upset_mode, + min_setsize = upset_min_setsize) ``` + Your parameters: * pthresh = `r pthresh` @@ -102,12 +111,15 @@ Your parameters: * min_setsize = `r upset_min_setsize` *** + ## DeeDee Q-Q plot + ```{r echo = TRUE} - deedee_qqmult(data = deedee_list, - pthresh = pthresh, - ref = qqmult_ref) +deedee_qqmult(dde = dde, + pthresh = pthresh, + ref = qqmult_ref) ``` + Your parameters: * pthresh = `r pthresh` @@ -116,13 +128,15 @@ Your parameters: *** ## DeeDee CAT plot + ```{r echo = TRUE} - deedee_cat(data = deedee_list, - pthresh = pthresh, - ref = cat_ref, - maxrank = cat_maxrank, - mode = cat_mode) +deedee_cat(dde = dde, + pthresh = pthresh, + ref = cat_ref, + maxrank = cat_maxrank, + mode = cat_mode) ``` + Your parameters: * pthresh = `r pthresh` @@ -133,10 +147,7 @@ Your parameters: *** ## Session info {-} + ```{r} sessionInfo() ``` - - - - diff --git a/inst/scripts/create_datasets_example.R b/inst/scripts/create_datasets_example.R new file mode 100644 index 0000000..a69181a --- /dev/null +++ b/inst/scripts/create_datasets_example.R @@ -0,0 +1,129 @@ +# round 1 ----------------------------------------------------------------- + +library("macrophage") +library("DESeq2") +library("org.Hs.eg.db") +library("AnnotationDbi") +library("dplyr") +library("ggplot2") + +data(gse, "macrophage") +dds_macrophage <- DESeqDataSet(gse, design = ~ line + condition) +rownames(dds_macrophage) <- substr(rownames(dds_macrophage), 1, 15) +dds_macrophage + +se_macrophage <- gse +rownames(se_macrophage) <- substr(rownames(se_macrophage), 1, 15) +se_macrophage + +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rownames(se_macrophage) +) +rownames(se_macrophage_noassays) <- rownames(se_macrophage) + +anno_df <- data.frame( + gene_id = rownames(dds_macrophage), + gene_name = mapIds(org.Hs.eg.db, + keys = rownames(dds_macrophage), + column = "SYMBOL", + keytype = "ENSEMBL" + ), + stringsAsFactors = FALSE, + row.names = rownames(dds_macrophage) +) + +colData(se_macrophage) +rowData(se_macrophage) + +# DE run +keep <- rowSums(counts(dds_macrophage) >= 10) >= 6 +dds_macrophage <- dds_macrophage[keep, ] +dds_unnormalized <- dds_macrophage + + + +dds_macrophage <- DESeq(dds_macrophage) +vst_macrophage <- vst(dds_macrophage) +res_macrophage_IFNg_vs_naive <- results(dds_macrophage, + contrast = c("condition", "IFNg", "naive"), + lfcThreshold = 1, alpha = 0.05 +) +summary(res_macrophage_IFNg_vs_naive) +res_macrophage_IFNg_vs_naive$SYMBOL <- rowData(dds_macrophage)$SYMBOL + +se_macrophage <- se_macrophage[keep, ] +se_macrophage_noassays <- se_macrophage_noassays[keep, ] + +colData(se_macrophage) +rowData(se_macrophage) + +# DE results +IFNg_naive <- results(dds_macrophage, + contrast = c("condition", "IFNg", "naive"), + lfcThreshold = 1, alpha = 0.05 +) + +save(IFNg_naive, file = "data/DE_results_IFNg_naive.RData", compress = "xz") + + +IFNg_both <- results(dds_macrophage, + contrast = c("condition", "IFNg_SL1344", "IFNg"), + lfcThreshold = 1, alpha = 0.05 +) + +save(IFNg_both, file = "data/DE_results_IFNg_both.RData", compress = "xz") + + +Salm_naive <- results(dds_macrophage, + contrast = c("condition", "SL1344", "naive"), + lfcThreshold = 1, alpha = 0.05 +) + +save(Salm_naive, file = "data/DE_results_Salm_naive.RData", compress = "xz") + + +Salm_both <- results(dds_macrophage, + contrast = c("condition", "IFNg_SL1344", "SL1344"), + lfcThreshold = 1, alpha = 0.05 +) + +save(Salm_both, file = "data/DE_results_Salm_both.RData", compress = "xz") + + +res_de <- res_macrophage_IFNg_vs_naive +str(res_de) + +data(DE_results_IFNg_naive, package = "DeeDee") +IFNg_naive +data(DE_results_IFNg_both, package = "DeeDee") +IFNg_both +data(DE_results_Salm_naive, package = "DeeDee") +Salm_naive +data(DE_results_Salm_both, package = "DeeDee") +Salm_both + +# for the original object/implementation: +# dd_list_original <- list( +# IFNg_naive = DeeDeeLegacy::deedee_prepare(IFNg_naive, "DESeq2"), +# IFNg_both = DeeDeeLegacy::deedee_prepare(IFNg_both, "DESeq2"), +# Salm_naive = DeeDeeLegacy::deedee_prepare(Salm_naive, "DESeq2"), +# Salm_both = DeeDeeLegacy::deedee_prepare(Salm_both, "DESeq2") +# ) + +# save(dd_list_original, file = "data/dd_list_original.RData", compress = "xz") +data("dd_list_original", package = "DeeDee") + +# for the new version +de_named_list <- list( + ifng_vs_naive = IFNg_naive, + ifngsalmo_vs_naive = IFNg_both, + salmonella_vs_naive = Salm_naive, + salmo_both = Salm_both +) + +# save(de_named_list, file = "data/de_named_list.RData", compress = "xz") +data("de_named_list", package = "DeeDee") + +dde <- DeeDeeExperiment(se_macrophage_noassays, de_results = de_named_list) + diff --git a/man/DeeDee-pkg.Rd b/man/DeeDee-pkg.Rd index c9853ad..3700726 100644 --- a/man/DeeDee-pkg.Rd +++ b/man/DeeDee-pkg.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee-pkg.R +% Please edit documentation in R/DeeDee-pkg.R \docType{package} \name{DeeDee-pkg} \alias{DeeDee-pkg} diff --git a/man/DeeDeeExperiment-methods.Rd b/man/DeeDeeExperiment-methods.Rd new file mode 100644 index 0000000..5de0f3b --- /dev/null +++ b/man/DeeDeeExperiment-methods.Rd @@ -0,0 +1,95 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDeeExperiment-methods.R +\name{DeeDeeExperiment-methods} +\alias{DeeDeeExperiment-methods} +\alias{dea} +\alias{dea<-} +\alias{add_dea} +\alias{remove_dea} +\alias{get_dea_df} +\alias{get_dea_list} +\alias{dea,DeeDeeExperiment-method} +\alias{dea<-,DeeDeeExperiment,list-method} +\alias{add_dea,DeeDeeExperiment,list-method} +\alias{remove_dea,DeeDeeExperiment,character-method} +\alias{get_dea_df,DeeDeeExperiment,character-method} +\alias{get_dea_list,DeeDeeExperiment-method} +\title{Methods for \link{DeeDeeExperiment} objects} +\usage{ +\S4method{dea}{DeeDeeExperiment}(x) + +\S4method{dea}{DeeDeeExperiment,list}(x) <- value + +\S4method{add_dea}{DeeDeeExperiment,list}(x, dea) + +\S4method{remove_dea}{DeeDeeExperiment,character}(x, dea_name) + +\S4method{get_dea_df}{DeeDeeExperiment,character}(x, dea_name) + +\S4method{get_dea_list}{DeeDeeExperiment}(x) +} +\arguments{ +\item{x}{A \code{\link[=DeeDeeExperiment]{DeeDeeExperiment()}} object} + +\item{value}{Replacement value for replacement methods.} + +\item{dea}{A named list of DE results, in any of the formats supported by +the \code{DeeDee} package (currently: results from DESeq2, edgeR, limma).} + +\item{dea_name}{Character value, specifying the name of the DE analysis to +get or remove} +} +\value{ +Return value varies depending on the individual methods, as described +below. +} +\description{ +The \code{\link[=DeeDeeExperiment]{DeeDeeExperiment()}} class provides a family of methods to get +and set DE-related information in \link{DeeDeeExperiment} objects. +} +\details{ +\itemize{ +\item \code{dea} and \verb{dea<-} are the methods to get and set the \code{dea} information as a +whole. These methods return \code{DeeDeeExperiment} objects. +\item \code{add_dea} and \code{remove_dea} are used to respectively add or remove DE-results +items. These methods also return \code{DeeDeeExperiment} objects, with updated +content in the \code{dea} slot. +\item \code{get_dea_df} and \code{get_dea_list} retrieve the \code{dea} information and provide +this as a \code{DataFrame} object (for a specific analysis) or as a list, with one +element for each reported analysis. +\item \code{show} is the method to nicely print out the information of a \code{DeeDeeExperiment} +object. +} +} +\examples{ +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) + +# creating a `DeeDeeExperiment` +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) +dde + +new_del <- list( + ifng2 = de_named_list$ifng_vs_naive, + ifngsalmo2 = de_named_list$ifngsalmo_vs_naive +) + +# add a new (set of) DE result(s) +dde_new <- add_dea(dde, new_del) +dde_new + +# removing DEAs +dde_removed <- remove_dea(dde, "ifng_vs_naive") +dde_removed +} diff --git a/man/DeeDeeExperiment-misc.Rd b/man/DeeDeeExperiment-misc.Rd new file mode 100644 index 0000000..a70e29b --- /dev/null +++ b/man/DeeDeeExperiment-misc.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDeeExperiment-methods.R +\name{DeeDeeExperiment-misc} +\alias{DeeDeeExperiment-misc} +\alias{show,DeeDeeExperiment-method} +\title{Miscellaneous DeeDeeExperiment methods} +\usage{ +\S4method{show}{DeeDeeExperiment}(object) +} +\arguments{ +\item{object}{a \code{\link{DeeDeeExperiment}} object} +} +\value{ +Returns NULL +} +\description{ +Miscellaneous methods for the \code{\link{DeeDeeExperiment}} class and its +descendants that do not fit into any other documentation category such as, +for example, show methods. +} diff --git a/man/DeeDeeExperiment.Rd b/man/DeeDeeExperiment.Rd new file mode 100644 index 0000000..946be66 --- /dev/null +++ b/man/DeeDeeExperiment.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R, R/DeeDeeExperiment.R +\docType{class} +\name{DeeDeeExperiment-class} +\alias{DeeDeeExperiment-class} +\alias{DeeDeeExperiment} +\title{The DeeDeeExperiment class} +\usage{ +DeeDeeExperiment(se = NULL, de_results = NULL) +} +\arguments{ +\item{se}{A \code{SummarizedExperiment} object, that will be used as a scaffold to +store the DE related information.} + +\item{de_results}{A named list of DE results, in any of the formats supported by +the \code{DeeDee} package (currently: results from DESeq2, edgeR, limma).} +} +\value{ +A \code{DeeDeeExperiment} object. +} +\description{ +The \code{DeeDeeExperiment} class is designed to represent +It inherits from the SummarizedExperiment class, and additionally stores +DE-related information via dedicated slots and \code{colData}. +} +\details{ +The \code{se} parameter can be optionally left unspecified. If this is the case, +the resulting \code{DeeDeeExperiment} object will contain as features the ones +specified by the provided components of the object supplied via the +\code{de_results} parameter. + +The conversion of the components of the \code{de_results} list will be handled via +conversion functions to uniform the names and set of information which will +be stored in the returned \code{DeeDeeExperiment} object. +The names of the list will be used to define the \code{contrasts} for the different +DE analyses included, which will determine the way to access the information +stored in the \code{dea} slot of the \code{DeeDeeExperiment} object + +Since a \code{DeeDeeExperiment} is also a \code{SummarizedExperiment} object, it can be +seamlessly provided downstream for visualization and in-depth exploration to +packages such as \code{iSEE} or similar. +} +\section{Slots}{ + +\describe{ +\item{\code{dea}}{This slot is designed to hold the DE-related information. This is +internally being created upon importing from the list of DE results objects, +provided when instantiating the \link{DeeDeeExperiment}.} +}} + +\examples{ +data("de_named_list", package = "DeeDee") + +dde_onlyde <- DeeDeeExperiment( + de_results = de_named_list +) + +# or, with a SE object as support - even without assay data available +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) + +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) +} +\author{ +Lea Rothörl and Federico Marini +} diff --git a/man/DeeDeeObject-class.Rd b/man/DeeDeeObject-class.Rd deleted file mode 100644 index cb41b55..0000000 --- a/man/DeeDeeObject-class.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DeeDeeObject.R -\docType{class} -\name{DeeDeeObject-class} -\alias{DeeDeeObject-class} -\alias{DeeDeeObject} -\title{DeeDeeObject (S4 class)} -\description{ -DeeDeeObject is the format that the DeeDee App works on. It -holds a slot for your list of DeeDee tables. More functionality -to come. -} -\section{Slots}{ - -\describe{ -\item{\code{DeeDeeList}}{} -}} - -\examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both -) - -# obj <- DeeDeeObject(DeeDeeList = dd_list) - -} diff --git a/man/IFNg_both.Rd b/man/IFNg_both.Rd index b444db9..42ec6f4 100644 --- a/man/IFNg_both.Rd +++ b/man/IFNg_both.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee-data.R +% Please edit documentation in R/DeeDee-data.R \docType{data} \name{IFNg_both} \alias{IFNg_both} \title{A sample \code{DESeqResults} object} +\value{ +A sample \code{DESeqResults} object, generated with \code{DESeq2} +} \description{ A sample \code{DESeqResults} object, generated with \code{DESeq2} } diff --git a/man/IFNg_naive.Rd b/man/IFNg_naive.Rd index 47f6bc4..2d12ddd 100644 --- a/man/IFNg_naive.Rd +++ b/man/IFNg_naive.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee-data.R +% Please edit documentation in R/DeeDee-data.R \docType{data} \name{IFNg_naive} \alias{IFNg_naive} \title{A sample \code{DESeqResults} object} +\value{ +A sample \code{DESeqResults} object, generated with \code{DESeq2} +} \description{ A sample \code{DESeqResults} object, generated with \code{DESeq2} } diff --git a/man/Salm_both.Rd b/man/Salm_both.Rd index f0d1280..b2eea7c 100644 --- a/man/Salm_both.Rd +++ b/man/Salm_both.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee-data.R +% Please edit documentation in R/DeeDee-data.R \docType{data} \name{Salm_both} \alias{Salm_both} \title{A sample \code{DESeqResults} object} +\value{ +A sample \code{DESeqResults} object, generated with \code{DESeq2} +} \description{ A sample \code{DESeqResults} object, generated with \code{DESeq2} } diff --git a/man/Salm_naive.Rd b/man/Salm_naive.Rd index 7e1d2e3..3502bed 100644 --- a/man/Salm_naive.Rd +++ b/man/Salm_naive.Rd @@ -1,9 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee-data.R +% Please edit documentation in R/DeeDee-data.R \docType{data} \name{Salm_naive} \alias{Salm_naive} \title{A sample \code{DESeqResults} object} +\value{ +A sample \code{DESeqResults} object, generated with \code{DESeq2} +} \description{ A sample \code{DESeqResults} object, generated with \code{DESeq2} } diff --git a/man/dd_list_original.Rd b/man/dd_list_original.Rd new file mode 100644 index 0000000..d34ed39 --- /dev/null +++ b/man/dd_list_original.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDee-data.R +\docType{data} +\name{dd_list_original} +\alias{dd_list_original} +\title{dd_list_original} +\value{ +A list of DE results +} +\description{ +A list of \code{deedee_prepare}d DE results. +} +\details{ +documented creation in ... script +} diff --git a/man/de_named_list.Rd b/man/de_named_list.Rd new file mode 100644 index 0000000..22ee207 --- /dev/null +++ b/man/de_named_list.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDee-data.R +\docType{data} +\name{de_named_list} +\alias{de_named_list} +\title{de_named_list} +\value{ +A named list of DE results, in their original format +} +\description{ +A named list of DE results, in their original format (from DESeq2, edgeR or limma) +} +\details{ +documented creation in the \code{create_dataset_example.R} script in the +\code{scripts} package folder +} diff --git a/man/deedee_app.Rd b/man/deedee_app.Rd index af200f1..b92292d 100644 --- a/man/deedee_app.Rd +++ b/man/deedee_app.Rd @@ -1,13 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_app.R +% Please edit documentation in R/DeeDee-app.R \name{deedee_app} \alias{deedee_app} \title{DeeDee App} \usage{ -deedee_app(deedee_obj = NULL) +deedee_app(deedee_obj = NULL, dde = NULL) } \arguments{ -\item{deedee_obj}{An object of the class DeeDeeObject to be analyzed.} +\item{deedee_obj}{An object of the class DeeDeeExperiment to be analyzed.} + +\item{dde}{An object of the class DeeDeeExperiment to be analyzed.} } \value{ A shiny app @@ -18,25 +20,28 @@ the functionalities of all other DeeDee functions with a user-friendly graphical user interface. } \examples{ +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage ) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) +dde + +if (interactive()) { + deedee_app(dde = dde) +} +# one can provide the DeeDeeExperiment object also at runtime if (interactive()) { - deedee_app(dd_list) + deedee_app() } } diff --git a/man/deedee_bars.Rd b/man/deedee_bars.Rd new file mode 100644 index 0000000..95a7c5d --- /dev/null +++ b/man/deedee_bars.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDee_bars.R +\name{deedee_bars} +\alias{deedee_bars} +\title{Title} +\usage{ +deedee_bars(dde, p_thresh = 0.05, show_DEnumbers = TRUE) +} +\arguments{ +\item{dde}{A \link{DeeDeeExperiment} object.} + +\item{p_thresh}{Numeric value, corresponding to the threshold used to call a +feature as differentially expressed.} + +\item{show_DEnumbers}{Logical value;} +} +\value{ +A \code{ggplot} plot object, summarizing the amount of DE genes in each +comparison performed. +} +\description{ +Title +} +\examples{ +data("de_named_list", package = "DeeDee") +library(SummarizedExperiment) + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) +dde + +deedee_bars(dde) +} diff --git a/man/deedee_cat.Rd b/man/deedee_cat.Rd index 3782ebf..543ff9f 100644 --- a/man/deedee_cat.Rd +++ b/man/deedee_cat.Rd @@ -1,51 +1,49 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_cat.R +% Please edit documentation in R/DeeDee_cat.R \name{deedee_cat} \alias{deedee_cat} -\title{DeeDee Concordance At the Top Plot} +\title{deedee_cat} \usage{ -deedee_cat(data, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) +deedee_cat(dde, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{ref}{index of the contrast in data to be used as reference contrast -(default = 1)} +\item{ref}{A numeric value, corresponding to the order of the element in the +\code{dde} object to be used as a reference.} -\item{maxrank}{highest rank that should be displayed (default = 1000)} +\item{maxrank}{A numeric value. Indicates the maximum ranked feature to +include when computing the Concordance At the Top. Defaults to 1000.} -\item{mode}{sort by highest logFC (\code{up}, default), lowest logFC (\code{down}) or -greatest deviation from zero (\code{both})} +\item{mode}{A character value, could be one of "up", "down", or "both". Defines +which features to include in the computations. Defaults to "up".} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include. Defaults sensibly to 0.05.} } \value{ -ggplot object (plottable with show()/print()) +A \code{ggplot} plot object. } \description{ -\code{deedee_cat} creates a Concordance at the Top plot depicting -the concordance of genes in the first n elements of the logFC-ranked lists -for the given (non-reference) input contrasts against a chosen reference -contrast from the input list. +CAT plot - Concordance At the Top } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +deedee_cat(dde, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) -deedee_cat(dd_list, ref = 1, maxrank = 1000, mode = "up", pthresh = 0.05) } diff --git a/man/deedee_deheat.Rd b/man/deedee_deheat.Rd new file mode 100644 index 0000000..be0d7cf --- /dev/null +++ b/man/deedee_deheat.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/DeeDee_heatmap.R +\name{deedee_deheat} +\alias{deedee_deheat} +\title{deedee_heatmap(dd_list_original, +pthresh = 0.05, show_first = 25, +show_gene_names = FALSE, dist = "euclidean", +clust = "average", show_na = FALSE +) +Title} +\usage{ +deedee_deheat( + dde, + assay_name = "vst", + pvalue_threshold = 0.05, + logfc_threshold = 5, + custom_genelist = NULL +) +} +\arguments{ +\item{dde}{TODO} + +\item{assay_name}{TODO} + +\item{pvalue_threshold}{TODO} + +\item{logfc_threshold}{TODO} + +\item{custom_genelist}{TODO} +} +\value{ +TODO +} +\description{ +deedee_heatmap(dd_list_original, +pthresh = 0.05, show_first = 25, +show_gene_names = FALSE, dist = "euclidean", +clust = "average", show_na = FALSE +) +Title +} +\examples{ +# TODO +NULL ## TODO: this needs to be fully in +} diff --git a/man/deedee_heatmap.Rd b/man/deedee_heatmap.Rd index 8f7ebf2..ff6b6ea 100644 --- a/man/deedee_heatmap.Rd +++ b/man/deedee_heatmap.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_heatmap.R +% Please edit documentation in R/DeeDee_heatmap.R \name{deedee_heatmap} \alias{deedee_heatmap} -\title{DeeDee Heatmap} +\title{deedee_heatmap} \usage{ deedee_heatmap( - data, + dde, show_first = 25, show_gene_names = FALSE, dist = "euclidean", @@ -15,56 +15,55 @@ deedee_heatmap( ) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{show_first}{indicating the number of genes depicted (default = 25)} +\item{show_first}{Numeric value, specifying the number of features to include. +The ranking is done according to ... TODO} -\item{show_gene_names}{boolean, show row names next to heatmap -(default = FALSE)} +\item{show_gene_names}{Logical value, whether to display the gene names on the +heatmap's side.} -\item{dist}{select the distance measure (\code{euclidean}, \code{manhattan}, \code{pearson}, -\code{spearman})} +\item{dist}{Character value, specifying the distance type to use in the call +to \code{ComplexHeatmap}. Accordingly, it can be a pre-defined character +("euclidean", "maximum", "manhattan", "canberra", "binary", "minkowski", +"pearson", "spearman", "kendall").} -\item{clust}{select the clustering method (\code{single}, \code{complete}, \code{average}, -\code{centroid})} +\item{clust}{Character value. Defines the method to perform hierarchical +clustering, passed to \code{hclust}, as used in \code{ComplexHeatmap}.} -\item{show_na}{boolean, include genes with NA values in heatmap -(default = FALSE)} +\item{show_na}{Logical value, whether to include features that have \code{NA} value +for the log fold change.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -Heatmap object (plottable with show()/print()). The resulting heatmap -(\code{res}) can be opened in a Shiny App with interactive functionality by -running the command \code{ht_shiny(res)} (see package \code{InteractiveComplexHeatmap}). +A plot object generated via the \code{ComplexHeatmap} package. } \description{ -\code{deedee_heatmap} creates a heatmap depicting the logFC as a -measure of the differential expression of the first genes in the given -datasets. +Construct a logFC heatmap on a subset of features } \examples{ +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde -deedee_heatmap(dd_list, - pthresh = 0.05, show_first = 25, - show_gene_names = FALSE, dist = "euclidean", - clust = "average", show_na = FALSE +deedee_heatmap(dde, + pthresh = 0.05, show_first = 25, + show_gene_names = FALSE, dist = "euclidean", + clust = "average", show_na = FALSE ) + } diff --git a/man/deedee_prepare.Rd b/man/deedee_prepare.Rd deleted file mode 100644 index 1e917b6..0000000 --- a/man/deedee_prepare.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_prepare.R -\name{deedee_prepare} -\alias{deedee_prepare} -\title{DeeDee Prepare} -\usage{ -deedee_prepare(data, input_type) -} -\arguments{ -\item{data}{result from DESeq2, limma or edgeR} - -\item{input_type}{the program the data comes from (\code{DESeq2}, \code{limma} or -\code{edgeR})} -} -\value{ -DeeDee table, to be used as part of the input for the other DeeDee -functions -} -\description{ -\code{deedee_prepare} creates a DeeDee table from a DEA result -} -\examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") - -deedee_table <- deedee_prepare(IFNg_naive, "DESeq2") -} diff --git a/man/deedee_qq.Rd b/man/deedee_qq.Rd index 7a77f3c..e95d937 100644 --- a/man/deedee_qq.Rd +++ b/man/deedee_qq.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_qq.R +% Please edit documentation in R/DeeDee_qq.R \name{deedee_qq} \alias{deedee_qq} -\title{DeeDee QQ Plot} +\title{deedee_qq} \usage{ deedee_qq( - data, + dde, select1 = 1, select2 = 2, color_by = "pval1", @@ -14,46 +14,46 @@ deedee_qq( ) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{select1}{index of first data-list element to be used (default = 1)} +\item{select1}{Numeric value, corresponding to the order of the element in the +\code{dde} object to be selected first.} -\item{select2}{index of second data-list element to be used (default = 2)} +\item{select2}{Numeric value, corresponding to the order of the element in the +\code{dde} object to be selected as second.} -\item{color_by}{indicates which set of values the output should be colored by -(possible values = \code{pval1} (default), \code{pval2})} +\item{color_by}{Character value, either "pval1" or "pval2" to color the +individual points mapping them to the p-value of either DE result set.} -\item{as_line}{logical value specifying if the resulting plot should be a -line (TRUE) or points (FALSE, default)} +\item{as_line}{Logical value, whether to plot the Q-Q information as a line - +defaults to FALSE.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -ggplot object (plottable with show()/print()) +A \code{ggplot} plot object. } \description{ -\code{deedee_qq} creates a Q-Q-plot comparing the statistical -distribution of the logFC of the genes in two input datasets. To compare more -than two contrasts against a reference, have a look at \code{deedee_qqmult}. +Q-Q plot for comparing DE analyses } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +deedee_qq(dde) -deedee_qq(dd_list, pthresh = 0.05, select = 1, select2 = 2, color_by = "pval1") } diff --git a/man/deedee_qqmult.Rd b/man/deedee_qqmult.Rd index 9407369..7a512f8 100644 --- a/man/deedee_qqmult.Rd +++ b/man/deedee_qqmult.Rd @@ -1,46 +1,43 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_qqmult.R +% Please edit documentation in R/DeeDee_qqmult.R \name{deedee_qqmult} \alias{deedee_qqmult} -\title{DeeDee QQ Plot with Multiple Contrasts} +\title{deedee_qqmult} \usage{ -deedee_qqmult(data, ref = 1, pthresh = 0.05) +deedee_qqmult(dde, ref = 1, pthresh = 0.05) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{ref}{index of the contrast in data to be used as reference contrast -(default = 1)} +\item{ref}{A numeric value, corresponding to the order of the element in the +\code{dde} object to be used as a reference.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -ggplot object (plottable with show()/print()) +A \code{ggplot} plot object. } \description{ -\code{deedee_qqmult} creates a plot containing Q-Q-lines comparing -the statistical distribution of the logFC of the genes in each input datasets -to a contrast chosen from the input data. For a Q-Q plot comparing two -contrasts in a p-value-colored manner, have a look at \code{deedee_qq}. +Q-Q plot for multiple comparisons of DE analyses } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +deedee_qqmult(dde, pthresh = 0.05, ref = 1) -deedee_qqmult(dd_list, pthresh = 0.05, ref = 1) } diff --git a/man/deedee_scatter.Rd b/man/deedee_scatter.Rd index 95f992c..2206b7d 100644 --- a/man/deedee_scatter.Rd +++ b/man/deedee_scatter.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_scatter.R +% Please edit documentation in R/DeeDee_scatter.R \name{deedee_scatter} \alias{deedee_scatter} -\title{DeeDee logFC Scatter Plot} +\title{deedee_scatter} \usage{ deedee_scatter( - data, + dde, select1 = 1, select2 = 2, color_by = "pval1", @@ -13,47 +13,46 @@ deedee_scatter( ) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{select1}{index of first data-list element to be used (default = 1)} +\item{select1}{Numeric value, corresponding to the order of the element in the +\code{dde} object to be selected first.} -\item{select2}{index of second data-list element to be used (default = 2)} +\item{select2}{Numeric value, corresponding to the order of the element in the +\code{dde} object to be selected as second.} -\item{color_by}{indicates which set of values the output should be colored by -(possible values = \code{pval1} (default), \code{pval2})} +\item{color_by}{Character value, either "pval1" or "pval2" to color the +individual points mapping them to the p-value of either DE result set.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -ggplot object (plottable with show()/print()) +A \code{ggplot} plot object. } \description{ -\code{deedee_scatter} creates a scatterplot of the genes in two input -datasets based on their logFC values. +Scatter plot for the log fold change in the different DE analyses } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, - IFNg_both = IFNg_both, - Salm_naive = Salm_naive, - Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage ) - -deedee_scatter(dd_list, - pthresh = 0.05, select1 = 1, select2 = 2, - color_by = "pval1" +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +deedee_scatter(dde, 1, 3, color_by = "pval2") +deedee_scatter(dde, 1, 2) +deedee_scatter(dde, 1, 4) +deedee_scatter(dde, 3, 2) + } diff --git a/man/deedee_summary.Rd b/man/deedee_summary.Rd index c110422..be088aa 100644 --- a/man/deedee_summary.Rd +++ b/man/deedee_summary.Rd @@ -1,11 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_summary.R +% Please edit documentation in R/DeeDee_summary.R \name{deedee_summary} \alias{deedee_summary} -\title{DeeDee Summary} +\title{deedee_summary} \usage{ deedee_summary( - deedee_list, + dde, + template = system.file("extdata", "summary_template.Rmd", package = "DeeDee"), output_path = "DeeDee_Summary.html", overwrite = FALSE, pthresh = 0.05, @@ -24,105 +25,121 @@ deedee_summary( cat_ref = 1, cat_maxrank = 1000, cat_mode = "up", + render_quiet = TRUE, silent = FALSE, open_file = TRUE ) } \arguments{ -\item{deedee_list}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{output_path}{the path to save the resulting report in. must end with -a filename.html (default = "DeeDee_Summary.html" in the -working directory)} +\item{template}{Character value. Defines the location of the Rmd template to use +for generating the summary} -\item{overwrite}{logical value specifying if the output is supposed to -overwrite a potential existing file at the location of -output_path (default = FALSE)} +\item{output_path}{Character value, name of the file the report will be saved +to. Defaults to \code{DeeDeeSummary.html}, in the current working directory.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{overwrite}{Logical value, whether to overwrite an existing file if +choosing the exact same name.} -\item{scatter_select1}{index of first data-list element to be used -(default = 1)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include. This parameter is shared across +a number of individual \code{DeeDee} functions.} -\item{scatter_select2}{index of second data-list element to be used -(default = 2)} +\item{scatter_select1}{From \code{\link[=deedee_scatter]{deedee_scatter()}} - Numeric value, corresponding +to the order of the element in the dde object to be selected first.} -\item{scatter_color_by}{indicates which set of values the output should be -colored by (possible values = \code{pval1} (default), -\code{pval2})} +\item{scatter_select2}{From \code{\link[=deedee_scatter]{deedee_scatter()}} - Numeric value, corresponding +to the order of the element in the dde object to be selected as second.} -\item{heatmap_show_first}{indicating the number of genes depicted -(default = 25)} +\item{scatter_color_by}{From \code{\link[=deedee_scatter]{deedee_scatter()}} - Character value, either +"pval1" or "pval2" to color the individual points mapping them to the p-value +of either DE result set.} -\item{heatmap_show_gene_names}{boolean, show row names next to heatmap -(default = FALSE)} +\item{heatmap_show_first}{From \code{\link[=deedee_heatmap]{deedee_heatmap()}} - Numeric value, specifying +the number of features to include.} -\item{heatmap_dist}{select the distance measure (\code{euclidean}, \code{manhattan}, -\code{pearson}, \code{spearman})} +\item{heatmap_show_gene_names}{From \code{\link[=deedee_heatmap]{deedee_heatmap()}} - Logical value, +whether to display the gene names on the heatmap's side.} -\item{heatmap_clust}{select the clustering method (\code{single}, \code{complete}, -\code{average}, \code{centroid})} +\item{heatmap_dist}{From \code{\link[=deedee_heatmap]{deedee_heatmap()}} - Character value, specifying the +distance type to use in the call to ComplexHeatmap.} -\item{heatmap_show_na}{boolean, include genes with NA values in heatmap -(default = FALSE)} +\item{heatmap_clust}{From \code{\link[=deedee_heatmap]{deedee_heatmap()}} - Character value. Defines the +method to perform hierarchical clustering, passed to \code{hclust}, as used in +\code{ComplexHeatmap}.} -\item{venn_mode}{show all overlapping DE genes (\code{both}, default), -only conjointly up-regulated (\code{up}) -or only conjointly down-regulated (\code{down}) genes} +\item{heatmap_show_na}{From \code{\link[=deedee_heatmap]{deedee_heatmap()}} - Logical value, whether to +include features that have \code{NA} value for the log fold change.} -\item{upset_mode}{show all overlapping DE genes (\code{both}), -all overlapping genes colored by DE direction -(\code{both_colored}, default), -only conjointly up-regulated (\code{up}) -or only conjointly down-regulated (\code{down}) genes} +\item{venn_mode}{From \code{\link[=deedee_venn]{deedee_venn()}} - Character value, one of "both", "up", +or "down". Specifies which set of features to focus on for the overlap +calculations.} -\item{upset_min_setsize}{the minimum size of intersections to be displayed in -the UpSet plot (default = 10)} +\item{upset_mode}{From \code{\link[=deedee_upset]{deedee_upset()}} - Character value, specifies which +subset of features to include in the overlap computations. +Can be either of the following: "both", "up", "down", or "both_colored".} -\item{qqmult_ref}{index of the contrast in data to be used as reference -contrast (default = 1)} +\item{upset_min_setsize}{From \code{\link[=deedee_upset]{deedee_upset()}} - Numeric value, specifying +the minimal number of observations in an intersection for it to be included +in the upset plot.} -\item{cat_ref}{index of the contrast in data to be used as reference contrast -(default = 1)} +\item{qqmult_ref}{From \code{\link[=deedee_qqmult]{deedee_qqmult()}} - A numeric value, corresponding to +the order of the element in the \code{dde} object to be used as a reference for the +multi Q-Q plot.} -\item{cat_maxrank}{highest rank that should be displayed (default = 1000)} +\item{cat_ref}{From \code{\link[=deedee_cat]{deedee_cat()}} - A numeric value, corresponding to the +order of the element in the dde object to be used as a reference in the CAT +plot.} -\item{cat_mode}{sort by highest logFC (\code{up}, default), lowest logFC (\code{down}) -or greatest deviation from zero (\code{both})} +\item{cat_maxrank}{From \code{\link[=deedee_cat]{deedee_cat()}} - A numeric value. Indicates the +maximum ranked feature to include when computing the Concordance At the Top.} -\item{silent}{logical, specifying if success message shall be suppressed -(default = FALSE)} +\item{cat_mode}{From \code{\link[=deedee_cat]{deedee_cat()}} - A character value, could be one of "up", +"down", or "both". Defines which features to include in the computations.} -\item{open_file}{logical, specifying if the output file is supposed to be -opened after successful creation (default = TRUE)} +\item{render_quiet}{Logical value. Whether to render the report quietly when +calling \code{rmarkdown::render()}.} + +\item{silent}{Logical value, prints a message once completed if set to TRUE.} + +\item{open_file}{Logical value, if set to TRUE opens up the report once +generated into a browser window.} } \value{ -Creates a html document containing the results of running the DeeDee -functions on your input data and params. TODO where +Generates a fully fledged report in the location specified by +\code{output_path}, and returns (invisibly) the name of the generated report. } \description{ -DeeDee Summary +Generates a comprehensive summary on the DE analyses, in one command +} +\details{ +Most parameters in this function call are related to a specific function of the +\code{DeeDee} package. Please refer to the individual help pages for more details, +reminding that the parameter naming scheme is mirroring the pattern +\code{function_parameter}, e.g. \code{scatter_color_by} controlling the \code{color_by} +value in the \code{\link[=deedee_scatter]{deedee_scatter()}} function. } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage ) -\dontrun{ -deedee_summary(dd_list) -} +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) +dde +# deedee_summary(dde) +} +\seealso{ +\code{\link[=deedee_cat]{deedee_cat()}}, \code{\link[=deedee_heatmap]{deedee_heatmap()}}, \code{\link[=deedee_qq]{deedee_qq()}}, \code{\link[=deedee_qqmult]{deedee_qqmult()}}, +\code{\link[=deedee_scatter]{deedee_scatter()}}, \code{\link[=deedee_upset]{deedee_upset()}}, and \code{\link[=deedee_venn]{deedee_venn()}} } diff --git a/man/deedee_upset.Rd b/man/deedee_upset.Rd index 2adc397..06a590c 100644 --- a/man/deedee_upset.Rd +++ b/man/deedee_upset.Rd @@ -1,50 +1,47 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_upset.R +% Please edit documentation in R/DeeDee_upset.R \name{deedee_upset} \alias{deedee_upset} -\title{DeeDee UpSet Plot} +\title{deedee_upset} \usage{ -deedee_upset(data, mode = "both_colored", min_setsize = 10, pthresh = 0.05) +deedee_upset(dde, mode = "both_colored", min_setsize = 10, pthresh = 0.05) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{mode}{show all overlapping DE genes (\code{both}), -all overlapping genes colored by DE direction (\code{both_colored}, -default), -only conjointly up-regulated (\code{up}) -or only conjointly down-regulated (\code{down}) genes} +\item{mode}{Character value, specifies which subset of features to include +in the overlap computations. Can be either of the following: "both", "up", +"down", or "both_colored".} -\item{min_setsize}{the minimum size of intersections to be displayed in the -UpSet plot (default = 10)} +\item{min_setsize}{Numeric value, specifying the minimal number of +observations in an intersection for it to be included in the upset plot.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -upset element (plottable with show()/print()) +A plot object, drawn with the \code{ComplexUpset} package. } \description{ -\code{deedee_upset} creates an UpSet plot depicting the overlaps of -differentially expressed genes in the input datasets. +Upset plot on the sets of DE features for the different analyses included } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +deedee_upset(dde, pthresh = 0.05, mode = "both_colored", min_setsize = 10) -deedee_upset(dd_list, pthresh = 0.05, mode = "both_colored", min_setsize = 10) } diff --git a/man/deedee_venn.Rd b/man/deedee_venn.Rd index fbc07a1..364f2d0 100644 --- a/man/deedee_venn.Rd +++ b/man/deedee_venn.Rd @@ -1,45 +1,44 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/deedee_venn.R +% Please edit documentation in R/DeeDee_venn.R \name{deedee_venn} \alias{deedee_venn} -\title{DeeDee Venn Diagram} +\title{deedee_venn} \usage{ -deedee_venn(data, mode = "both", pthresh = 0.05) +deedee_venn(dde, mode = "both", pthresh = 0.05) } \arguments{ -\item{data}{named list of results from deedee_prepare()} +\item{dde}{A \link{DeeDeeExperiment} object.} -\item{mode}{show all overlapping DE genes (\code{both}, default), -only conjointly up-regulated (\code{up}) -or only conjointly down-regulated (\code{down}) genes} +\item{mode}{Character value, one of "both", "up", or "down". Specifies which +set of features to focus on for the overlap calculations.} -\item{pthresh}{threshold for p-values to be in-/excluded (default = 0.05)} +\item{pthresh}{Numeric value, corresponding to the p-value to use as a +threshold to subset the features to include.} } \value{ -ggplot object (plottable with show()/print()) +A \code{ggplot} plot object. } \description{ -\code{deedee_venn} creates a Venn diagram depicting the overlaps of -differentially expressed genes in the input datasets. +A Venn diagram on the DE features from different analyses } \examples{ - -data(DE_results_IFNg_naive, package = "DeeDee") -IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") - -data(DE_results_IFNg_both, package = "DeeDee") -IFNg_both <- deedee_prepare(IFNg_both, "DESeq2") - -data(DE_results_Salm_naive, package = "DeeDee") -Salm_naive <- deedee_prepare(Salm_naive, "DESeq2") - -data(DE_results_Salm_both, package = "DeeDee") -Salm_both <- deedee_prepare(Salm_both, "DESeq2") - -dd_list <- list( - IFNg_naive = IFNg_naive, IFNg_both = IFNg_both, - Salm_naive = Salm_naive, Salm_both = Salm_both +data("de_named_list", package = "DeeDee") +library("SummarizedExperiment") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list ) +dde + +library("dplyr") ## to have the inner_join, needed by ggvenn +deedee_venn(dde, pthresh = 0.05, mode = "both") -# deedee_venn(dd_list, pthresh = 0.05, mode = "both") } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..ebf4ec2 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/tests.html +# * https://testthat.r-lib.org/reference/test_package.html#special-files + +library(testthat) +library(DeeDee) + +test_check("DeeDee") diff --git a/tests/testthat/setuptests_DeeDee.R b/tests/testthat/setuptests_DeeDee.R new file mode 100644 index 0000000..b74ff94 --- /dev/null +++ b/tests/testthat/setuptests_DeeDee.R @@ -0,0 +1,16 @@ +suppressPackageStartupMessages( + library("SummarizedExperiment") +) + +data("de_named_list", package = "DeeDee") + +rd_macrophage <- DataFrame( + gene_id = rownames(de_named_list$ifng_vs_naive)) +rownames(rd_macrophage) <- rownames(de_named_list$ifng_vs_naive) +se_macrophage_noassays <- SummarizedExperiment( + assays = SimpleList(), + rowData = rd_macrophage +) + +names(de_named_list) + diff --git a/tests/testthat/test-DeeDeeExperiment.R b/tests/testthat/test-DeeDeeExperiment.R new file mode 100644 index 0000000..faf535d --- /dev/null +++ b/tests/testthat/test-DeeDeeExperiment.R @@ -0,0 +1,101 @@ +test_that("creating", { + dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list + ) + + print(dde) + + expect_is(dde, "DeeDeeExperiment") + + dde_only_de <- DeeDeeExperiment( + de_results = de_named_list + ) + expect_is(dde, "DeeDeeExperiment") + + dde_nodd <- DeeDeeExperiment( + se = se_macrophage_noassays, + ) + expect_is(dde_nodd, "DeeDeeExperiment") + + + expect_is( + get_dea_df(dde, "ifng_vs_naive"), "DataFrame" + ) + + expect_error( + get_dea_df(dde, "wrong_name") + ) + + dde_gone_wrong <- dde + rowData(dde_gone_wrong)[["ifng_vs_naive_log2FoldChange"]] <- NULL + expect_error( + get_dea_df(dde_gone_wrong, "ifng_vs_naive") + ) + + expect_error( + DeeDeeExperiment( + rowData(se_macrophage_noassays), + de_results = de_named_list + ) + ) + + expect_error( + DeeDeeExperiment( + assay(se_macrophage), + de_results = de_named_list + ) + ) + + expect_error( + DeeDeeExperiment() + ) +}) + + +test_that("adding and removing", { + dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list + ) + + new_del <- list( + ifng2 = de_named_list$ifng_vs_naive, + ifngsalmo2 = de_named_list$ifngsalmo_vs_naive + ) + # add a new (set of) DE result(s) + dde_new <- add_dea(dde, new_del) + expect_is(dde_new, "DeeDeeExperiment") + expect_equal(length(dea(dde)), 4) + expect_equal(length(dea(dde_new)), 6) + + dde_removed <- remove_dea(dde, "ifngsalmo_vs_naive") + expect_is(dde_removed, "DeeDeeExperiment") + expect_equal(length(dea(dde_removed)), 3) +}) + + +test_that("validity and so", { + dde2 <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list + ) + + expect_true(validObject(dde2)) + + rowData(dde2)[["ifng_vs_naive_log2FoldChange"]] <- NULL + expect_error(validObject(dde2)) + + dde3 <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list + ) + + # invalid replacements + ## actually, can enable it is an empty list (i.e. no DE (yet) inserted) + # dde3@dea <- list() + # expect_error(validObject(dde3)) + + dde3@dea <- list("foo", "bar") + expect_error(validObject(dde3)) +}) diff --git a/tests/testthat/test-DeeDee_app.R b/tests/testthat/test-DeeDee_app.R new file mode 100644 index 0000000..d55cdd4 --- /dev/null +++ b/tests/testthat/test-DeeDee_app.R @@ -0,0 +1,8 @@ +test_that("shiny", { + # data(dd_list_original, package = "DeeDee") + + library("shiny") + myapp <- deedee_app(dde = DeeDeeExperiment(se = se_macrophage_noassays, de_results = de_named_list)) + + expect_is(myapp, "shiny.appobj") +}) diff --git a/tests/testthat/test-DeeDee_misc.R b/tests/testthat/test-DeeDee_misc.R new file mode 100644 index 0000000..b3375cf --- /dev/null +++ b/tests/testthat/test-DeeDee_misc.R @@ -0,0 +1,34 @@ + +test_that("summary report", { + dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list + ) + + temp_output_file <- "test_report.html" + deedee_summary( + dde = dde, + template = system.file("extdata", + "summary_template.Rmd", + package = "DeeDee"), + output_path = temp_output_file + ) + + # trigger error by trying to overwrite + expect_error( + deedee_summary( + dde = dde, + template = system.file("extdata", + "summary_template.Rmd", + package = "DeeDee"), + output_path = temp_output_file + ) + ) + + # browseURL(temp_output_file) + expect_true(file.exists(temp_output_file)) + + file.remove(temp_output_file) +}) + + diff --git a/tests/testthat/test-DeeDee_plots.R b/tests/testthat/test-DeeDee_plots.R new file mode 100644 index 0000000..02a378a --- /dev/null +++ b/tests/testthat/test-DeeDee_plots.R @@ -0,0 +1,63 @@ +dde <- DeeDeeExperiment( + se_macrophage_noassays, + de_results = de_named_list +) + +# needed for bad handling of namespace by ggvenn +library("dplyr") + +test_that("plotting & plotting", { + p_scatter <- deedee_scatter(dde) + expect_is(p_scatter, "gg") + + + p_heatmap <- deedee_heatmap(dde) + expect_is(p_heatmap, "Heatmap") + + + p_venn <- deedee_venn(dde) + expect_is(p_venn, "gg") + + p_venn_up <- deedee_venn(dde, mode = "up") + expect_is(p_venn_up, "gg") + p_venn_down <- deedee_venn(dde, mode = "down") + expect_is(p_venn_down, "gg") + + + p_upset <- deedee_upset(dde) + expect_is(p_upset, "gg") + + p_upset_both <- deedee_upset(dde, mode = "both") + expect_is(p_upset_both, "gg") + + p_upset_up <- deedee_upset(dde, mode = "up") + expect_is(p_upset_up, "gg") + p_upset_down <- deedee_upset(dde, mode = "down") + expect_is(p_upset_down, "gg") + + + p_cat <- deedee_cat(dde) + expect_is(p_cat, "gg") + + + p_bars <- deedee_bars(dde) + expect_is(p_bars, "gg") + + p_bars_wnumbers <- deedee_bars(dde, show_DEnumbers = TRUE) + expect_is(p_bars_wnumbers, "gg") + + + p_cat_down <- deedee_cat(dde, mode = "down") + expect_is(p_cat_down, "gg") + p_cat_both <- deedee_cat(dde, mode = "both") + expect_is(p_cat_both, "gg") + + + p_qq <- deedee_qq(dde) + expect_is(p_qq, "gg") + p_qq_m <- deedee_qqmult(dde) + expect_is(p_qq_m, "gg") + +}) + + diff --git a/vignettes/DeeDee_bibliography.bib b/vignettes/DeeDee_bibliography.bib new file mode 100644 index 0000000..135d029 --- /dev/null +++ b/vignettes/DeeDee_bibliography.bib @@ -0,0 +1,40 @@ +% Refs to be added + +@article{Alasoo2018, +abstract = {Regulatory variants are often context specific, modulating gene expression in a subset of possible cellular states. Although these genetic effects can play important roles in disease, the molecular mechanisms underlying context specificity are poorly understood. Here, we identified shared quantitative trait loci (QTLs) for chromatin accessibility and gene expression in human macrophages exposed to IFN$\gamma$, Salmonella and IFN$\gamma$ plus Salmonella. We observed that {\~{}}60{\%} of stimulus-specific expression QTLs with a detectable effect on chromatin altered the chromatin accessibility in naive cells, thus suggesting that they perturb enhancer priming. Such variants probably influence binding of cell-type-specific transcription factors, such as PU.1, which can then indirectly alter the binding of stimulus-specific transcription factors, such as NF-$\kappa$B or STAT2. Thus, although chromatin accessibility assays are powerful for fine-mapping causal regulatory variants, detecting their downstream effects on gene expression will be challenging, requiring profiling of large numbers of stimulated cellular states and time points.}, +author = {Alasoo, Kaur and Rodrigues, Julia and Mukhopadhyay, Subhankar and Knights, Andrew J. and Mann, Alice L. and Kundu, Kousik and Hale, Christine and Dougan, Gordon and Gaffney, Daniel J.}, +doi = {10.1038/s41588-018-0046-7}, +file = {:Users/fede/Library/Containers/com.apple.Preview/Data/Downloads/s41588-018-0046-7.pdf:pdf}, +issn = {15461718}, +journal = {Nature Genetics}, +mendeley-groups = {ideal{\_}manuscript,GeneTonic{\_}manuscript}, +number = {3}, +pages = {424--431}, +publisher = {Springer US}, +title = {{Shared genetic effects on chromatin and gene expression indicate a role for enhancer priming in immune response}}, +url = {http://dx.doi.org/10.1038/s41588-018-0046-7}, +volume = {50}, +year = {2018} +} + +@article{Love2014, +abstract = {In comparative high-throughput sequencing assays, a fundamental task is the analysis of count data, such as read counts per gene in RNA-seq, for evidence of systematic changes across experimental conditions. Small replicate numbers, discreteness, large dynamic range and the presence of outliers require a suitable statistical approach. We present DESeq2, a method for differential analysis of count data, using shrinkage estimation for dispersions and fold changes to improve stability and interpretability of estimates. This enables a more quantitative analysis focused on the strength rather than the mere presence of differential expression. The DESeq2 package is available at http://www.bioconductor.org/packages/release/bioc/html/DESeq2.html webcite.}, +author = {Love, Michael I and Huber, Wolfgang and Anders, Simon}, +doi = {10.1186/s13059-014-0550-8}, +file = {:Users/fede/Library/Application Support/Mendeley Desktop/Downloaded/Love, Huber, Anders - 2014 - Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2.pdf:pdf}, +isbn = {1465-6906}, +issn = {1474-760X}, +journal = {Genome Biology}, +keywords = {Algorithms,Computational Biology,Computational Biology: methods,Genetic,High-Throughput Nucleotide Sequencing,Models,RNA,RNA: analysis,Sequence Analysis,Software}, +mendeley-groups = {PhDthesis,pcaExplorer{\_}manuscript,ideal{\_}manuscript,VFapplication,VF,iSEE,GeneTonic{\_}manuscript}, +month = {dec}, +number = {12}, +pages = {550}, +pmid = {25516281}, +title = {{Moderated estimation of fold change and dispersion for RNA-seq data with DESeq2}}, +url = {http://genomebiology.biomedcentral.com/articles/10.1186/s13059-014-0550-8}, +volume = {15}, +year = {2014} +} + + diff --git a/vignettes/deedee_manual.Rmd b/vignettes/deedee_manual.Rmd index c5e3a1c..2861002 100644 --- a/vignettes/deedee_manual.Rmd +++ b/vignettes/deedee_manual.Rmd @@ -1,36 +1,188 @@ --- -title: "DeeDee User Guide" +title: > + The `DeeDee` User's Guide author: - name: Lea Rothörl - affiliation: Institute of Medical Biostatistics, Epidemiology and Informatics (IMBEI), - Mainz -date: "`r Sys.Date()`" -output: - html_document: - toc: yes - toc_float: yes - theme: cosmo + affiliation: + - Institute of Medical Biostatistics, Epidemiology and Informatics (IMBEI), Mainz +- name: Federico Marini + affiliation: + - Institute of Medical Biostatistics, Epidemiology and Informatics (IMBEI), Mainz + - Research Center for Immunotherapy (FZI), Mainz + email: marinif@uni-mainz.de +date: "`r BiocStyle::doc_date()`" +package: "`r BiocStyle::pkg_ver('DeeDee')`" +output: + BiocStyle::html_document: + toc_float: true code_folding: show code_download: yes - pdf_document: - toc: yes -vignette: | - %\VignetteIndexEntry{The DeeDee User's Guide} - %\VignetteEncoding{UTF-8} - %\VignettePackage{DeeDee} +vignette: > + %\VignetteIndexEntry{The DeeDee User's Guide} + %\VignetteEncoding{UTF-8} + %\VignettePackage{DeeDee} + %\VignetteKeywords{GeneExpression, RNASeq, Sequencing, Visualization, QualityControl, GUI} %\VignetteEngine{knitr::rmarkdown} -editor_options: +editor_options: chunk_output_type: console +bibliography: DeeDee_bibliography.bib --- + + +**Compiled date**: `r Sys.Date()` + +**Last edited**: 2023-01-12 + +**License**: `r packageDescription("DeeDee")[["License"]]` + ```{r setup, include=FALSE} knitr::opts_chunk$set( - echo = TRUE + collapse = TRUE, + comment = "#>", + error = FALSE, + warning = FALSE, + eval = TRUE, + message = FALSE, + fig.width = 10 ) + +options(width = 100) ``` -```{r, echo = FALSE, warning = FALSE, message = FALSE, results = "hide"} +
+ +# Introduction {#introduction} + +This vignette describes how to use the `r BiocStyle::Biocpkg("DeeDee")` package for ...... + +This package provides ...... + +In order to use `r BiocStyle::Biocpkg("DeeDee")` in your workflow, ...... the following inputs are required: + +In the remainder of this vignette, we will illustrate the main features of `r BiocStyle::Biocpkg("DeeDee")` on a publicly available dataset from Alasoo, et al. "Shared genetic effects on chromatin and gene expression indicate a role for enhancer priming in immune response", published in Nature Genetics, January 2018 [@Alasoo2018] +[doi:10.1038/s41588-018-0046-7](https://doi.org/10.1038/s41588-018-0046-7). + +The data is made available via the `r BiocStyle::Biocpkg("macrophage")` Bioconductor package, which contains the files output from the Salmon quantification (version 0.12.0, with Gencode v29 reference), as well as the values summarized at the gene level, which we will use to exemplify. + +In the `macrophage` experimental setting, the samples are available from 6 different donors, in 4 different conditions (naive, treated with Interferon gamma, with SL1344, or with a combination of Interferon gamma and SL1344). + +...... + +We will focus our attention on the following comparisons: + +* between Interferon gamma treated samples vs naive samples. +...... + +# Getting started {#gettingstarted} + +To install this package, start R and enter: + +```{r install, eval=FALSE} +if (!requireNamespace("BiocManager", quietly = TRUE)) + install.packages("BiocManager") + +BiocManager::install("DeeDee") +``` + +Once installed, the package can be loaded and attached to your current workspace as follows: + +```{r loadlib, eval = TRUE} library("DeeDee") +``` + +If you have all four input elements ready, + +...... + +you can launch the `GeneTonic()` app by running: + +...... + + +# The `DeeDeeExperiment` class + +yadda yadda + +...... + +# A typical analysis workflow with `DeeDee` {#typicalworkflow} + + +a number of functions which can be used also as standalone components for a workflow. + + + +# Using `DeeDee` interactively: the `deedee_app()` + + +Description of the `DeeDee` user interface {#userinterface} + +What it does + +How to use it + + + + +# Additional Information {#additionalinfo} + +Bug reports can be posted on the Bioconductor support site (https://support.bioconductor.org/) or raised as issues in the `DeeDee` GitHub repository +...... +(https://github.com/federicomarini/GeneTonic/issues). + +The GitHub repository also contains the development version of the package, where new functionality is added over time - careful, you might be running bleeding edge versions! + +The authors appreciate well-considered suggestions for improvements or new features, or even better, pull requests. + +If you use `DeeDee` for your analysis, please cite it as shown below: + +```{r cite} +citation("DeeDee") +``` + + +# FAQs {#faqs} + +**Q: Why DeeDee?** + +A: For this and that + +**Q: I'd like to try `DeeDee` but I could not install it/I just want a quick peek into it. What can I do for this?** + +A: We set up an instance of `DeeDee` running on the `macrophage` dataset at this address: http://shiny.imbei.uni-mainz.de:3838/DeeDee. + +# Session Info {- .smaller} + +```{r sessioninfo} +sessionInfo() +``` + +# References {-} + +```{r} +``` + + + + + + + + + + + + + + + +```{r, echo = FALSE, warning = FALSE, message = FALSE, results = "hide"} +library(DeeDeeLegacy) data(DE_results_IFNg_naive, package = "DeeDee") IFNg_naive <- deedee_prepare(IFNg_naive, "DESeq2") data(DE_results_IFNg_both, package = "DeeDee") @@ -134,7 +286,7 @@ The function `deedee_venn()` creates a Venn diagram depicting the overlaps of di \pagebreak ## DeeDee UpSet Plot -The function `deedee_upset()` creates an UpSet plot depicting the overlaps of differentially expressed genes in the input datasets. Contrary to [`deedee_venn()`](#deedee-venn-diagram), the UpSet plot can compare multiple (and even more than four) datasets in a visually pleasing way. The parameter `mode` can be set to `up`, `down`, `both`, or `both_colored` (default), specifying if only up-regulated, down-regulated or both DE genes shall be depicted. If `both_colored` is chosen, the result is the same UpSet plot as for `both`, but the shares of the intersections where all samples have positive/negative logFC values are colored accoring to the color key. The minimum size for an intersection to be included in the plot can be defined via the parameter `min_setsize`, default is 10. +The function `deedee_upset()` creates an UpSet plot depicting the overlaps of differentially expressed genes in the input datasets. Contrary to [`deedee_venn()`](#deedee-venn-diagram), the UpSet plot can compare multiple (and even more than four) datasets in a visually pleasing way. The parameter `mode` can be set to `up`, `down`, `both`, or `both_colored` (default), specifying if only up-regulated, down-regulated or both DE genes shall be depicted. If `both_colored` is chosen, the result is the same UpSet plot as for `both`, but the shares of the intersections where all samples have positive/negative logFC values are colored according to the color key. The minimum size for an intersection to be included in the plot can be defined via the parameter `min_setsize`, default is 10. ```{r, echo = TRUE, warning = FALSE, message = FALSE} deedee_upset(data = DeeDee_obj, mode = "both_colored", min_setsize = 15, pthresh = 0.05) @@ -211,14 +363,4 @@ More information on the usage can be found in the `INFO` panel in each respectiv Optionally, you can include a list of DeeDee tables as an argument to the `deedee_app(data = DeeDee_obj)` function. The input can be combined with uploads and used just like these. -# Session Info {-} - - -```{r, collapse=TRUE} -sessionInfo() -``` - - - -