diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..10f98d5 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,7 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^data-raw$ +^R-raw$ +^README\.Rmd$ +^README-.*\.png$ +^\.github$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml new file mode 100644 index 0000000..9ce7995 --- /dev/null +++ b/.github/workflows/check-bioc.yml @@ -0,0 +1,435 @@ +## 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() +## or +## > usethis::use_github_action("check-bioc", "https://bit.ly/biocthis_gha", "check-bioc.yml") +## without having to install biocthis. +## +## 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 + +## Specify which branches you want this GHA to run on. +## Bioconductor uses branches such as master (bioc-devel) and RELEASE_* like +## RELEASE_3_10. For more details check +## http://bioconductor.org/developers/how-to/git/ +on: + push: + branches: + - master + pull_request: + branches: + - master + +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' + +jobs: + ## This first job uses the GitHub repository branch name to infer what + ## version of Bioconductor we will be working on. + define-docker-info: + runs-on: ubuntu-latest + outputs: + imagename: ${{ steps.findinfo.outputs.imagename }} + biocversion: ${{ steps.findinfo.outputs.biocversion }} + steps: + - id: findinfo + run: | + ## Find what Bioconductor RELEASE branch we are working on + ## otherwise, assume we are working on bioc-devel. + if echo "$GITHUB_REF" | grep -q "RELEASE_"; then + biocversion="$(basename -- $GITHUB_REF | tr '[:upper:]' '[:lower:]')" + else + biocversion="devel" + fi + ## Define the image name and print the information + imagename="bioconductor/bioconductor_docker:${biocversion}" + echo $imagename + echo $biocversion + + ## Save the information for the next job + echo "::set-output name=imagename::${imagename}" + echo "::set-output name=biocversion::${biocversion}" + + R-CMD-check-bioc: + ## This job then checks the R package using the Bioconductor docker that + ## was defined by the previous job. This job will determine what version of + ## R to use for the macOS and Windows builds on the next job. + runs-on: ubuntu-latest + needs: define-docker-info + + ## Name shown on the GHA log + name: ubuntu-latest (r-biocdocker bioc-${{ needs.define-docker-info.outputs.biocversion }}) + + ## Information used by the next job that will run on macOS and Windows + outputs: + rversion: ${{ steps.findrversion.outputs.rversion }} + biocversionnum: ${{ steps.findrversion.outputs.biocversionnum }} + + ## Environment variables unique to this job. + env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + TZ: UTC + NOT_CRAN: true + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + ## The docker container to use. Note that we link a directory on the GHA + ## runner to a docker directory, such that we can then cache the linked + ## directory. This directory will contain the R packages used. + container: + image: ${{ needs.define-docker-info.outputs.imagename }} + volumes: + - /home/runner/work/_temp/Library:/usr/local/lib/R/host-site-library + + steps: + - name: Install latest git + run: | + ## git version provided + git --version + ## to be able to install software properties + sudo apt-get update -y + ## to be able to use add-apt-repository + sudo apt-get install software-properties-common -y + ## to use stable releases of git that are already in a PPA at + ## https://launchpad.net/~git-core/+archive/ubuntu/candidate + sudo add-apt-repository ppa:git-core/candidate -y + ## Update + sudo apt-get update -y + ## Upgrade git and other tools + sudo apt-get upgrade -y + ## latest git version + git --version + shell: bash {0} + ## Related to https://github.com/rocker-org/rocker-versioned2/issues/52 + + ## 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. + - uses: actions/checkout@v2 + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + message(paste('****', Sys.time(), 'installing BiocManager ****')) + remotes::install_cran("BiocManager") + shell: Rscript {0} + + ## Find the corresponding R version based on the Bioconductor version + ## to use for the macOS and Windows checks by the next GHA job + - id: findrversion + name: Find Bioc and R versions + run: | + ## Find what branch we are working on + if echo "$GITHUB_REF" | grep -q "master"; then + biocversion="devel" + elif echo "$GITHUB_REF" | grep -q "RELEASE_"; then + biocversion="release" + fi + + ## Define the R and Bioconductor version numbers + biocversionnum=$(Rscript -e "info <- BiocManager:::.version_map_get_online('https://bioconductor.org/config.yaml'); res <- subset(info, BiocStatus == '${biocversion}')[, 'Bioc']; cat(as.character(res))") + rversion=$(Rscript -e "info <- BiocManager:::.version_map_get_online('https://bioconductor.org/config.yaml'); res <- subset(info, BiocStatus == '${biocversion}')[, 'R']; cat(as.character(res))") + + ## Print the results + echo $biocversion + echo $biocversionnum + echo $rversion + + ## Save the info for the next job + echo "::set-output name=rversion::${rversion}" + echo "::set-output name=biocversionnum::${biocversionnum}" + shell: + bash {0} + + - name: Cache R packages + if: "!contains(github.event.head_commit.message, '/nocache')" + uses: actions/cache@v1 + with: + path: /home/runner/work/_temp/Library + key: ${{ env.cache-version }}-${{ runner.os }}-biocdocker-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ steps.findrversion.outputs.rversion }}-bioc-${{ steps.findrversion.outputs.biocversionnum }}-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocdocker-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ steps.findrversion.outputs.rversion }}-bioc-${{ steps.findrversion.outputs.biocversionnum }}- + + - name: Install dependencies + 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. + + ## Pass #1 at installing dependencies + message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****')) + local_deps <- remotes::local_package_deps(dependencies = TRUE) + deps <- remotes::dev_package_deps(dependencies = TRUE, repos = BiocManager::repositories()) + BiocManager::install(local_deps[local_deps %in% deps$package[deps$diff != 0]]) + + ## Pass #2 at installing dependencies + message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****')) + deps <- remotes::dev_package_deps(dependencies = TRUE, repos = BiocManager::repositories()) + BiocManager::install(deps$package[deps$diff != 0]) + + ## For running the checks + message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****')) + remotes::install_cran("rcmdcheck") + # BiocManager::install("BiocCheck") + # BiocManager::install("limma") + + remotes::install_github("saeyslab/nichenetr") + + 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: Check + env: + _R_CHECK_CRAN_INCOMING_: false + run: | + rcmdcheck::rcmdcheck( + args = c("--no-build-vignettes", "--no-manual", "--timings"), + build_args = c("--no-manual", "--no-resave-data", "--no-build-vignettes"), + error_on = "error", + check_dir = "check" + ) + shell: Rscript {0} + + - 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: | + ## Install BiocGenerics + BiocManager::install("BiocGenerics") + BiocGenerics:::testPackage() + shell: Rscript {0} + + - name: Install covr + if: github.ref == 'refs/heads/master' && env.run_covr == 'true' + run: | + remotes::install_cran("covr") + shell: Rscript {0} + + - name: Test coverage + if: github.ref == 'refs/heads/master' && env.run_covr == 'true' + run: | + covr::codecov() + shell: Rscript {0} + + - name: Install pkgdown + if: github.ref == 'refs/heads/master' && env.run_pkgdown == 'true' + run: | + remotes::install_github("r-lib/pkgdown") + shell: Rscript {0} + + - name: Install package + if: github.ref == 'refs/heads/master' && env.run_pkgdown == 'true' + run: R CMD INSTALL . + + - name: Upload check results + if: failure() + uses: actions/upload-artifact@master + with: + name: ${{ runner.os }}-biocdocker-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ steps.findrversion.outputs.rversion }}-bioc-${{ steps.findrversion.outputs.biocversionnum }}-results + path: check + + ## Run R CMD check on both macOS and Windows. You can also run the + ## tests on Linux outside of the Bioconductor docker environment. If you + ## do so, you might have to install system dependencies on Linux + ## Bioconductor's docker includes all the system dependencies required by + ## Bioconductor packages and their dependencies (which includes many CRAN + ## dependencies as well, thus making this workflow useful beyond Bioconductor) + R-CMD-check-r-lib: + runs-on: ${{ matrix.config.os }} + needs: [define-docker-info, R-CMD-check-bioc] + + name: ${{ matrix.config.os }} (r-${{ needs.R-CMD-check-bioc.outputs.rversion }} bioc-${{ needs.define-docker-info.outputs.biocversion }}) + + strategy: + fail-fast: false + matrix: + config: + ## Comment/Un-comment in case you also want to run other versions + - {os: windows-latest} + # - {os: macOS-latest} # uncomment later!! + # - {os: ubuntu-16.04, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"} + + env: + R_REMOTES_NO_ERRORS_FROM_WARNINGS: true + RSPM: ${{ matrix.config.rspm }} + BIOCVERSIONNUM: ${{ needs.R-CMD-check-bioc.outputs.biocversionnum }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v2 + - uses: actions/checkout@master + - uses: codecov/codecov-action@v1 + with: + token: ${{ secrets.CODECOV_TOKEN }} # not required for public repos + file: ./coverage.xml # optional + files: ./coverage1.xml,./coverage2.xml # optional + flags: unittests # optional + name: codecov-umbrella # optional + fail_ci_if_error: true # optional (default = false) + + - name: Setup R from r-lib + uses: r-lib/actions/setup-r@master + with: + r-version: ${{ needs.R-CMD-check-bioc.outputs.rversion }} + + - name: Setup pandoc from r-lib + uses: r-lib/actions/setup-pandoc@master + + - name: Query dependencies + run: | + install.packages('remotes') + saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) + shell: Rscript {0} + + - name: Cache R packages + if: "!contains(github.event.head_commit.message, '/nocache')" + uses: actions/cache@v1 + with: + path: ${{ env.R_LIBS_USER }} + key: ${{ env.cache-version }}-${{ runner.os }}-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ needs.R-CMD-check-bioc.outputs.rversion }}-bioc-${{ needs.define-docker-info.outputs.biocversion }}-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ needs.R-CMD-check-bioc.outputs.rversion }}-bioc-${{ needs.define-docker-info.outputs.biocversion }}- + + - name: Install Linux system dependencies + if: runner.os == 'Linux' + env: + RHUB_PLATFORM: linux-x86_64-ubuntu-gcc + run: | + Rscript -e "remotes::install_github('r-hub/sysreqs')" + sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))") + 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 "::set-env name=XML_CONFIG::/usr/local/opt/libxml2/bin/xml2-config" + + ## Required to install magick as noted at + ## https://github.com/r-lib/usethis/commit/f1f1e0d10c1ebc75fd4c18fa7e2de4551fd9978f#diff-9bfee71065492f63457918efcd912cf2 + brew install imagemagick@6 + + - name: Install Windows system dependencies + if: runner.os == 'Windows' + run: | + ## Edit below if you have any Windows system dependencies + Rscript -e "install.packages('igraph', type = 'binary',repos = 'http://cran.us.r-project.org')" + + - name: Install BiocManager + run: | + message(paste('****', Sys.time(), 'installing BiocManager ****')) + remotes::install_cran("BiocManager") + shell: Rscript {0} + + - name: Set BiocVersion + run: | + BiocManager::install(version = Sys.getenv('BIOCVERSIONNUM'), ask = FALSE) + shell: Rscript {0} + + - name: Install dependencies + 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. + + ## Pass #1 at installing dependencies + message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****')) + local_deps <- remotes::local_package_deps(dependencies = TRUE) + deps <- remotes::dev_package_deps(dependencies = TRUE, repos = BiocManager::repositories()) + BiocManager::install(local_deps[local_deps %in% deps$package[deps$diff != 0]]) + + ## Pass #2 at installing dependencies + message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****')) + deps <- remotes::dev_package_deps(dependencies = TRUE, repos = BiocManager::repositories()) + BiocManager::install(deps$package[deps$diff != 0]) + + ## For running the checks + message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****')) + remotes::install_cran("rcmdcheck") + BiocManager::install("BiocCheck") + # BiocManager::install("limma") + remotes::install_github("saeyslab/nichenetr") + 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: Check + env: + _R_CHECK_CRAN_INCOMING_: false + run: | + rcmdcheck::rcmdcheck( + args = c("--no-build-vignettes", "--no-manual", "--timings"), + build_args = c("--no-manual", "--no-resave-data", "--no-build-vignettes"), + error_on = "error", + check_dir = "check" + ) + shell: Rscript {0} + + - 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: | + ## Install BiocGenerics + BiocManager::install("BiocGenerics") + BiocGenerics:::testPackage() + shell: Rscript {0} + + - name: Upload check results + if: failure() + uses: actions/upload-artifact@master + with: + name: ${{ runner.os }}-biocbranch-${{ needs.define-docker-info.outputs.biocversion }}-r-${{ needs.R-CMD-check-bioc.outputs.rversion }}-bioc-${{ needs.define-docker-info.outputs.biocversion }}-results + path: check diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..d4c431a --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,35 @@ +Package: multinichenetr +Type: Package +Title: Cell-Cell Communication analysis for scRNAseq data with complex multi-sample multi-group designs +Version: 0.1.0 +Author: person("Robin", "Browaeys", email = "robin.browaeys@ugent.be", + role = c("aut", "cre")) +Maintainer: Robin Browaeys +Description: This package allows you the investigate intercellular communication from a computational perspective. + It is an extension of the NicheNet framework (https://github.com/saeyslab/nichenetr) to better suit scRNAseq datasets with complex designs. + These datasets can contain multiple samples (e.g. patients) over different groups of interest (e.g. disease subtypes). + With MultiNicheNet, you can now better analyze the differences in cell-cell signaling between the different groups of interest. + MultiNicheNet will give a you a list of the ligand-receptor interactions that are most strongly differentially expressed between patients of the different groups, and also most active in the different groups as given by the NicheNet ligand activity. +License: GPL-3 +Encoding: UTF-8 +LazyData: true +URL: https://github.com/browaeysrobin/multinichenetr +BugReports: https://github.com/browaeysrobin/multinichenetr/issues +Depends: R (>= 3.4.0) +Imports: + Seurat, + dplyr, + circlize, + patchwork, + ggplot2, + tibble, + tidyr, + purrr, + ComplexHeatmap, + stringr, + generics, + grid, + Nebulosa +Remotes: + github::saeyslab/nichenetr +RoxygenNote: 7.1.1 diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..6482e1e --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,33 @@ +# Generated by roxygen2: do not edit by hand + +export(combine_sender_receiver_de) +export(combine_sender_receiver_info_ic) +export(fix_frq_df) +export(generate_prioritization_tables) +export(get_avg_frac_exprs_abund) +export(get_ligand_activities_targets_DEgenes) +export(get_muscat_exprs_avg) +export(get_muscat_exprs_frac) +export(make_circos_group_comparison) +export(make_featureplot) +export(make_group_lfc_exprs_activity_plot) +export(make_ligand_activity_plots) +export(make_ligand_activity_target_plot) +export(make_ligand_receptor_nebulosa_feature_plot) +export(make_ligand_receptor_violin_plot) +export(make_nebulosa) +export(make_sample_lr_prod_activity_plots) +export(make_sample_lr_prod_plots) +export(make_sample_target_plots) +export(make_sample_target_plots_reversed) +export(make_target_nebulosa_feature_plot) +export(make_target_violin_plot) +export(ms_mg_nichenet_analysis) +export(ms_mg_nichenet_analysis_combined) +export(ms_mg_nichenet_analysis_separate) +export(perform_muscat_de_analysis) +export(process_info_to_ic) +import(Seurat) +import(dplyr) +import(muscat) +importFrom(purrr,map) diff --git a/R-raw/add_data.R b/R-raw/add_data.R new file mode 100644 index 0000000..ff1d454 --- /dev/null +++ b/R-raw/add_data.R @@ -0,0 +1,30 @@ +library(Seurat) +library(tidyverse) + +# add visium +seurat_obj = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet/data/seurat_obj_lite_hnscc.rds") +usethis::use_data(seurat_obj,overwrite = T, compress = "bzip2") + + +usethis::use_package("Seurat") +usethis::use_package("dplyr") +usethis::use_package("ggplot2") +usethis::use_package("circlize") +usethis::use_package("patchwork") + +usethis::use_package("Scater") +usethis::use_package("Muscat") +usethis::use_package("tibble") +usethis::use_package("tidyr") +usethis::use_package("purrr") +usethis::use_package("ComplexHeatmap") + +usethis::use_package("circlize") +usethis::use_package("stringr") +usethis::use_package("generics") +usethis::use_package("ComplexHeatmap") +usethis::use_package("grid") +usethis::use_package("Nebulosa") + + + diff --git a/R/data.R b/R/data.R new file mode 100644 index 0000000..65d1236 --- /dev/null +++ b/R/data.R @@ -0,0 +1,9 @@ +## description of data + +#' Seurat object containing scRNAseq data (subsampled) +#' +#' Seurat object containing scRNAseq data (subsampled). Source of the data: Puram et al., Cell 2017: “Single-Cell Transcriptomic Analysis of Primary and Metastatic Tumor Ecosystems in Head and Neck Cancer.”. This example data was downsampled (features and cells). +#' +#' @format An object of class Seurat +#' +"seurat_obj" diff --git a/R/expression_processing.R b/R/expression_processing.R new file mode 100644 index 0000000..7652a2a --- /dev/null +++ b/R/expression_processing.R @@ -0,0 +1,380 @@ +#' @title get_muscat_exprs_frac +#' +#' @description \code{get_muscat_exprs_frac} XXXX +#' @usage get_muscat_exprs_frac(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA") +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +get_muscat_exprs_frac = function(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA"){ + + # convert seurat to SCE object + sce = Seurat::as.SingleCellExperiment(seurat_obj, assay = assay_oi_sce) + + # prepare SCE for the muscat pseudobulk analysis + sce$id = sce[[sample_id]] + sce = muscat::prepSCE(sce, + kid = celltype_id, # subpopulation assignments + gid = group_id, # group IDs (ctrl/stim) + sid = "id", # sample IDs (ctrl/stim.1234) + drop = FALSE) # + + samples = sce$sample_id %>% unique() %>% as.character() + groups = sce$group_id %>% unique() %>% as.character() + + frq = muscat::calcExprFreqs(sce, assay = "counts", th = 0) # gives NaN sometimes... + + celltypes = sce$cluster_id %>% unique() %>% as.character() + + frq_lists = celltypes %>% lapply(function(celltype_oi, frq){ + frq_celltype = frq@assays@data[[celltype_oi]] + + frq_celltype_samples = frq_celltype[,samples] + frq_celltype_samples = frq_celltype_samples %>% data.frame() %>% tibble::rownames_to_column("gene") %>% tidyr::gather(sample, fraction_sample, -gene) %>% tibble::as_tibble() %>% dplyr::mutate(celltype = celltype_oi) + + frq_celltype_groups = frq_celltype[,groups] + frq_celltype_groups = frq_celltype_groups %>% data.frame() %>% tibble::rownames_to_column("gene") %>% tidyr::gather(group, fraction_group, -gene) %>% tibble::as_tibble() %>% dplyr::mutate(celltype = celltype_oi) + + return(list(frq_celltype_samples = frq_celltype_samples, frq_celltype_groups = frq_celltype_groups)) + },frq) %>% magrittr::set_names(sce$cluster_id %>% unique()) + + frq_celltype_samples = frq_lists %>% purrr::map("frq_celltype_samples") %>% dplyr::bind_rows() + frq_celltype_groups = frq_lists %>% purrr::map("frq_celltype_groups") %>% dplyr::bind_rows() + rm(frq_lists) + + return(list(frq_celltype_samples = frq_celltype_samples, frq_celltype_groups = frq_celltype_groups)) +} + +#' @title get_muscat_exprs_avg +#' +#' @description \code{get_muscat_exprs_avg} XXXX +#' @usage get_muscat_exprs_avg(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA") +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +get_muscat_exprs_avg = function(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA"){ + + # convert seurat to SCE object + sce = Seurat::as.SingleCellExperiment(seurat_obj, assay = assay_oi_sce) + + # prepare SCE for the muscat pseudobulk analysis + sce$id = sce[[sample_id]] + sce = muscat::prepSCE(sce, + kid = celltype_id, # subpopulation assignments + gid = group_id, # group IDs (ctrl/stim) + sid = "id", # sample IDs (ctrl/stim.1234) + drop = FALSE) # + + sce = scater::computeLibraryFactors(sce) + sce = scater::logNormCounts(sce) + # scater::calculateAverage() + # sce = scater::calculateCPM(sce) + # scater::normalizeCounts() + avg = muscat::aggregateData(sce, assay = "logcounts", fun = "mean", by = c("cluster_id", "sample_id")) + + avg_df = sce$cluster_id %>% unique() %>% lapply(function(celltype_oi, avg){ + avg_celltype = avg@assays@data[[celltype_oi]] + + avg_celltype_samples = avg_celltype[,sce$sample_id %>% unique()] + avg_celltype_samples = avg_celltype_samples %>% data.frame() %>% tibble::rownames_to_column("gene") %>% tidyr::gather(sample, average_sample, -gene) %>% tibble::as_tibble() %>% dplyr::mutate(celltype = celltype_oi) + + },avg) %>% dplyr::bind_rows() + + return(avg_df) +} + +#' @title fix_frq_df +#' +#' @description \code{fix_frq_df} XXXX +#' @usage fix_frq_df(seurat_obj, frq_celltype_samples) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' @param frq_celltype_samples XXXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +fix_frq_df = function(seurat_obj, frq_celltype_samples){ + genes = seurat_obj@assays$RNA@data %>% rownames() + gene_mapping = genes %>% magrittr::set_names(seq(length(genes))) + + frq_celltype_samples_OK = frq_celltype_samples %>% dplyr::filter(gene %in% genes) + + frq_celltype_samples_FIX = frq_celltype_samples %>% dplyr::filter(!gene %in% genes) + + frq_celltype_samples_FIX = frq_celltype_samples_FIX %>% dplyr::mutate(gene = gene_mapping[gene]) + + frq_celltype_samples_FIX = frq_celltype_samples_FIX %>% dplyr::mutate(fraction_sample = 0) + + frq_celltype_samples = frq_celltype_samples_OK %>% dplyr::bind_rows(frq_celltype_samples_FIX) + + return(frq_celltype_samples) + +} + +#' @title get_avg_frac_exprs_abund +#' +#' @description \code{get_avg_frac_exprs_abund} XXXX +#' @usage get_avg_frac_exprs_abund(seurat_obj, sample_id, celltype_id, group_id, assay_oi = "RNA") +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +get_avg_frac_exprs_abund = function(seurat_obj, sample_id, celltype_id, group_id, assay_oi = "RNA"){ + ## calculate averages, fractions, relative abundance of a cell type in a group + + # calculate average expression + avg_df = get_muscat_exprs_avg(seurat_obj, sample_id = sample_id, celltype_id = celltype_id, group_id = group_id, assay_oi_sce = assay_oi) + + # calculate fraction of expression + frq_df = get_muscat_exprs_frac(seurat_obj, sample_id = sample_id, celltype_id = celltype_id, group_id = group_id, assay_oi_sce = assay_oi) %>% .$frq_celltype_samples + + # check whether something needs to be fixed + if(nrow(avg_df %>% dplyr::filter(is.na(average_sample))) > 0 | nrow(avg_df %>% dplyr::filter(is.nan(average_sample))) > 0) { + warning("There are some genes with NA average expression.") + } + if(nrow(frq_df %>% dplyr::filter(is.na(fraction_sample))) > 0 | nrow(frq_df %>% dplyr::filter(is.nan(fraction_sample))) > 0) { + warning("There are some genes with NA fraction of expression. This is the result of the muscat function `calcExprFreqs` which will give NA when there are no cells of a particular cell type in a particular group. As a temporary fix, we give all these genes an expression fraction of 0 in that group for that cell type") + frq_df = fix_frq_df(seurat_obj, frq_df) + } + + # prepare grouping to get group averages + metadata = seurat_obj@meta.data + if('sample_id' != sample_id){ + metadata$sample_id = metadata[[sample_id]] + } + if('group_id' != sample_id){ + metadata$group_id = metadata[[group_id]] + } + if('celltype_id' != celltype_id){ + metadata$celltype_id = metadata[[celltype_id]] + } + + grouping_df = metadata %>% dplyr::select(sample_id, group_id) %>% tibble::as_tibble() %>% dplyr::distinct() %>% dplyr::rename(sample = sample_id, group = group_id) + + avg_df_group = avg_df %>% dplyr::inner_join(grouping_df) %>% dplyr::group_by(group, celltype, gene) %>% dplyr::summarise(average_group = mean(average_sample)) + frq_df_group = frq_df %>% dplyr::inner_join(grouping_df) %>% dplyr::group_by(group, celltype, gene) %>% dplyr::summarise(fraction_group = mean(fraction_sample)) + + # calculate relative abundance + n_celltypes = metadata$celltype_id %>% unique() %>% length() + if(n_celltypes > 1){ + rel_abundance_celltype_vs_celltype = table(metadata$celltype_id, metadata$group_id) %>% apply(2, function(x){x/sum(x)}) + rel_abundance_celltype_vs_group = rel_abundance_celltype_vs_celltype %>% apply(1, function(x){x/sum(x)}) + } else { + rel_abundance_celltype_vs_group = table(metadata$celltype_id, metadata$group_id) %>% apply(1, function(x){x/sum(x)}) + } + + # rel_ab_mean = rel_abundance_celltype_vs_group %>% apply(2, mean, na.rm = TRUE) + # rel_ab_sd = rel_abundance_celltype_vs_group %>% apply(2, sd, na.rm = TRUE) + # rel_ab_z = (rel_abundance_celltype_vs_group - rel_ab_mean) / rel_ab_sd + # rel_abundance_df = rel_ab_z %>% data.frame() %>% tibble::rownames_to_column("group") %>% tidyr::gather(celltype, rel_abundance_scaled, -group) %>% tibble::as_tibble() + rel_abundance_df = rel_abundance_celltype_vs_group %>% data.frame() %>% tibble::rownames_to_column("group") %>% tidyr::gather(celltype, rel_abundance_scaled, -group) %>% tibble::as_tibble() %>% dplyr::mutate(rel_abundance_scaled = scale_quantile_adapted(rel_abundance_scaled)) + return(list(avg_df = avg_df, frq_df = frq_df, avg_df_group = avg_df_group, frq_df_group = frq_df_group, rel_abundance_df = rel_abundance_df)) + +} + +#' @title process_info_to_ic +#' +#' @description \code{process_info_to_ic} XXXX +#' @usage process_info_to_ic(info_object, ic_type = "sender", lr_network) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' @param info_object XXX +#' @param ic_type XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +process_info_to_ic = function(info_object, ic_type = "sender", lr_network){ + + ligands = lr_network %>% pull(ligand) %>% unique() + receptors = lr_network %>% pull(receptor) %>% unique() + + if(ic_type == "sender"){ + avg_df = info_object$avg_df %>% dplyr::filter(gene %in% ligands) %>% dplyr::rename(sender = celltype, ligand = gene, avg_ligand = average_sample) + frq_df = info_object$frq_df %>% dplyr::filter(gene %in% ligands) %>% dplyr::rename(sender = celltype, ligand = gene, fraction_ligand = fraction_sample) + + avg_df_group = info_object$avg_df_group %>% dplyr::filter(gene %in% ligands) %>% dplyr::rename(sender = celltype, ligand = gene, avg_ligand_group = average_group) + frq_df_group = info_object$frq_df_group %>% dplyr::filter(gene %in% ligands) %>% dplyr::rename(sender = celltype, ligand = gene, fraction_ligand_group = fraction_group) + + rel_abundance_df = info_object$rel_abundance_df %>% dplyr::rename(sender = celltype, rel_abundance_scaled_sender = rel_abundance_scaled) + } + if(ic_type == "receiver"){ + avg_df = info_object$avg_df %>% dplyr::filter(gene %in% receptors) %>% dplyr::rename(receiver = celltype, receptor = gene, avg_receptor = average_sample) + frq_df = info_object$frq_df %>% dplyr::filter(gene %in% receptors) %>% dplyr::rename(receiver = celltype, receptor = gene, fraction_receptor = fraction_sample) + + avg_df_group = info_object$avg_df_group %>% dplyr::filter(gene %in% receptors) %>% dplyr::rename(receiver = celltype, receptor = gene, avg_receptor_group = average_group) + frq_df_group = info_object$frq_df_group %>% dplyr::filter(gene %in% receptors) %>% dplyr::rename(receiver = celltype, receptor = gene, fraction_receptor_group = fraction_group) + + rel_abundance_df = info_object$rel_abundance_df %>% dplyr::rename(receiver = celltype, rel_abundance_scaled_receiver = rel_abundance_scaled) + } + + return(list(avg_df = avg_df, frq_df = frq_df, avg_df_group = avg_df_group, frq_df_group = frq_df_group, rel_abundance_df = rel_abundance_df)) +} + +#' @title combine_sender_receiver_info_ic +#' +#' @description \code{combine_sender_receiver_info_ic} XXXX +#' @usage combine_sender_receiver_info_ic(sender_info, receiver_info, senders_oi, receivers_oi, lr_network) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' @param sender_info XXX +#' @param receiver_info XXX +#' @param senders_oi XXX +#' @param receivers_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +combine_sender_receiver_info_ic = function(sender_info, receiver_info, senders_oi, receivers_oi, lr_network){ + + # combine avg_df + avg_df_sender = sender_info$avg_df %>% dplyr::filter(sender %in% senders_oi) + avg_df_receiver = receiver_info$avg_df %>% dplyr::filter(receiver %in% receivers_oi) + + avg_df_sender_receiver = avg_df_sender %>% dplyr::inner_join(lr_network, by = "ligand") %>% dplyr::inner_join(avg_df_receiver, by = c("receptor","sample")) + avg_df_sender_receiver = avg_df_sender_receiver %>% dplyr::mutate(ligand_receptor_prod = avg_ligand * avg_receptor) %>% dplyr::arrange(-ligand_receptor_prod) %>% dplyr::select(sample, sender, receiver, ligand, receptor, avg_ligand, avg_receptor, ligand_receptor_prod) %>% dplyr::distinct() + + # combine avg_df_group + avg_df_group_sender = sender_info$avg_df_group %>% dplyr::filter(sender %in% senders_oi) + avg_df_group_receiver = receiver_info$avg_df_group %>% dplyr::filter(receiver %in% receivers_oi) + + avg_df_group_sender_receiver = avg_df_group_sender %>% dplyr::inner_join(lr_network, by = "ligand") %>% dplyr::inner_join(avg_df_group_receiver, by = c("receptor","group")) + avg_df_group_sender_receiver = avg_df_group_sender_receiver %>% dplyr::mutate(ligand_receptor_prod_group = avg_ligand_group * avg_receptor_group) %>% dplyr::arrange(-ligand_receptor_prod_group) %>% dplyr::select(group, sender, receiver, ligand, receptor, avg_ligand_group, avg_receptor_group, ligand_receptor_prod_group) %>% dplyr::distinct() + + # combine frq_df + + frq_df_sender = sender_info$frq_df %>% dplyr::filter(sender %in% senders_oi) + frq_df_receiver = receiver_info$frq_df %>% dplyr::filter(receiver %in% receivers_oi) + + frq_df_sender_receiver = frq_df_sender %>% dplyr::inner_join(lr_network, by = "ligand") %>% dplyr::inner_join(frq_df_receiver, by = c("receptor","sample")) + frq_df_sender_receiver = frq_df_sender_receiver %>% dplyr::mutate(ligand_receptor_fraction_prod = fraction_ligand * fraction_receptor) %>% dplyr::arrange(-ligand_receptor_fraction_prod) %>% dplyr::select(sample, sender, receiver, ligand, receptor, fraction_ligand, fraction_receptor, ligand_receptor_fraction_prod) %>% dplyr::distinct() + + # combine frq_df_group + + frq_df_group_sender = sender_info$frq_df_group %>% dplyr::filter(sender %in% senders_oi) + frq_df_group_receiver = receiver_info$frq_df_group %>% dplyr::filter(receiver %in% receivers_oi) + + frq_df_group_sender_receiver = frq_df_group_sender %>% dplyr::inner_join(lr_network, by = "ligand") %>% dplyr::inner_join(frq_df_group_receiver, by = c("receptor","group")) + frq_df_group_sender_receiver = frq_df_group_sender_receiver %>% dplyr::mutate(ligand_receptor_fraction_prod_group = fraction_ligand_group * fraction_receptor_group) %>% dplyr::arrange(-ligand_receptor_fraction_prod_group) %>% dplyr::select(group, sender, receiver, ligand, receptor, fraction_ligand_group, fraction_receptor_group, ligand_receptor_fraction_prod_group) %>% dplyr::distinct() + + # combine relative abundances + rel_abundance_df_sender = sender_info$rel_abundance_df %>% dplyr::filter(sender %in% senders_oi) + rel_abundance_df_receiver = receiver_info$rel_abundance_df %>% dplyr::filter(receiver %in% receivers_oi) + + rel_abundance_df_sender_receiver = rel_abundance_df_sender %>% dplyr::inner_join(rel_abundance_df_receiver, by = "group") %>% dplyr::mutate(sender_receiver_rel_abundance_avg = 0.5*(rel_abundance_scaled_sender + rel_abundance_scaled_receiver)) + + # return + return(list(avg_df = avg_df_sender_receiver, frq_df = frq_df_sender_receiver, avg_df_group = avg_df_group_sender_receiver, frq_df_group = frq_df_group_sender_receiver, rel_abundance_df = rel_abundance_df_sender_receiver)) +} + +#' @title combine_sender_receiver_de +#' +#' @description \code{combine_sender_receiver_de} XXXX +#' @usage combine_sender_receiver_de(sender_de, receiver_de, senders_oi, receivers_oi, lr_network) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' @inheritParams combine_sender_receiver_info_ic +#' @param sender_de XXX +#' @param receiver_de XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +combine_sender_receiver_de = function(sender_de, receiver_de, senders_oi, receivers_oi, lr_network){ + + de_output_tidy_sender = muscat::resDS(sender_de$sce, sender_de$de_output, bind = "row", cpm = FALSE, frq = FALSE) %>% tibble::as_tibble() + de_output_tidy_receiver = muscat::resDS(receiver_de$sce, receiver_de$de_output, bind = "row", cpm = FALSE, frq = FALSE) %>% tibble::as_tibble() + + de_output_tidy_sender = de_output_tidy_sender %>% dplyr::select(gene, cluster_id, logFC, p_val, p_adj.loc, contrast) %>% dplyr::filter(cluster_id %in% senders_oi) %>% dplyr::rename(ligand = gene, lfc_ligand = logFC, p_val_ligand = p_val, p_adj_ligand = p_adj.loc, sender = cluster_id) + de_output_tidy_receiver = de_output_tidy_receiver %>% dplyr::select(gene, cluster_id, logFC, p_val, p_adj.loc, contrast) %>% dplyr::filter(cluster_id %in% receivers_oi) %>% dplyr::rename(receptor = gene, lfc_receptor = logFC, p_val_receptor = p_val, p_adj_receptor = p_adj.loc, receiver = cluster_id) + + de_tbl_sender_receiver = de_output_tidy_sender %>% dplyr::inner_join(lr_network, by = "ligand") %>% dplyr::inner_join(de_output_tidy_receiver, by = c("receptor","contrast")) + de_tbl_sender_receiver = de_tbl_sender_receiver %>% dplyr::mutate(ligand_receptor_lfc_avg = (lfc_receptor + lfc_ligand)/2) %>% dplyr::arrange(-ligand_receptor_lfc_avg) %>% dplyr::select(contrast, sender, receiver, ligand, receptor, lfc_ligand, lfc_receptor, ligand_receptor_lfc_avg, p_val_ligand, p_adj_ligand, p_val_receptor, p_adj_receptor) %>% dplyr::distinct() + + return(de_tbl_sender_receiver) +} diff --git a/R/ligand_activities.R b/R/ligand_activities.R new file mode 100644 index 0000000..82c56e2 --- /dev/null +++ b/R/ligand_activities.R @@ -0,0 +1,80 @@ +#' @title get_ligand_activities_targets_DEgenes +#' +#' @description \code{get_ligand_activities_targets_DEgenes} XXXX +#' @usage get_ligand_activities_targets_DEgenes(receiver_de, receivers_oi, receiver_frq_df_group, ligand_target_matrix, logFC_threshold = 0.25, p_val_threshold = 0.05, frac_cutoff = 0.05, p_val_adj = FALSE, top_n_target = 250) +#' +#' @inheritParams ms_mg_nichenet_analysis_separate +#' @inheritParams combine_sender_receiver_info_ic +#' @inheritParams combine_sender_receiver_de +#' @param receiver_frq_df_group XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +get_ligand_activities_targets_DEgenes = function(receiver_de, receivers_oi, receiver_frq_df_group, ligand_target_matrix, logFC_threshold = 0.25, p_val_threshold = 0.05, frac_cutoff = 0.05, p_val_adj = FALSE, top_n_target = 250){ + + # consider other dplyr::filtering of the target genes? based on fraction of samples in a group that should have enough expression? + + ligand_activities_targets_geneset_ALL = receivers_oi %>% + lapply(function(receiver_oi, receiver_de, receiver_frq_df_group, frac_cutoff){ + print("receiver_oi:") + print(receiver_oi %>% as.character()) + + de_output_tidy = muscat::resDS(receiver_de$sce, receiver_de$de_output, bind = "row", cpm = FALSE, frq = FALSE) %>% tibble::as_tibble() + de_output_tidy = de_output_tidy %>% dplyr::filter(cluster_id == receiver_oi) %>% dplyr::select(gene, cluster_id, logFC, p_val, p_adj.loc, contrast) + + background_expressed_genes = de_output_tidy$gene %>% unique() %>% dplyr::intersect(rownames(ligand_target_matrix)) + ligand_target_matrix = ligand_target_matrix[rownames(ligand_target_matrix) %in% background_expressed_genes, ] + ligands = colnames(ligand_target_matrix) + + frq_tbl = receiver_frq_df_group %>% dplyr::group_by(gene, celltype) %>% dplyr::summarise(max_frac = max(fraction_group)) %>% dplyr::mutate(present = max_frac > frac_cutoff) %>% dplyr::select(gene, celltype, present, max_frac) %>% dplyr::rename(cluster_id = celltype) + + ligand_activities_targets_geneset = de_output_tidy$contrast %>% unique() %>% + lapply(function(contrast_oi,de_output_tidy){ + print("contrast_oi:") + print(contrast_oi) + if(p_val_adj == TRUE){ + de_tbl_geneset = de_output_tidy %>% dplyr::inner_join(frq_tbl) %>% dplyr::filter(contrast == contrast_oi) %>% dplyr::filter(logFC > logFC_threshold & p_adj.loc < p_val_threshold & present) + geneset_oi = de_tbl_geneset %>% dplyr::pull(gene) %>% unique() %>% dplyr::intersect(rownames(ligand_target_matrix)) + } else { + de_tbl_geneset = de_output_tidy %>% dplyr::inner_join(frq_tbl) %>% dplyr::filter(contrast == contrast_oi) %>% dplyr::filter(logFC > logFC_threshold & p_val < p_val_threshold & present) + geneset_oi = de_tbl_geneset %>% dplyr::pull(gene) %>% unique() %>% dplyr::intersect(rownames(ligand_target_matrix)) + } + + ligand_activities = nichenetr::predict_ligand_activities(geneset = geneset_oi, background_expressed_genes = background_expressed_genes, ligand_target_matrix = ligand_target_matrix, potential_ligands = ligands) + ligand_activities = ligand_activities %>% dplyr::mutate(contrast = contrast_oi) %>% tidyr::drop_na() %>% dplyr::rename(ligand = test_ligand, activity = pearson) %>% dplyr::select(-aupr, -auroc) + + ligand_target_df = ligand_activities$ligand %>% unique() %>% lapply(nichenetr::get_weighted_ligand_target_links, geneset_oi, ligand_target_matrix, top_n_target) %>% dplyr::bind_rows() %>% dplyr::mutate(contrast = contrast_oi) %>% dplyr::rename(ligand_target_weight = weight) + ligand_activities = ligand_activities %>% dplyr::inner_join(ligand_target_df) %>% dplyr::mutate(receiver = receiver_oi) + + de_genes_df = de_tbl_geneset %>% dplyr::mutate(contrast = contrast_oi) %>% dplyr::rename(receiver = cluster_id) + + return(list(ligand_activities = ligand_activities, de_genes_df = de_genes_df)) + }, de_output_tidy) + + ligand_activities = ligand_activities_targets_geneset %>% purrr::map("ligand_activities") %>% dplyr::bind_rows() + de_genes_df = ligand_activities_targets_geneset %>% purrr::map("de_genes_df") %>% dplyr::bind_rows() + + return(list(ligand_activities = ligand_activities, de_genes_df = de_genes_df)) + + },receiver_de, receiver_frq_df_group, frac_cutoff) + + + ligand_activities = ligand_activities_targets_geneset_ALL %>% purrr::map("ligand_activities") %>% dplyr::bind_rows() %>% dplyr::group_by(receiver, contrast) %>% dplyr::mutate(activity_scaled = nichenetr::scaling_zscore(activity)) + de_genes_df = ligand_activities_targets_geneset_ALL %>% purrr::map("de_genes_df") %>% dplyr::bind_rows() + + + return(list(ligand_activities = ligand_activities, de_genes_df = de_genes_df)) + +} diff --git a/R/muscat_de.R b/R/muscat_de.R new file mode 100644 index 0000000..926f290 --- /dev/null +++ b/R/muscat_de.R @@ -0,0 +1,99 @@ +#' @title perform_muscat_de_analysis +#' +#' @description \code{perform_muscat_de_analysis} XXXX +#' @usage perform_muscat_de_analysis(seurat_obj, sample_id, celltype_id, group_id, covariates, contrasts, assay_oi_sce = "RNA", assay_oi_pb = "counts", fun_oi_pb = "sum", de_method_oi = "edgeR", min_cells = 10) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +perform_muscat_de_analysis = function(seurat_obj, sample_id, celltype_id, group_id, covariates, contrasts, assay_oi_sce = "RNA", assay_oi_pb = "counts", fun_oi_pb = "sum", de_method_oi = "edgeR", min_cells = 10){ + + # convert seurat to SCE object + sce = Seurat::as.SingleCellExperiment(seurat_obj, assay = assay_oi_sce) + + # prepare SCE for the muscat pseudobulk analysis + sce$id = sce[[sample_id]] + sce = muscat::prepSCE(sce, + kid = celltype_id, # subpopulation assignments + gid = group_id, # group IDs (ctrl/stim) + sid = "id", # sample IDs (ctrl/stim.1234) + drop = FALSE) # drop all other colData columns ----------------- change to false + + pb = muscat::aggregateData(sce, + assay = assay_oi_pb, fun = fun_oi_pb, + by = c("cluster_id", "sample_id")) + + # prepare the design and contrast matrix for the muscat DE analysis + if(length(covariates) > 1){ + covariates_present = TRUE + } else { + if(!is.na(covariates)){ + covariates_present = TRUE + } else { + covariates_present = FALSE + + } + } + + if(covariates_present){ + extra_metadata = seurat_obj@meta.data %>% dplyr::select(all_of(sample_id), all_of(covariates)) %>% dplyr::distinct() %>% dplyr::mutate_all(factor) + } else { + extra_metadata = seurat_obj@meta.data %>% dplyr::select(all_of(sample_id)) %>% dplyr::distinct() %>% dplyr::mutate_all(factor) + } + if('sample_id' != sample_id){ + extra_metadata$sample_id = extra_metadata[[sample_id]] + } + ei = metadata(sce)$experiment_info + + ei = ei %>% dplyr::inner_join(extra_metadata, by = "sample_id") + + if(covariates_present){ + covariates_string = paste0("ei$",covariates) %>% paste(collapse = " + ") + design = eval(parse(text=paste("model.matrix(~ 0 + ei$group_id + ", covariates_string, " ) ",sep=""))) + dimnames(design) = list(ei$sample_id, c(levels(ei$group_id), make.names(colnames(design)[(length(levels(ei$group_id))+1):length(colnames(design))])) ) + + } else { + design = eval(parse(text=paste("model.matrix(~ 0 + ei$group_id) ",sep=""))) + dimnames(design) = list(ei$sample_id, c(levels(ei$group_id))) + + } + + contrast = eval(parse(text=paste("makeContrasts(", contrasts, ",levels=design)",sep=""))) + + # check which cell types will be excluded + n_cells = metadata(pb)$n_cells + celltypes = SummarizedExperiment::assayNames(pb) + names(celltypes) = celltypes + excluded_celltypes = celltypes %>% lapply(function(k){ + rmv = n_cells[k, ] < min_cells + d = design[colnames(y <- pb[, !rmv]), , drop = FALSE] + if (any(tabulate(y$group_id) < 2) || qr(d)$rank == nrow(d) || + qr(d)$rank < ncol(d)) { + return(k) + } + }) %>% unlist() %>% unique() + + if(length(excluded_celltypes) > 0){ + print("excluded cell types are:") + print(excluded_celltypes) + print("These celltypes are not considered in the analysis. After removing samples that contain less cells than the required minimal, some groups don't have 2 or more samples anymore. As a result the analysis cannot be run. To solve this: decrease the number of min_cells or change your group_id and pool all samples that belong to groups that are not of interest! ") + } + + # run DS analysis + res = muscat::pbDS(pb, method = de_method_oi , design = design, contrast = contrast, min_cells = min_cells, verbose = FALSE, filter = "none") + + return(list(sce = sce, de_output = res)) +} diff --git a/R/pipeline.R b/R/pipeline.R new file mode 100644 index 0000000..fc70cfc --- /dev/null +++ b/R/pipeline.R @@ -0,0 +1,819 @@ +#' @title ms_mg_nichenet_analysis +#' +#' @description \code{ms_mg_nichenet_analysis} XXXX +#' @usage ms_mg_nichenet_analysis(sender_receiver_separate = TRUE, ...) +#' +#' @param sender_receiver_separate XXXX +#' @param ... Arguments to `ms_mg_nichenet_analysis_separate` (default; when `sender_receiver_separate = TRUE`) or `ms_mg_nichenet_analysis_combined` (when `sender_receiver_separate = FALSE`) +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +ms_mg_nichenet_analysis = function(sender_receiver_separate = TRUE, ...){ + + if(!is.logical(sender_receiver_separate)) { + stop("The sender_receiver_separate argument should be TRUE or FALSE") + } + + if(sender_receiver_separate == TRUE){ + output = ms_mg_nichenet_analysis_separate(...) + } else { + output = ms_mg_nichenet_analysis_combined(...) + } + return(output) +} + +#' @title ms_mg_nichenet_analysis_separate +#' +#' @description \code{ms_mg_nichenet_analysis_separate} XXXX +#' @usage ms_mg_nichenet_analysis_separate( +#' seurat_obj_receiver,seurat_obj_sender,celltype_id_receiver,celltype_id_sender,sample_id,group_id,lr_network,ligand_target_matrix,contrasts_oi,contrast_tbl, +#' prioritizing_weights = c("scaled_lfc_ligand" = 1, "scaled_p_val_ligand" = 1, "scaled_lfc_receptor" = 1, "scaled_p_val_receptor" = 1, "scaled_activity_scaled" = 1.5, +#' "scaled_activity" = 0.5,"scaled_avg_exprs_ligand" = 1,"scaled_avg_frq_ligand" = 1,"scaled_avg_exprs_receptor" = 1, "scaled_avg_frq_receptor" = 1, +#' "fraction_expressing_ligand_receptor" = 1,"scaled_abundance_sender" = 0, "scaled_abundance_receiver" = 0), +#' assay_oi_sce = "RNA",assay_oi_pb ="counts",fun_oi_pb = "sum",de_method_oi = "edgeR",min_cells = 10,logFC_threshold = 0.25,p_val_threshold = 0.05,frac_cutoff = 0.05,p_val_adj = FALSE,top_n_target = 250, verbose = TRUE) +#' +#' @param seurat_obj_receiver XXXX +#' @param seurat_obj_sender XXXX +#' @param celltype_id_receiver XXXX +#' @param celltype_id_sender XXXX +#' @param sample_id XXXX +#' @param group_id XXXX +#' @param lr_network XXXX +#' @param ligand_target_matrix XXXX +#' @param contrasts_oi XXXX +#' @param contrast_tbl XXXX +#' @param prioritizing_weights XXXX +#' @param assay_oi_sce XXXX +#' @param assay_oi_pb XXXX +#' @param fun_oi_pb XXXX +#' @param de_method_oi XXXX +#' @param min_cells XXXX +#' @param logFC_threshold XXXX +#' @param p_val_threshold XXXX +#' @param frac_cutoff XXXX +#' @param p_val_adj XXXX +#' @param top_n_target XXXX +#' @param verbose XXXX +#' +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +ms_mg_nichenet_analysis_separate = function(seurat_obj_receiver, + seurat_obj_sender, + celltype_id_receiver, + celltype_id_sender, + sample_id, + group_id, + lr_network, + ligand_target_matrix, + contrasts_oi, + contrast_tbl, + prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0), + assay_oi_sce = "RNA", + assay_oi_pb ="counts", + fun_oi_pb = "sum", + de_method_oi = "edgeR", + min_cells = 10, + logFC_threshold = 0.25, + p_val_threshold = 0.05, + frac_cutoff = 0.05, + p_val_adj = FALSE, + top_n_target = 250, verbose = TRUE){ + + + # input checks + + if (class(seurat_obj_receiver) != "Seurat") { + stop("seurat_obj_receiver should be a Seurat object") + } + if (class(seurat_obj_sender) != "Seurat") { + stop("seurat_obj_sender should be a Seurat object") + } + if (!celltype_id_receiver %in% colnames(seurat_obj_receiver@meta.data)) { + stop("celltype_id_receiver should be a column name in the metadata dataframe of seurat_obj_receiver") + } + if (!celltype_id_sender %in% colnames(seurat_obj_sender@meta.data)) { + stop("celltype_id_sender should be a column name in the metadata dataframe of seurat_obj_sender") + } + if (!sample_id %in% colnames(seurat_obj_receiver@meta.data)) { + stop("sample_id should be a column name in the metadata dataframe of seurat_obj_receiver") + } + if (!sample_id %in% colnames(seurat_obj_sender@meta.data)) { + stop("sample_id should be a column name in the metadata dataframe of seurat_obj_sender") + } + if (!group_id %in% colnames(seurat_obj_receiver@meta.data)) { + stop("group_id should be a column name in the metadata dataframe of seurat_obj_receiver") + } + if (!group_id %in% colnames(seurat_obj_sender@meta.data)) { + stop("group_id should be a column name in the metadata dataframe of seurat_obj_sender") + } + if(!is.character(contrasts_oi)){ + stop("contrasts_oi should be a character vector") + } + if(!is.data.frame(contrast_tbl)){ + stop("contrast_tbl should be a data frame / tibble") + } + # conditions of interest in the contrast should be present in the in the group column of the metadata + groups_oi = seurat_obj_receiver@meta.data[,group_id] %>% unique() + conditions_oi = stringr::str_split(contrasts_oi, "'") %>% unlist() %>% unique() %>% + stringr::str_split("[:digit:]") %>% unlist() %>% unique() %>% + stringr::str_split("\\)") %>% unlist() %>% unique() %>% + stringr::str_split("\\(") %>% unlist() %>% unique() %>% + stringr::str_split("-") %>% unlist() %>% unique() %>% + stringr::str_split("\\+") %>% unlist() %>% unique() %>% + stringr::str_split("\\*") %>% unlist() %>% unique() %>% + stringr::str_split("\\/") %>% unlist() %>% unique() %>% generics::setdiff(c("",",")) %>% unlist() %>% unique() + + # conditions of interest in the contrast should be present in the in the contrast_tbl + contrasts_oi_simplified = stringr::str_split(contrasts_oi, "'") %>% unlist() %>% unique() %>% + stringr::str_split(",") %>% unlist() %>% unique() %>% generics::setdiff(c("",",")) %>% unlist() %>% unique() + + if (sum(conditions_oi %in% groups_oi) != length(conditions_oi)) { + warning("conditions written in contrasts_oi should be in the condition-indicating column! This is not the case, which can lead to errors downstream.") + } + if (sum(contrasts_oi_simplified %in% unique(contrast_tbl$contrast)) != length(contrasts_oi_simplified)) { + warning("conditions written in contrasts_oi should be in the contrast column of contrast_tbl column! This is not the case, which can lead to errors downstream.") + } + + # Check concordance ligand-receptor network and ligand-target network - and concordance with Seurat object features + if (!is.matrix(ligand_target_matrix)){ + stop("ligand_target_matrix should be a matrix") + } + if (!is.data.frame(lr_network)){ + stop("lr_network should be a data frame / tibble") + } + + if(! "ligand" %in% colnames(lr_network)){ + lr_network = lr_network %>% dplyr::rename(ligand = from) + } + if(! "receptor" %in% colnames(lr_network)){ + lr_network = lr_network %>% dplyr::rename(receptor = to) + } + ligands_lrnetwork = lr_network$ligand %>% unique() + receptors_lrnetwork = lr_network$receptor %>% unique() + ligands_ligand_target_matrix = colnames(ligand_target_matrix) + + if(length(intersect(ligands_lrnetwork, ligands_ligand_target_matrix)) != length(ligands_lrnetwork)){ + warning("Not all Ligands from your ligand-receptor network are in the ligand-target matrix") + } + if(length(intersect(ligands_lrnetwork, ligands_ligand_target_matrix)) != length(ligands_lrnetwork)){ + warning("Not all Ligands from your ligand-receptor network are in the ligand-target matrix") + } + + if(length(seurat_obj_sender@assays$RNA@counts %>% rownames() %>% generics::intersect(ligands_lrnetwork)) < 25 ){ + warning("Less than 25 ligands from your ligand-receptor network are in your expression matrix of the sender cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + if(length(seurat_obj_sender@assays$RNA@counts %>% rownames() %>% generics::intersect(ligands_ligand_target_matrix)) < 25 ){ + warning("Less than 25 ligands from your ligand-target matrix are in your expression matrix of the sender cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + if(length(seurat_obj_receiver@assays$RNA@counts %>% rownames() %>% generics::intersect(receptors_lrnetwork)) < 25 ){ + warning("Less than 25 receptors from your ligand-receptor network are in your expression matrix of the receiver cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + + if(length(prioritizing_weights) != 13 | !is.double(prioritizing_weights)) { + stop("prioritizing_weights should be a numeric vector with length 13") + } + names_prioritizing_weights = c("scaled_lfc_ligand", + "scaled_p_val_ligand", + "scaled_lfc_receptor", + "scaled_p_val_receptor", + "scaled_activity_scaled", + "scaled_activity", + "scaled_avg_exprs_ligand", + "scaled_avg_frq_ligand", + "scaled_avg_exprs_receptor", + "scaled_avg_frq_receptor", + "fraction_expressing_ligand_receptor", + "scaled_abundance_sender", + "scaled_abundance_receiver") + if(sum(names_prioritizing_weights %in% names(prioritizing_weights)) != length(names_prioritizing_weights)) { + stop("prioritizing_weights should be have the correct names. Check the vignettes and code documentation") + } + + if(!is.character(assay_oi_sce)){ + stop("assay_oi_sce should be a character vector") + } else { + if(assay_oi_sce != "RNA"){ + warning("are you sure you don't want to use the RNA assay?") + } + } + if(!is.character(assay_oi_pb)){ + stop("assay_oi_pb should be a character vector") + } else { + if(assay_oi_pb != "counts"){ + warning("are you sure you don't want to use the counts assay?") + } + } + if(!is.character(fun_oi_pb)){ + stop("fun_oi_pb should be a character vector") + } + if(!is.character(de_method_oi)){ + stop("de_method_oi should be a character vector") + } + + if(!is.double(min_cells)){ + stop("min_cells should be numeric") + } else { + if(min_cells <= 0) { + warning("min_cells is now 0 or smaller. We recommend having a positive, non-zero value for this parameter") + } + } + if(!is.double(logFC_threshold)){ + stop("logFC_threshold should be numeric") + } else { + if(logFC_threshold <= 0) { + warning("logFC_threshold is now 0 or smaller. We recommend having a positive, non-zero value for this parameter") + } + } + if(!is.double(p_val_threshold)){ + stop("p_val_threshold should be numeric") + } else { + if(p_val_threshold <= 0 | p_val_threshold > 1) { + warning("p_val_threshold is now 0 or smaller; or higher than 1. We recommend setting this parameter between 0 and 1 - preferably between 0 and 0.10, 0 excluded.") + } + } + if(!is.double(frac_cutoff)){ + stop("frac_cutoff should be numeric") + } else { + if(frac_cutoff <= 0 | frac_cutoff > 1) { + warning("frac_cutoff is now 0 or smaller; or higher than 1. We recommend setting this parameter between 0 and 1 - preferably between 0 and 0.25, 0 excluded.") + } + } + if(!is.double(top_n_target)){ + stop("top_n_target should be numeric") + } else { + if(top_n_target <= 0 ) { + warning("top_n_target is now 0 or smaller. We recommend having a positive, non-zero value for this parameter.") + } + } + if(!is.logical(p_val_adj)){ + stop("p_val_adj should be TRUE or FALSE") + } + if(!is.logical(verbose)){ + stop("verbose should be TRUE or FALSE") + } + + if(verbose == TRUE){ + print("Extract expression information from receiver") + } + + receiver_info = suppressMessages(get_avg_frac_exprs_abund( + seurat_obj = seurat_obj_receiver, + sample_id = sample_id, + celltype_id = celltype_id_receiver, + group_id = group_id)) + receiver_info_ic = suppressMessages(process_info_to_ic( + info_object = receiver_info, + ic_type = "receiver", + lr_network = lr_network)) + + if(verbose == TRUE){ + print("Extract expression information from sender") + } + + sender_info = suppressMessages(get_avg_frac_exprs_abund( + seurat_obj = seurat_obj_sender, + sample_id = sample_id, + celltype_id = celltype_id_sender, + group_id = group_id)) + sender_info_ic = suppressMessages(process_info_to_ic( + info_object = sender_info, + ic_type = "sender", + lr_network = lr_network)) + + senders_oi = Idents(seurat_obj_sender) %>% unique() + receivers_oi = Idents(seurat_obj_receiver) %>% unique() + + sender_receiver_info = suppressMessages(combine_sender_receiver_info_ic( + sender_info = sender_info_ic, + receiver_info = receiver_info_ic, + senders_oi = senders_oi, + receivers_oi = receivers_oi, + lr_network = lr_network)) + + ### Perform the DE analysis ---------------------------------------------------------------- + + # best: pool samples that do not belong to contrasts of interest in advance! + # necessary to have the same condition indications for both sender and receiver objects + # so: change your condition/group metadata column! + + if(verbose == TRUE){ + print("Calculate differential expression in receiver") + } + receiver_de = perform_muscat_de_analysis( + seurat_obj = seurat_obj_receiver, + sample_id = sample_id, + celltype_id = celltype_id_receiver, + group_id = group_id, + covariates = covariates, + contrasts = contrasts_oi, + assay_oi_sce = assay_oi_sce, + assay_oi_pb = assay_oi_pb, + fun_oi_pb = fun_oi_pb, + de_method_oi = de_method_oi, + min_cells = min_cells) + + if(verbose == TRUE){ + print("Calculate differential expression in sender") + } + sender_de = perform_muscat_de_analysis( + seurat_obj = seurat_obj_sender, + sample_id = sample_id, + celltype_id = celltype_id_sender, + group_id = group_id, + covariates = covariates, + contrasts = contrasts_oi, + assay_oi_sce = assay_oi_sce, + assay_oi_pb = assay_oi_pb, + fun_oi_pb = fun_oi_pb, + de_method_oi = de_method_oi, + min_cells = min_cells) + + + sender_receiver_de = suppressMessages(combine_sender_receiver_de( + sender_de = sender_de, + receiver_de = receiver_de, + senders_oi = senders_oi, + receivers_oi = receivers_oi, + lr_network = lr_network + )) + + ### Use the DE analysis for defining the DE genes in the receiver cell type and perform NicheNet ligand activity and ligand-target inference ---------------------------------------------------------------- + if(verbose == TRUE){ + print("Calculate NicheNet ligand activities and ligand-target links for receiver") + } + ligand_activities_targets_DEgenes = suppressMessages(suppressWarnings(get_ligand_activities_targets_DEgenes( + receiver_de = receiver_de, + receivers_oi = receivers_oi, + receiver_frq_df_group = receiver_info$frq_df_group, + ligand_target_matrix = ligand_target_matrix, + logFC_threshold = logFC_threshold, + p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, + p_val_adj = p_val_adj, + top_n_target = top_n_target + ))) + + rm(receiver_info_ic) + rm(sender_info_ic) + + ### Combine the three types of information calculated above to prioritize ligand-receptor interactions ---------------------------------------------------------------- + if(verbose == TRUE){ + print("Combine all the information in prioritization tables") + } + ### Remove types of information that we don't need anymore: + + sender_receiver_tbl = sender_receiver_de %>% dplyr::distinct(sender, receiver) + + metadata_combined = seurat_obj_receiver@meta.data %>% dplyr::bind_rows(seurat_obj_sender@meta.data) %>% tibble::as_tibble() + + if(!is.na(covariates)){ + grouping_tbl = metadata_combined[,c(sample_id, group_id, covariates)] %>% tibble::as_tibble() %>% dplyr::distinct() + colnames(grouping_tbl) = c("sample","group",covariates) + } else { + grouping_tbl = metadata_combined[,c(sample_id, group_id)] %>% tibble::as_tibble() %>% dplyr::distinct() + colnames(grouping_tbl) = c("sample","group") + } + + # print(grouping_tbl) + + prioritization_tables = suppressMessages(generate_prioritization_tables( + sender_receiver_info = sender_receiver_info, + sender_receiver_de = sender_receiver_de, + ligand_activities_targets_DEgenes = ligand_activities_targets_DEgenes, + contrast_tbl = contrast_tbl, + sender_receiver_tbl = sender_receiver_tbl, + grouping_tbl = grouping_tbl, + prioritizing_weights = prioritizing_weights, + fraction_cutoff = frac_cutoff + )) + + # Prepare Unsupervised analysis of samples! ------------------------------------------------------------------------------------------------------------ + if(verbose == TRUE){ + print("Prepare the ligand-receptor expression product matrix to be used for unsupervised analyses") + } + ids_oi = prioritization_tables$group_prioritization_tbl %>% dplyr::filter(fraction_expressing_ligand_receptor > 0) %>% pull(id) %>% unique() + + lr_prod_df = sender_receiver_info$avg_df %>% dplyr::inner_join(grouping_tbl, by = "sample") %>% dplyr::mutate(lr_interaction = paste(ligand, receptor, sep = "_")) %>% dplyr::mutate(id = paste(lr_interaction, sender, receiver, sep = "_")) %>% dplyr::select(sample, id, ligand_receptor_prod) %>% dplyr::filter(id %in% ids_oi) %>% dplyr::distinct() %>% tidyr::spread(id, ligand_receptor_prod) + lr_prod_mat = lr_prod_df %>% dplyr::select(-sample) %>% data.frame() %>% as.matrix() + rownames(lr_prod_mat) = lr_prod_df$sample + + col_remove = lr_prod_mat %>% apply(2,function(x)sum(x != 0)) %>% .[. == 0] %>% names() + row_remove = lr_prod_mat %>% apply(1,function(x)sum(x != 0)) %>% .[. == 0] %>% names() + + lr_prod_mat = lr_prod_mat %>% .[rownames(.) %>% generics::setdiff(col_remove),colnames(.) %>% generics::setdiff(col_remove)] + + + return( + list( + sender_info = sender_info, + receiver_info = receiver_info, + sender_de = sender_de, + receiver_de = receiver_de, + sender_receiver_info = sender_receiver_info, + sender_receiver_de = sender_receiver_de, + ligand_activities_targets_DEgenes = ligand_activities_targets_DEgenes, + prioritization_tables = prioritization_tables, + lr_prod_mat = lr_prod_mat, + grouping_tbl = grouping_tbl + ) + ) +} +#' @title ms_mg_nichenet_analysis_combined +#' +#' @description \code{ms_mg_nichenet_analysis_combined} XXXX +#' @usage ms_mg_nichenet_analysis_combined( +#' seurat_obj, celltype_id, sample_id,group_id,lr_network,ligand_target_matrix,contrasts_oi,contrast_tbl, +#' prioritizing_weights = c("scaled_lfc_ligand" = 1, "scaled_p_val_ligand" = 1, "scaled_lfc_receptor" = 1, "scaled_p_val_receptor" = 1, "scaled_activity_scaled" = 1.5, +#' "scaled_activity" = 0.5,"scaled_avg_exprs_ligand" = 1,"scaled_avg_frq_ligand" = 1,"scaled_avg_exprs_receptor" = 1, "scaled_avg_frq_receptor" = 1, +#' "fraction_expressing_ligand_receptor" = 1,"scaled_abundance_sender" = 0, "scaled_abundance_receiver" = 0), +#' assay_oi_sce = "RNA",assay_oi_pb ="counts",fun_oi_pb = "sum",de_method_oi = "edgeR",min_cells = 10,logFC_threshold = 0.25,p_val_threshold = 0.05,frac_cutoff = 0.05,p_val_adj = FALSE,top_n_target = 250, verbose = TRUE) +#' +#' @param seurat_obj XXXX +#' @param celltype_id XXXX +#' @inheritParams ms_mg_nichenet_analysis_separate +#' +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +ms_mg_nichenet_analysis_combined = function(seurat_obj, + celltype_id, + sample_id, + group_id, + lr_network, + ligand_target_matrix, + contrasts_oi, + contrast_tbl, + prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0), + assay_oi_sce = "RNA", + assay_oi_pb ="counts", + fun_oi_pb = "sum", + de_method_oi = "edgeR", + min_cells = 10, + logFC_threshold = 0.25, + p_val_threshold = 0.05, + frac_cutoff = 0.05, + p_val_adj = FALSE, + top_n_target = 250, verbose = TRUE){ + + + # input checks + + if (class(seurat_obj) != "Seurat") { + stop("seurat_obj should be a Seurat object") + } + if (!celltype_id %in% colnames(seurat_obj@meta.data)) { + stop("celltype_id should be a column name in the metadata dataframe of seurat_obj") + } + if (!sample_id %in% colnames(seurat_obj@meta.data)) { + stop("sample_id should be a column name in the metadata dataframe of seurat_obj") + } + if (!group_id %in% colnames(seurat_obj@meta.data)) { + stop("group_id should be a column name in the metadata dataframe of seurat_obj") + } + if(!is.character(contrasts_oi)){ + stop("contrasts_oi should be a character vector") + } + if(!is.data.frame(contrast_tbl)){ + stop("contrast_tbl should be a data frame / tibble") + } + # conditions of interest in the contrast should be present in the in the group column of the metadata + groups_oi = seurat_obj@meta.data[,group_id] %>% unique() + conditions_oi = stringr::str_split(contrasts_oi, "'") %>% unlist() %>% unique() %>% + stringr::str_split("[:digit:]") %>% unlist() %>% unique() %>% + stringr::str_split("\\)") %>% unlist() %>% unique() %>% + stringr::str_split("\\(") %>% unlist() %>% unique() %>% + stringr::str_split("-") %>% unlist() %>% unique() %>% + stringr::str_split("\\+") %>% unlist() %>% unique() %>% + stringr::str_split("\\*") %>% unlist() %>% unique() %>% + stringr::str_split("\\/") %>% unlist() %>% unique() %>% generics::setdiff(c("",",")) %>% unlist() %>% unique() + + # conditions of interest in the contrast should be present in the in the contrast_tbl + contrasts_oi_simplified = stringr::str_split(contrasts_oi, "'") %>% unlist() %>% unique() %>% + stringr::str_split(",") %>% unlist() %>% unique() %>% generics::setdiff(c("",",")) %>% unlist() %>% unique() + + if (sum(conditions_oi %in% groups_oi) != length(conditions_oi)) { + warning("conditions written in contrasts_oi should be in the condition-indicating column! This is not the case, which can lead to errors downstream.") + } + if (sum(contrasts_oi_simplified %in% unique(contrast_tbl$contrast)) != length(contrasts_oi_simplified)) { + warning("conditions written in contrasts_oi should be in the contrast column of contrast_tbl column! This is not the case, which can lead to errors downstream.") + } + + # Check concordance ligand-receptor network and ligand-target network - and concordance with Seurat object features + if (!is.matrix(ligand_target_matrix)){ + stop("ligand_target_matrix should be a matrix") + } + if (!is.data.frame(lr_network)){ + stop("lr_network should be a data frame / tibble") + } + + if(! "ligand" %in% colnames(lr_network)){ + lr_network = lr_network %>% dplyr::rename(ligand = from) + } + if(! "receptor" %in% colnames(lr_network)){ + lr_network = lr_network %>% dplyr::rename(receptor = to) + } + ligands_lrnetwork = lr_network$ligand %>% unique() + receptors_lrnetwork = lr_network$receptor %>% unique() + ligands_ligand_target_matrix = colnames(ligand_target_matrix) + + if(length(intersect(ligands_lrnetwork, ligands_ligand_target_matrix)) != length(ligands_lrnetwork)){ + warning("Not all Ligands from your ligand-receptor network are in the ligand-target matrix") + } + if(length(intersect(ligands_lrnetwork, ligands_ligand_target_matrix)) != length(ligands_lrnetwork)){ + warning("Not all Ligands from your ligand-receptor network are in the ligand-target matrix") + } + + if(length(seurat_obj@assays$RNA@counts %>% rownames() %>% generics::intersect(ligands_lrnetwork)) < 25 ){ + warning("Less than 25 ligands from your ligand-receptor network are in your expression matrix of the sender cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + if(length(seurat_obj@assays$RNA@counts %>% rownames() %>% generics::intersect(ligands_ligand_target_matrix)) < 25 ){ + warning("Less than 25 ligands from your ligand-target matrix are in your expression matrix of the sender cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + if(length(seurat_obj@assays$RNA@counts %>% rownames() %>% generics::intersect(receptors_lrnetwork)) < 25 ){ + warning("Less than 25 receptors from your ligand-receptor network are in your expression matrix of the receiver cell.\nDid you convert the gene symbols of the ligand-receptor network and the ligand-target matrix if your data is not from human?") + } + + if(length(prioritizing_weights) != 13 | !is.double(prioritizing_weights)) { + stop("prioritizing_weights should be a numeric vector with length 13") + } + names_prioritizing_weights = c("scaled_lfc_ligand", + "scaled_p_val_ligand", + "scaled_lfc_receptor", + "scaled_p_val_receptor", + "scaled_activity_scaled", + "scaled_activity", + "scaled_avg_exprs_ligand", + "scaled_avg_frq_ligand", + "scaled_avg_exprs_receptor", + "scaled_avg_frq_receptor", + "fraction_expressing_ligand_receptor", + "scaled_abundance_sender", + "scaled_abundance_receiver") + if(sum(names_prioritizing_weights %in% names(prioritizing_weights)) != length(names_prioritizing_weights)) { + stop("prioritizing_weights should be have the correct names. Check the vignettes and code documentation") + } + + if(!is.character(assay_oi_sce)){ + stop("assay_oi_sce should be a character vector") + } else { + if(assay_oi_sce != "RNA"){ + warning("are you sure you don't want to use the RNA assay?") + } + } + if(!is.character(assay_oi_pb)){ + stop("assay_oi_pb should be a character vector") + } else { + if(assay_oi_pb != "counts"){ + warning("are you sure you don't want to use the counts assay?") + } + } + if(!is.character(fun_oi_pb)){ + stop("fun_oi_pb should be a character vector") + } + if(!is.character(de_method_oi)){ + stop("de_method_oi should be a character vector") + } + + if(!is.double(min_cells)){ + stop("min_cells should be numeric") + } else { + if(min_cells <= 0) { + warning("min_cells is now 0 or smaller. We recommend having a positive, non-zero value for this parameter") + } + } + if(!is.double(logFC_threshold)){ + stop("logFC_threshold should be numeric") + } else { + if(logFC_threshold <= 0) { + warning("logFC_threshold is now 0 or smaller. We recommend having a positive, non-zero value for this parameter") + } + } + if(!is.double(p_val_threshold)){ + stop("p_val_threshold should be numeric") + } else { + if(p_val_threshold <= 0 | p_val_threshold > 1) { + warning("p_val_threshold is now 0 or smaller; or higher than 1. We recommend setting this parameter between 0 and 1 - preferably between 0 and 0.10, 0 excluded.") + } + } + if(!is.double(frac_cutoff)){ + stop("frac_cutoff should be numeric") + } else { + if(frac_cutoff <= 0 | frac_cutoff > 1) { + warning("frac_cutoff is now 0 or smaller; or higher than 1. We recommend setting this parameter between 0 and 1 - preferably between 0 and 0.25, 0 excluded.") + } + } + if(!is.double(top_n_target)){ + stop("top_n_target should be numeric") + } else { + if(top_n_target <= 0 ) { + warning("top_n_target is now 0 or smaller. We recommend having a positive, non-zero value for this parameter.") + } + } + if(!is.logical(p_val_adj)){ + stop("p_val_adj should be TRUE or FALSE") + } + if(!is.logical(verbose)){ + stop("verbose should be TRUE or FALSE") + } + + + if(verbose == TRUE){ + print("Extract expression information from all cell types") + } + + celltype_info = suppressMessages(get_avg_frac_exprs_abund( + seurat_obj = seurat_obj, + sample_id = sample_id, + celltype_id = celltype_id, + group_id = group_id)) + + receiver_info_ic = suppressMessages(process_info_to_ic( + info_object = celltype_info, + ic_type = "receiver", + lr_network = lr_network)) + + sender_info_ic = suppressMessages(process_info_to_ic( + info_object = celltype_info, + ic_type = "sender", + lr_network = lr_network)) + + senders_oi = Idents(seurat_obj) %>% unique() + receivers_oi = Idents(seurat_obj) %>% unique() + + sender_receiver_info = suppressMessages(combine_sender_receiver_info_ic( + sender_info = sender_info_ic, + receiver_info = receiver_info_ic, + senders_oi = senders_oi, + receivers_oi = receivers_oi, + lr_network = lr_network)) + + ### Perform the DE analysis ---------------------------------------------------------------- + + # best: pool samples that do not belong to contrasts of interest in advance! + # necessary to have the same condition indications for both sender and receiver objects + # so: change your condition/group metadata column! + + if(verbose == TRUE){ + print("Calculate differential expression for all cell types") + } + celltype_de = perform_muscat_de_analysis( + seurat_obj = seurat_obj, + sample_id = sample_id, + celltype_id = celltype_id, + group_id = group_id, + covariates = covariates, + contrasts = contrasts_oi, + assay_oi_sce = assay_oi_sce, + assay_oi_pb = assay_oi_pb, + fun_oi_pb = fun_oi_pb, + de_method_oi = de_method_oi, + min_cells = min_cells) + + sender_receiver_de = suppressMessages(combine_sender_receiver_de( + sender_de = celltype_de, + receiver_de = celltype_de, + senders_oi = senders_oi, + receivers_oi = receivers_oi, + lr_network = lr_network + )) + + ### Use the DE analysis for defining the DE genes in the receiver cell type and perform NicheNet ligand activity and ligand-target inference ---------------------------------------------------------------- + if(verbose == TRUE){ + print("Calculate NicheNet ligand activities and ligand-target links") + } + ligand_activities_targets_DEgenes = suppressMessages(suppressWarnings(get_ligand_activities_targets_DEgenes( + receiver_de = celltype_de, + receivers_oi = receivers_oi, + receiver_frq_df_group = celltype_info$frq_df_group, + ligand_target_matrix = ligand_target_matrix, + logFC_threshold = logFC_threshold, + p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, + p_val_adj = p_val_adj, + top_n_target = top_n_target + ))) + + rm(receiver_info_ic) + rm(sender_info_ic) + + ### Combine the three types of information calculated above to prioritize ligand-receptor interactions ---------------------------------------------------------------- + if(verbose == TRUE){ + print("Combine all the information in prioritization tables") + } + ### Remove types of information that we don't need anymore: + + sender_receiver_tbl = sender_receiver_de %>% dplyr::distinct(sender, receiver) + + metadata_combined = seurat_obj@meta.data %>% tibble::as_tibble() + + if(!is.na(covariates)){ + grouping_tbl = metadata_combined[,c(sample_id, group_id, covariates)] %>% tibble::as_tibble() %>% dplyr::distinct() + colnames(grouping_tbl) = c("sample","group",covariates) + } else { + grouping_tbl = metadata_combined[,c(sample_id, group_id)] %>% tibble::as_tibble() %>% dplyr::distinct() + colnames(grouping_tbl) = c("sample","group") + } + + # print(grouping_tbl) + + prioritization_tables = suppressMessages(generate_prioritization_tables( + sender_receiver_info = sender_receiver_info, + sender_receiver_de = sender_receiver_de, + ligand_activities_targets_DEgenes = ligand_activities_targets_DEgenes, + contrast_tbl = contrast_tbl, + sender_receiver_tbl = sender_receiver_tbl, + grouping_tbl = grouping_tbl, + prioritizing_weights = prioritizing_weights, + fraction_cutoff = frac_cutoff + )) + + # Prepare Unsupervised analysis of samples! ------------------------------------------------------------------------------------------------------------ + if(verbose == TRUE){ + print("Prepare the ligand-receptor expression product matrix to be used for unsupervised analyses") + } + ids_oi = prioritization_tables$group_prioritization_tbl %>% dplyr::filter(fraction_expressing_ligand_receptor > 0) %>% pull(id) %>% unique() + + lr_prod_df = sender_receiver_info$avg_df %>% dplyr::inner_join(grouping_tbl, by = "sample") %>% dplyr::mutate(lr_interaction = paste(ligand, receptor, sep = "_")) %>% dplyr::mutate(id = paste(lr_interaction, sender, receiver, sep = "_")) %>% dplyr::select(sample, id, ligand_receptor_prod) %>% dplyr::filter(id %in% ids_oi) %>% dplyr::distinct() %>% tidyr::spread(id, ligand_receptor_prod) + lr_prod_mat = lr_prod_df %>% dplyr::select(-sample) %>% data.frame() %>% as.matrix() + rownames(lr_prod_mat) = lr_prod_df$sample + + col_remove = lr_prod_mat %>% apply(2,function(x)sum(x != 0)) %>% .[. == 0] %>% names() + row_remove = lr_prod_mat %>% apply(1,function(x)sum(x != 0)) %>% .[. == 0] %>% names() + + lr_prod_mat = lr_prod_mat %>% .[rownames(.) %>% generics::setdiff(col_remove),colnames(.) %>% generics::setdiff(col_remove)] + + + return( + list( + celltype_info = celltype_info, + celltype_de = celltype_de, + sender_receiver_info = sender_receiver_info, + sender_receiver_de = sender_receiver_de, + ligand_activities_targets_DEgenes = ligand_activities_targets_DEgenes, + prioritization_tables = prioritization_tables, + lr_prod_mat = lr_prod_mat, + grouping_tbl = grouping_tbl + ) + ) +} diff --git a/R/plotting.R b/R/plotting.R new file mode 100644 index 0000000..59787c1 --- /dev/null +++ b/R/plotting.R @@ -0,0 +1,1326 @@ +#' @title make_sample_lr_prod_plots +#' +#' @description \code{make_sample_lr_prod_plots} XXXX +#' @usage make_sample_lr_prod_plots(prioritization_tables, prioritized_tbl_oi) +#' +#' @param prioritization_tables XXX +#' @param prioritized_tbl_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_sample_lr_prod_plots = function(prioritization_tables, prioritized_tbl_oi){ + filtered_data = prioritization_tables$sample_prioritization_tbl %>% dplyr::filter(id %in% prioritized_tbl_oi$id) %>% dplyr::mutate(sender_receiver = paste(sender, receiver, sep = "\nto\n")) %>% dplyr::arrange(sender) %>% group_by(sender) %>% dplyr::arrange(receiver) + p1 = filtered_data %>% + ggplot(aes(sample, lr_interaction, color = scaled_LR_prod, size = scaled_LR_frac)) + + geom_point() + + facet_grid(sender_receiver~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(color = "Scaled L-R\navg expression product", size= "Scaled L-R\navg exprs fraction product") + max_lfc = abs(filtered_data$scaled_LR_prod) %>% max() + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + + p1 = p1 + custom_scale_fill + + return(p1) + +} + +#' @title make_sample_lr_prod_activity_plots +#' +#' @description \code{make_sample_lr_prod_activity_plots} XXXX +#' @usage make_sample_lr_prod_activity_plots(prioritization_tables, prioritized_tbl_oi, widths = NULL) +#' +#' @param prioritization_tables XXX +#' @param prioritized_tbl_oi XXX +#' @param widths XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_sample_lr_prod_activity_plots = function(prioritization_tables, prioritized_tbl_oi, widths = NULL){ + + sample_data = prioritization_tables$sample_prioritization_tbl %>% dplyr::filter(id %in% prioritized_tbl_oi$id) %>% dplyr::mutate(sender_receiver = paste(sender, receiver, sep = "\nto\n")) %>% dplyr::arrange(sender) %>% group_by(sender) %>% dplyr::arrange(receiver) + + group_data = prioritization_tables$group_prioritization_tbl %>% dplyr::mutate(sender_receiver = paste(sender, receiver, sep = "\nto\n")) %>% dplyr::distinct(id, sender, receiver, sender_receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity, activity_scaled, fraction_ligand_group, prioritization_score, scaled_avg_exprs_ligand) %>% dplyr::filter(id %in% sample_data$id) + + p1 = sample_data %>% + ggplot(aes(sample, lr_interaction, color = scaled_LR_prod, size = scaled_LR_frac)) + + geom_point() + + facet_grid(sender_receiver~group, scales = "free", space = "free", switch = "y") + + scale_x_discrete(position = "top") + + # xlab("Ligand-Receptor expression in samples\n\n") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title = element_blank(), + # axis.title.x = element_text(face = "bold", size = 11), axis.title.y = element_blank(), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(0.40, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x.top = element_text(size = 10, color = "black", face = "bold", angle = 0), + strip.text.y.left = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(color = "Scaled L-R\navg expression product", size= "Scaled L-R\navg exprs fraction product") + max_lfc = abs(sample_data$scaled_LR_prod) %>% max() + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + + p1 = p1 + custom_scale_fill + + + p2 = group_data %>% + # ggplot(aes(receiver, lr_interaction, color = activity_scaled, size = activity)) + + # geom_point() + + ggplot(aes(receiver, lr_interaction, fill = activity_scaled)) + + geom_tile(color = "whitesmoke") + + facet_grid(sender_receiver~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + # xlab("Ligand activities in receiver cell types\n\n") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title = element_blank(), + # axis.title.x = element_text(face = "bold", size = 11), axis.title.y = element_blank(), + # axis.text.y = element_blank(), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(0.20, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 10, color = "black", face = "bold"), + strip.text.y = element_blank(), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "Scaled Ligand\nActivity in Receiver") + max_activity = abs(group_data$activity_scaled) %>% max() + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "PuRd") %>% .[-7]),values = c(0, 0.40, 0.50, 0.60, 0.70, 0.825, 1), limits = c(-1*max_activity, max_activity)) + + p2 = p2 + custom_scale_fill + + p3 = group_data %>% + ggplot(aes(receiver, lr_interaction, fill = activity)) + + geom_tile(color = "whitesmoke") + + facet_grid(sender_receiver~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + # xlab("Ligand activities in receiver cell types\n\n") + + theme_light() + + theme( + axis.ticks = element_blank(), + # axis.title.x = element_text(face = "bold", size = 11), + axis.title = element_blank(), + axis.title.y = element_blank(), + axis.text.y = element_blank(), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(0.20, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 10, color = "black", face = "bold"), + strip.text.y = element_blank(), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "Ligand\nActivity in Receiver") + max_activity = (group_data$activity) %>% max() + min_activity = (group_data$activity) %>% min() + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "Oranges") %>% .[-7]),values = c(0, 0.250, 0.5550, 0.675, 0.80, 0.925, 1), limits = c(min_activity-0.01, max_activity)) + + p3 = p3 + custom_scale_fill + + + if(!is.null(widths)){ + p = patchwork::wrap_plots( + p1,p2,p3, + nrow = 1,guides = "collect", + widths = widths + ) + } else { + p = patchwork::wrap_plots( + p1,p2,p3, + nrow = 1,guides = "collect", + widths = c(filtered_data$sample %>% unique() %>% length(), plot_data$receiver %>% unique() %>% length(), plot_data$receiver %>% unique() %>% length()) + ) + } + + + return(p) + + +} + +#' @title make_ligand_activity_plots +#' +#' @description \code{make_ligand_activity_plots} XXXX +#' @usage make_ligand_activity_plots(prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +#' +#' @param prioritization_tables XXX +#' @param ligands_oi XXX +#' @param contrast_tbl XXX +#' @param widths XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_ligand_activity_plots = function(prioritization_tables, ligands_oi, contrast_tbl, widths = NULL){ + + group_data = prioritization_tables$ligand_activities_target_de_tbl %>% dplyr::inner_join(contrast_tbl) %>% dplyr::distinct(group, ligand, receiver, activity, activity_scaled) %>% dplyr::filter(ligand %in% ligands_oi) + + + p1 = group_data %>% + # ggplot(aes(receiver, lr_interaction, color = activity_scaled, size = activity)) + + # geom_point() + + ggplot(aes(receiver, ligand, fill = activity_scaled)) + + geom_tile(color = "whitesmoke") + + facet_grid(.~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + # xlab("Ligand activities in receiver cell types\n\n") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title = element_blank(), + # axis.title.x = element_text(face = "bold", size = 11), axis.title.y = element_blank(), + # axis.text.y = element_blank(), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(0.20, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 10, color = "black", face = "bold"), + strip.text.y = element_blank(), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "Scaled Ligand\nActivity in Receiver") + max_activity = abs(group_data$activity_scaled) %>% max() + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "PuRd") %>% .[-7]),values = c(0, 0.40, 0.50, 0.60, 0.70, 0.825, 1), limits = c(-1*max_activity, max_activity)) + + p1 = p1 + custom_scale_fill + + p2 = group_data %>% + ggplot(aes(receiver, ligand, fill = activity)) + + geom_tile(color = "whitesmoke") + + facet_grid(.~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + # xlab("Ligand activities in receiver cell types\n\n") + + theme_light() + + theme( + axis.ticks = element_blank(), + # axis.title.x = element_text(face = "bold", size = 11), + axis.title = element_blank(), + axis.title.y = element_blank(), + axis.text.y = element_blank(), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(0.20, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 10, color = "black", face = "bold"), + strip.text.y = element_blank(), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "Ligand\nActivity in Receiver") + max_activity = (group_data$activity) %>% max() + min_activity = (group_data$activity) %>% min() + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "Oranges") %>% .[-7]),values = c(0, 0.250, 0.5550, 0.675, 0.80, 0.925, 1), limits = c(min_activity-0.01, max_activity)) + + p2 = p2 + custom_scale_fill + + + if(!is.null(widths)){ + p = patchwork::wrap_plots( + p1,p2, + nrow = 1,guides = "collect", + widths = widths + ) + } else { + p = patchwork::wrap_plots( + p1,p2, + nrow = 1,guides = "collect", + widths = c(plot_data$receiver %>% unique() %>% length(), plot_data$receiver %>% unique() %>% length()) + ) + } + + + return(p) + + +} + +#' @title make_sample_target_plots +#' +#' @description \code{make_sample_target_plots} XXXX +#' @usage make_sample_target_plots(receiver_info, targets_oi, receiver_oi, grouping_tbl) +#' +#' @param receiver_info XXX +#' @param targets_oi XXX +#' @param receiver_oi XXX +#' @param grouping_tbl XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_sample_target_plots = function(receiver_info, targets_oi, receiver_oi, grouping_tbl){ + + avg_df = receiver_info$avg_df %>% dplyr::filter(gene %in% targets_oi & celltype %in% receiver_oi) + frq_df = receiver_info$frq_df %>% dplyr::filter(gene %in% targets_oi & celltype %in% receiver_oi) + + filtered_data = avg_df %>% dplyr::inner_join(frq_df) %>% dplyr::inner_join(grouping_tbl) + + filtered_data = filtered_data %>% dplyr::group_by(gene) %>% dplyr::mutate(scaled_target_exprs = nichenetr::scaling_zscore(average_sample), scaled_target_frac = nichenetr::scaling_zscore(fraction_sample)) %>% dplyr::ungroup() + filtered_data$gene = factor(filtered_data$gene, levels=targets_oi) + + p1 = filtered_data %>% + ggplot(aes(sample, gene, color = scaled_target_exprs, size = fraction_sample)) + + geom_point() + + facet_grid(.~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(color = "Scaled target\navg expression", size= "Target\n exprs fraction") + max_lfc = abs(filtered_data$scaled_target_exprs) %>% max() + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + p1 = p1 + custom_scale_fill + return(p1) +} + +#' @title make_sample_target_plots_reversed +#' +#' @description \code{make_sample_target_plots_reversed} XXXX +#' @usage make_sample_target_plots_reversed(receiver_info, targets_oi, receiver_oi, grouping_tbl) +#' +#' @param receiver_info XXX +#' @param targets_oi XXX +#' @param receiver_oi XXX +#' @param grouping_tbl XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_sample_target_plots_reversed = function(receiver_info, targets_oi, receiver_oi, grouping_tbl){ + + avg_df = receiver_info$avg_df %>% dplyr::filter(gene %in% targets_oi & celltype %in% receiver_oi) + frq_df = receiver_info$frq_df %>% dplyr::filter(gene %in% targets_oi & celltype %in% receiver_oi) + + filtered_data = avg_df %>% dplyr::inner_join(frq_df) %>% dplyr::inner_join(grouping_tbl) + + filtered_data = filtered_data %>% dplyr::group_by(gene) %>% dplyr::mutate(scaled_target_exprs = nichenetr::scaling_zscore(average_sample), scaled_target_frac = nichenetr::scaling_zscore(fraction_sample)) %>% dplyr::ungroup() + + filtered_data$gene = factor(filtered_data$gene, levels=targets_oi) + + p1 = filtered_data %>% + # ggplot(aes(gene, sample , fill = scaled_target_exprs)) + + # geom_tile(color = "white") + + ggplot(aes(gene, sample , color = scaled_target_exprs, size = fraction_sample)) + + geom_point() + + facet_grid(group~., scales = "free", space = "free") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.x = element_text(face = "italic", size = 9, angle = 90,hjust = 0), + axis.text.y = element_text(size = 9), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 9, color = "black", face = "bold"), + strip.text.y = element_text(size = 11, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + + # labs(color = "Scaled target\navg expression") + labs(color = "Scaled target\navg expression", size= "Target\n exprs fraction") + max_lfc = abs(filtered_data$scaled_target_exprs) %>% max() + # custom_scale_fill = scale_fill_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + + plot = p1 + custom_scale_fill + + + return( plot ) +} + +#' @title make_group_lfc_exprs_activity_plot +#' +#' @description \code{make_group_lfc_exprs_activity_plot} XXXX +#' @usage make_group_lfc_exprs_activity_plot(prioritization_tables, prioritized_tbl_oi, receiver_oi, heights = NULL) +#' +#' @param prioritization_tables XXX +#' @param prioritized_tbl_oi XXX +#' @param receiver_oi XXX +#' @param heights XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_group_lfc_exprs_activity_plot = function(prioritization_tables, prioritized_tbl_oi, receiver_oi, heights = NULL){ + filtered_data = prioritization_tables$group_prioritization_tbl %>% dplyr::filter(id %in% prioritized_tbl_oi$id & receiver == receiver_oi) %>% dplyr::mutate(sender_receiver = paste(sender, receiver, sep = "\nto\n")) %>% dplyr::arrange(sender) %>% group_by(sender) %>% dplyr::arrange(receiver) + plot_data = prioritization_tables$group_prioritization_tbl %>% dplyr::mutate(sender_receiver = paste(sender, receiver, sep = "\nto\n")) %>% dplyr::distinct(id, sender, receiver, sender_receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity, activity_scaled, fraction_ligand_group, prioritization_score, scaled_avg_exprs_ligand) %>% dplyr::filter(lr_interaction %in% filtered_data$lr_interaction & receiver == receiver_oi) + + p_exprs = plot_data %>% + ggplot(aes(lr_interaction, group, color = ligand_receptor_lfc_avg, size = scaled_avg_exprs_ligand)) + + geom_point() + + facet_grid(sender_receiver~., scales = "free", space = "free") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(color = "Average of\nLogFC ligand & \nLogFC receptor", size= "Scaled average of\nligand expression") + max_lfc = abs(plot_data$ligand_receptor_lfc_avg) %>% max() + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdBu") %>% rev(),values = c(0, 0.350, 0.4850, 0.5, 0.5150, 0.65, 1), limits = c(-1*max_lfc, max_lfc)) + p_exprs = p_exprs + custom_scale_fill + + p_activity_scaled = plot_data %>% + ggplot(aes(lr_interaction, group, fill = activity_scaled)) + + geom_tile(color = "white", size = 0.5) + + scale_fill_gradient2(low = "purple", mid = "whitesmoke", high = "orange") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "Scaled NicheNet\nligand activity") + max_activity = abs(plot_data$activity_scaled) %>% max() + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "PuRd") %>% .[-7]),values = c(0, 0.40, 0.50, 0.60, 0.70, 0.825, 1), limits = c(-1*max_activity, max_activity)) + p_activity_scaled = p_activity_scaled + custom_scale_fill + + p_activity = plot_data %>% + ggplot(aes(lr_interaction, group, fill = activity)) + + geom_tile(color = "white", size = 0.5) + + scale_fill_gradient2(low = "white", mid = "whitesmoke", high = "orange") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold.italic", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + labs(fill = "NicheNet\nligand activity") + max_activity = (plot_data$activity) %>% max() + min_activity = (plot_data$activity) %>% min() + # custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "OrRd") %>% .[-7]),values = c(0, 0.25, 0.40, 0.55, 0.70, 0.825, 1), limits = c(min_activity-0.01, max_activity)) + custom_scale_fill = scale_fill_gradientn(colours = c("white", RColorBrewer::brewer.pal(n = 7, name = "Oranges") %>% .[-7]),values = c(0, 0.250, 0.5550, 0.675, 0.80, 0.925, 1), limits = c(min_activity-0.01, max_activity)) + + p_activity = p_activity + custom_scale_fill + + if(!is.null(heights)){ + # heights should be a vector of lenght 2 + p = patchwork::wrap_plots( + p_exprs , + p_activity + theme(axis.text.x = element_blank()), + p_activity_scaled + theme(axis.text.x = element_blank()), + nrow = 3,guides = "collect" + ) + patchwork::plot_layout(heights = heights) + } else { + p = patchwork::wrap_plots( + p_exprs , + p_activity + theme(axis.text.x = element_blank()), + p_activity_scaled + theme(axis.text.x = element_blank()), + nrow = 3,guides = "collect" + ) + patchwork::plot_layout(heights = c(plot_data$sender %>% unique() %>% length(), 1, 1)) + } + + return(p) +} + +#' @title make_circos_group_comparison +#' +#' @description \code{make_circos_group_comparison} XXXX +#' @usage make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) +#' +#' @param prioritized_tbl_oi XXX +#' @param colors_sender XXX +#' @param colors_receiver XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_circos_group_comparison = function(prioritized_tbl_oi, colors_sender, colors_receiver){ + + # Link each cell type to a color + grid_col_ligand = colors_sender + names(grid_col_ligand) = prioritized_tbl_oi$sender %>% unique() %>% sort() + + grid_col_receptor = colors_receiver + names(grid_col_receptor) = prioritized_tbl_oi$receiver %>% unique() %>% sort() + + grid_col_tbl_ligand = tibble::tibble(sender = grid_col_ligand %>% names(), color_ligand_type = grid_col_ligand) + grid_col_tbl_receptor = tibble::tibble(receiver = grid_col_receptor %>% names(), color_receptor_type = grid_col_receptor) + + # Make the plot for each condition + groups_oi = prioritized_tbl_oi$group %>% unique() + all_plots = groups_oi %>% lapply(function(group_oi){ + + # Make the plot for condition of interest - title of the plot + title = group_oi + circos_links_oi = prioritized_tbl_oi %>% dplyr::filter(group == group_oi) + + # deal with duplicated sector names + # dplyr::rename the ligands so we can have the same ligand in multiple senders (and receptors in multiple receivers) + # only do it with duplicated ones! + circos_links = circos_links_oi %>% dplyr::rename(weight = prioritization_score) + #circos_links = circos_links_oi %>% dplyr::rename(weight = prioritization_score) %>% dplyr::mutate(ligand = paste(sender, ligand, sep = "_"), receptor = paste(receptor, receiver, sep = "_")) + + df = circos_links + + ligand.uni = unique(df$ligand) + for (i in 1:length(ligand.uni)) { + df.i = df[df$ligand == ligand.uni[i], ] + sender.uni = unique(df.i$sender) + for (j in 1:length(sender.uni)) { + df.i.j = df.i[df.i$sender == sender.uni[j], ] + df.i.j$ligand = paste0(df.i.j$ligand, paste(rep(' ',j-1),collapse = '')) + df$ligand[df$id %in% df.i.j$id] = df.i.j$ligand + } + } + receptor.uni = unique(df$receptor) + for (i in 1:length(receptor.uni)) { + df.i = df[df$receptor == receptor.uni[i], ] + receiver.uni = unique(df.i$receiver) + for (j in 1:length(receiver.uni)) { + df.i.j = df.i[df.i$receiver == receiver.uni[j], ] + df.i.j$receptor = paste0(df.i.j$receptor, paste(rep(' ',j-1),collapse = '')) + df$receptor[df$id %in% df.i.j$id] = df.i.j$receptor + } + } + + intersecting_ligands_receptors = generics::intersect(unique(df$ligand),unique(df$receptor)) + + # print(intersecting_ligands_receptors) + + if(length(intersecting_ligands_receptors) > 0){ + df_unique = df %>% dplyr::filter(!receptor %in% intersecting_ligands_receptors) + df_duplicated = df %>% dplyr::filter(receptor %in% intersecting_ligands_receptors) + df_duplicated = df_duplicated %>% dplyr::mutate(receptor = paste(receptor, " ", sep = "")) + df = dplyr::bind_rows(df_unique, df_duplicated) + } + + circos_links = df + + # Link ligands/Receptors to the colors of senders/receivers + circos_links = circos_links %>% dplyr::inner_join(grid_col_tbl_ligand) %>% dplyr::inner_join(grid_col_tbl_receptor) + links_circle = circos_links %>% dplyr::distinct(ligand,receptor, weight) + ligand_color = circos_links %>% dplyr::distinct(ligand,color_ligand_type) + grid_ligand_color = ligand_color$color_ligand_type %>% magrittr::set_names(ligand_color$ligand) + receptor_color = circos_links %>% dplyr::distinct(receptor,color_receptor_type) + grid_receptor_color = receptor_color$color_receptor_type %>% magrittr::set_names(receptor_color$receptor) + grid_col =c(grid_ligand_color,grid_receptor_color) + + # give the option that links in the circos plot will be transparant ~ ligand-receptor potential score + transparency = circos_links %>% dplyr::mutate(weight =(weight-min(weight))/(max(weight)-min(weight))) %>% dplyr::mutate(transparency = 1-weight) %>% .$transparency + + # Define order of the ligands and receptors and the gaps + ligand_order = prioritized_tbl_oi$sender %>% unique() %>% sort() %>% lapply(function(sender_oi){ + ligands = circos_links %>% dplyr::filter(sender == sender_oi) %>% dplyr::arrange(ligand) %>% dplyr::distinct(ligand) + }) %>% unlist() + + receptor_order = prioritized_tbl_oi$receiver %>% unique() %>% sort() %>% lapply(function(receiver_oi){ + receptors = circos_links %>% dplyr::filter(receiver == receiver_oi) %>% dplyr::arrange(receptor) %>% dplyr::distinct(receptor) + }) %>% unlist() + + order = c(ligand_order,receptor_order) + # print(length(order)) + # print(length(ligand_order)) + # print(length(receptor_order)) + # print(length(ligand_order %>% unique())) + # print(length(receptor_order %>% unique())) + + + ###### second de-duplication - sometimes necessary + df = circos_links + + ligand.uni = unique(df$ligand) + for (i in 1:length(ligand.uni)) { + df.i = df[df$ligand == ligand.uni[i], ] + sender.uni = unique(df.i$sender) + for (j in 1:length(sender.uni)) { + df.i.j = df.i[df.i$sender == sender.uni[j], ] + df.i.j$ligand = paste0(df.i.j$ligand, paste(rep(' ',j-1),collapse = '')) + df$ligand[df$id %in% df.i.j$id] = df.i.j$ligand + } + } + receptor.uni = unique(df$receptor) + for (i in 1:length(receptor.uni)) { + df.i = df[df$receptor == receptor.uni[i], ] + receiver.uni = unique(df.i$receiver) + for (j in 1:length(receiver.uni)) { + df.i.j = df.i[df.i$receiver == receiver.uni[j], ] + df.i.j$receptor = paste0(df.i.j$receptor, paste(rep(' ',j-1),collapse = '')) + df$receptor[df$id %in% df.i.j$id] = df.i.j$receptor + } + } + + intersecting_ligands_receptors = generics::intersect(unique(df$ligand),unique(df$receptor)) + + # print(intersecting_ligands_receptors) + + if(length(intersecting_ligands_receptors) > 0){ + df_unique = df %>% dplyr::filter(!receptor %in% intersecting_ligands_receptors) + df_duplicated = df %>% dplyr::filter(receptor %in% intersecting_ligands_receptors) + df_duplicated = df_duplicated %>% dplyr::mutate(receptor = paste(receptor, " ", sep = "")) + df = dplyr::bind_rows(df_unique, df_duplicated) + } + + circos_links = df + + # Link ligands/Receptors to the colors of senders/receivers + circos_links = circos_links %>% dplyr::inner_join(grid_col_tbl_ligand) %>% dplyr::inner_join(grid_col_tbl_receptor) + links_circle = circos_links %>% dplyr::distinct(ligand,receptor, weight) + ligand_color = circos_links %>% dplyr::distinct(ligand,color_ligand_type) + grid_ligand_color = ligand_color$color_ligand_type %>% magrittr::set_names(ligand_color$ligand) + receptor_color = circos_links %>% dplyr::distinct(receptor,color_receptor_type) + grid_receptor_color = receptor_color$color_receptor_type %>% magrittr::set_names(receptor_color$receptor) + grid_col =c(grid_ligand_color,grid_receptor_color) + + # give the option that links in the circos plot will be transparant ~ ligand-receptor potential score + transparency = circos_links %>% dplyr::mutate(weight =(weight-min(weight))/(max(weight)-min(weight))) %>% dplyr::mutate(transparency = 1-weight) %>% .$transparency + + # Define order of the ligands and receptors and the gaps + ligand_order = prioritized_tbl_oi$sender %>% unique() %>% sort() %>% lapply(function(sender_oi){ + ligands = circos_links %>% dplyr::filter(sender == sender_oi) %>% dplyr::arrange(ligand) %>% dplyr::distinct(ligand) + }) %>% unlist() + + receptor_order = prioritized_tbl_oi$receiver %>% unique() %>% sort() %>% lapply(function(receiver_oi){ + receptors = circos_links %>% dplyr::filter(receiver == receiver_oi) %>% dplyr::arrange(receptor) %>% dplyr::distinct(receptor) + }) %>% unlist() + + order = c(ligand_order,receptor_order) + + # print(length(order)) + # print(length(ligand_order)) + # print(length(receptor_order)) + # print(length(ligand_order %>% unique())) + # print(length(receptor_order %>% unique())) + + width_same_cell_same_ligand_type = 0.275 + width_different_cell = 3 + width_ligand_receptor = 9 + width_same_cell_same_receptor_type = 0.275 + + sender_gaps = prioritized_tbl_oi$sender %>% unique() %>% sort() %>% lapply(function(sender_oi){ + sector = rep(width_same_cell_same_ligand_type, times = (circos_links %>% dplyr::filter(sender == sender_oi) %>% dplyr::distinct(ligand) %>% nrow() -1)) + gap = width_different_cell + return(c(sector,gap)) + }) %>% unlist() + sender_gaps = sender_gaps[-length(sender_gaps)] + + receiver_gaps = prioritized_tbl_oi$receiver %>% unique() %>% sort() %>% lapply(function(receiver_oi){ + sector = rep(width_same_cell_same_receptor_type, times = (circos_links %>% dplyr::filter(receiver == receiver_oi) %>% dplyr::distinct(receptor) %>% nrow() -1)) + gap = width_different_cell + return(c(sector,gap)) + }) %>% unlist() + receiver_gaps = receiver_gaps[-length(receiver_gaps)] + + gaps = c(sender_gaps, width_ligand_receptor, receiver_gaps, width_ligand_receptor) + + # print(length(gaps)) + # print(length(union(circos_links$ligand, circos_links$receptor) %>% unique())) + if(length(gaps) != length(union(circos_links$ligand, circos_links$receptor) %>% unique())){ + warning("Specified gaps have different length than combined total of ligands and receptors - This is probably due to duplicates in ligand-receptor names") + } + + + links_circle$weight[links_circle$weight == 0] = 0.01 + circos.clear() + circos.par(gap.degree = gaps) + chordDiagram(links_circle, + directional = 1, + order=order, + link.sort = FALSE, + link.decreasing = TRUE, + grid.col = grid_col, + transparency = transparency, + diffHeight = 0.005, + direction.type = c("diffHeight", "arrows"), + link.arr.type = "big.arrow", + link.visible = links_circle$weight > 0.01, + annotationTrack = "grid", + preAllocateTracks = list(track.height = 0.075), + reduce = 0, + scale = TRUE) + circos.track(track.index = 1, panel.fun = function(x, y) { + circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index, + facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5), cex = 1.15) + }, bg.border = NA) # + + title(title) + p_circos = recordPlot() + return(p_circos) + + }) + names(all_plots) = groups_oi + + plot(NULL ,xaxt='n',yaxt='n',bty='n',ylab='',xlab='', xlim=0:1, ylim=0:1) + # grid_col_all = c(grid_col_receptor, grid_col_ligand) + legend = ComplexHeatmap::Legend(at = prioritized_tbl_oi$receiver %>% unique() %>% sort(), + type = "grid", + legend_gp = grid::gpar(fill = grid_col_receptor[prioritized_tbl_oi$receiver %>% unique() %>% sort()]), + title_position = "topleft", + title = "Receiver") + ComplexHeatmap::draw(legend, just = c("left", "bottom")) + + legend = ComplexHeatmap::Legend(at = prioritized_tbl_oi$sender %>% unique() %>% sort(), + type = "grid", + legend_gp = grid::gpar(fill = grid_col_ligand[prioritized_tbl_oi$sender %>% unique() %>% sort()]), + title_position = "topleft", + title = "Sender") + ComplexHeatmap::draw(legend, just = c("left", "top")) + + p_legend = recordPlot() + + all_plots$legend = p_legend + + return(all_plots) +} + +#' @title make_nebulosa +#' +#' @description \code{make_nebulosa} XXXX +#' @usage make_nebulosa(seurat_subset_oi, seurat_subset_bg, title_umap, gene_oi, group_oi, background_groups) +#' +#' @param seurat_subset_oi XXX +#' @param seurat_subset_bg XXX +#' @param title_umap XXX +#' @param gene_oi XXX +#' @param group_oi XXX +#' @param background_groups XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_nebulosa = function(seurat_subset_oi, seurat_subset_bg, title_umap, gene_oi, group_oi, background_groups){ + + warning("Do not overinterpret a Nebulosa plot. For checking Smart-seq2 data, we recommend checking the normal Feature plot.") + + p_dim = DimPlot(seurat_subset_oi, label = T, repel = TRUE) + ggtitle(title_umap) + theme(title = element_text(face = "bold")) + + p_oi = plot_density(seurat_subset_oi, gene_oi) + max_density_oi = p_oi$data$feature %>% max() + + p_bg = plot_density(seurat_subset_bg, gene_oi) + max_density_bg = p_bg$data$feature %>% max() + + limit = max(max_density_oi, max_density_bg) + 0.0025 + + custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "RdYlBu") %>% rev(),values = c(0, 0.25, 0.35, 0.50, 0.60, 0.75, 1), limits = c(-0.001, limit)) + + p_oi = p_oi + custom_scale_fill + p_bg = p_bg + custom_scale_fill + + p_oi = p_oi + ggtitle(paste(gene_oi, group_oi, sep = " in ")) + theme(title = element_text(face = "bold")) + p_bg = p_bg + ggtitle(paste(gene_oi, background_groups %>% paste0(collapse = " & "), sep = " in ")) + theme(title = element_text(face = "bold")) + + wrapped_plots = wrap_plots(p_dim, + p_oi, + p_bg, + ncol = 3,guides = "collect") + +} + +#' @title make_featureplot +#' +#' @description \code{make_featureplot} XXXX +#' @usage make_featureplot(seurat_subset_oi, title_umap, gene_oi, group_oi, background_groups, group_id) +#' +#' @param seurat_subset_oi XXX +#' @param title_umap XXX +#' @param gene_oi XXX +#' @param group_oi XXX +#' @param background_groups XXX +#' @param group_id +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_featureplot = function(seurat_subset_oi, title_umap, gene_oi, group_oi, background_groups, group_id){ + p_dim = DimPlot(seurat_subset_oi, label = T, repel = TRUE) + ggtitle(title_umap) + theme(title = element_text(face = "bold")) + + + wrapped_plots = wrap_plots(p_dim, + FeaturePlot(seurat_subset_oi, gene_oi,split.by = eval(group_id)), + nrow = 1, + guides = "collect", + widths = c(1,3)) + + +} + +#' @title make_ligand_receptor_nebulosa_feature_plot +#' +#' @description \code{make_ligand_receptor_nebulosa_feature_plot} XXXX +#' @usage make_ligand_receptor_nebulosa_feature_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi) +#' +#' @param seurat_obj_sender XXX +#' @param seurat_obj_receiver XXX +#' @param ligand_oi XXX +#' @param receptor_oi XXX +#' @param group_oi XXX +#' @param group_id XXX +#' @param celltype_id_sender XXX +#' @param celltype_id_receiver XXX +#' @param senders_oi XXX +#' @param receivers_oi XXX +#' @param prioritized_tbl_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_ligand_receptor_nebulosa_feature_plot = function(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi){ + # senders_prioritized = prioritized_tbl_oi %>% dplyr::filter(ligand == ligand_oi & group == group_oi) %>% pull(sender) %>% unique() + # receptors_prioritized = prioritized_tbl_oi %>% dplyr::filter(receptor == receptor_oi & group == group_oi) %>% pull(receiver) %>% unique() + + background_groups = prioritized_tbl_oi$group %>% unique() %>% generics::setdiff(group_oi) + + # subset Sender - Nebulosa + seurat_subset_oi = seurat_obj_sender[, seurat_obj_sender@meta.data[[group_id]] %in% group_oi] + seurat_subset_bg = seurat_obj_sender[, seurat_obj_sender@meta.data[[group_id]] %in% background_groups] + + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_sender]] %in% senders_oi] + seurat_subset_bg = seurat_subset_bg[, seurat_subset_bg@meta.data[[celltype_id_sender]] %in% senders_oi] + + sender_plots = make_nebulosa(seurat_subset_oi, seurat_subset_bg, "Sender UMAP", ligand_oi, group_oi, background_groups) + + # subset Sender - Feature + seurat_subset_oi = seurat_obj_sender[, seurat_obj_sender@meta.data[[group_id]] %in% c(group_oi,background_groups)] + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_sender]] %in% senders_oi] + + sender_plots_feature = make_featureplot(seurat_subset_oi, "Sender UMAP", ligand_oi, group_oi, background_groups, group_id) + + # subset Receiver - Nebulosa + seurat_subset_oi = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% group_oi] + seurat_subset_bg = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% background_groups] + + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_receiver]] %in% receivers_oi] + seurat_subset_bg = seurat_subset_bg[, seurat_subset_bg@meta.data[[celltype_id_receiver]] %in% receivers_oi] + + receiver_plots = make_nebulosa(seurat_subset_oi, seurat_subset_bg, "Receiver UMAP", receptor_oi, group_oi, background_groups) + + # subset Receiver - Feature + seurat_subset_oi = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% c(group_oi,background_groups)] + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_receiver]] %in% receivers_oi] + + receiver_plots_feature = make_featureplot(seurat_subset_oi, "Receiver UMAP", receptor_oi, group_oi, background_groups, group_id) + + p = wrap_plots(sender_plots, receiver_plots, nrow = 2) + p_feature = wrap_plots(sender_plots_feature, receiver_plots_feature, nrow = 2) + + return(list( + nebulosa = p, + feature = p_feature + )) +} + +#' @title make_ligand_receptor_violin_plot +#' +#' @description \code{make_ligand_receptor_violin_plot} XXXX +#' @usage make_ligand_receptor_violin_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi) +#' +#' @param seurat_obj_sender XXX +#' @param seurat_obj_receiver XXX +#' @param ligand_oi XXX +#' @param receptor_oi XXX +#' @param group_oi XXX +#' @param group_id XXX +#' @param sample_id XXX +#' @param celltype_id_sender XXX +#' @param celltype_id_receiver XXX +#' @param sender_oi XXX +#' @param receiver_oi XXX +#' @param prioritized_tbl_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_ligand_receptor_violin_plot = function(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi){ + + background_groups = prioritized_tbl_oi$group %>% unique() %>% generics::setdiff(group_oi) + + seurat_subset = seurat_obj_sender[, seurat_obj_sender@meta.data[[celltype_id_sender]] %in% sender_oi] + seurat_subset = seurat_subset[, seurat_subset@meta.data[[group_id]] %in% c(group_oi,background_groups)] + + violin_group_sender = VlnPlot(seurat_subset, ligand_oi, group.by = eval(group_id),sort = FALSE) + scale_fill_brewer(palette = "Set2") + ggtitle(paste("Expression of the ligand ",ligand_oi, " in sender cell type ", sender_oi, sep = "")) + p = VlnPlot(seurat_subset, ligand_oi,group.by = eval(sample_id),sort = FALSE,split.by = eval(group_id)) + p = p + facet_grid(.~ split, scales = "free", space = "free") + + scale_x_discrete(position = "bottom") + + theme_light() + + theme( + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + title = element_text(face = "bold", size = 12), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + scale_fill_brewer(palette = "Set2") + p_sender = p + ggtitle(paste("Expression of the ligand ",ligand_oi, " in sender cell type ", sender_oi, sep = "")) + + seurat_subset = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[celltype_id_receiver]] %in% receiver_oi] + seurat_subset = seurat_subset[, seurat_subset@meta.data[[group_id]] %in% c(group_oi,background_groups)] + + violin_group_receiver = VlnPlot(seurat_subset, receptor_oi,group.by = eval(group_id),sort = FALSE) + scale_fill_brewer(palette = "Set2") + ggtitle(paste("Expression of the receptor ",receptor_oi, " in receiver cell type ", receiver_oi, sep = "")) + p = VlnPlot(seurat_subset, receptor_oi,group.by = eval(sample_id),sort = FALSE,split.by = eval(group_id)) + p = p + facet_grid(.~ split, scales = "free", space = "free") + + scale_x_discrete(position = "bottom") + + theme_light() + + theme( + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + title = element_text(face = "bold", size = 12), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + scale_fill_brewer(palette = "Set2") + p_receiver = p + ggtitle(paste("Expression of the receptor ",receptor_oi, " in receiver cell type ", receiver_oi, sep = "")) + + return(list( + violin_group = wrap_plots(violin_group_sender, violin_group_receiver, nrow = 2), + violin_sample = wrap_plots(p_sender, p_receiver, nrow = 2) + )) + +} + +#' @title make_target_violin_plot +#' +#' @description \code{make_target_violin_plot} XXXX +#' @usage make_target_violin_plot(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, prioritized_tbl_oi) +#' +#' @param seurat_obj_receiver XXX +#' @param target_oi XXX +#' @param group_oi XXX +#' @param group_id XXX +#' @param sample_id XXX +#' @param celltype_id_receiver XXX +#' @param receiver_oi XXX +#' @param prioritized_tbl_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_target_violin_plot = function(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, prioritized_tbl_oi){ + + background_groups = prioritized_tbl_oi$group %>% unique() %>% generics::setdiff(group_oi) + + seurat_subset = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[celltype_id_receiver]] %in% receiver_oi] + seurat_subset = seurat_subset[, seurat_subset@meta.data[[group_id]] %in% c(group_oi,background_groups)] + + violin_group_receiver = VlnPlot(seurat_subset, target_oi,group.by = eval(group_id),sort = FALSE) + scale_fill_brewer(palette = "Set2") + ggtitle(paste("Expression of the target ",target_oi, " in receiver cell type ", receiver_oi, sep = "")) + p = VlnPlot(seurat_subset, target_oi,group.by = eval(sample_id),sort = FALSE,split.by = eval(group_id)) + p = p + facet_grid(.~ split, scales = "free", space = "free") + + scale_x_discrete(position = "bottom") + + theme_light() + + theme( + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + title = element_text(face = "bold", size = 12), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + scale_fill_brewer(palette = "Set2") + p_receiver = p + ggtitle(paste("Expression of the target ",target_oi, " in receiver cell type ", receiver_oi, sep = "")) + + return(list( + violin_group = violin_group_receiver, + violin_sample = p_receiver + )) + +} + +#' @title make_target_nebulosa_feature_plot +#' +#' @description \code{make_target_nebulosa_feature_plot} XXXX +#' @usage make_target_nebulosa_feature_plot(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, prioritized_tbl_oi) +#' +#' @param seurat_obj_receiver XXX +#' @param target_oi XXX +#' @param group_oi XXX +#' @param group_id XXX +#' @param celltype_id_receiver XXX +#' @param receivers_oi XXX +#' @param prioritized_tbl_oi XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_target_nebulosa_feature_plot = function(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, prioritized_tbl_oi){ + # senders_prioritized = prioritized_tbl_oi %>% dplyr::filter(ligand == ligand_oi & group == group_oi) %>% pull(sender) %>% unique() + # receptors_prioritized = prioritized_tbl_oi %>% dplyr::filter(receptor == receptor_oi & group == group_oi) %>% pull(receiver) %>% unique() + + background_groups = prioritized_tbl_oi$group %>% unique() %>% generics::setdiff(group_oi) + + # subset Receiver - Nebulosa + seurat_subset_oi = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% group_oi] + seurat_subset_bg = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% background_groups] + + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_receiver]] %in% receivers_oi] + seurat_subset_bg = seurat_subset_bg[, seurat_subset_bg@meta.data[[celltype_id_receiver]] %in% receivers_oi] + + receiver_plots = make_nebulosa(seurat_subset_oi, seurat_subset_bg, "Receiver UMAP", target_oi, group_oi, background_groups) + + # subset Receiver - Feature + seurat_subset_oi = seurat_obj_receiver[, seurat_obj_receiver@meta.data[[group_id]] %in% c(group_oi,background_groups)] + seurat_subset_oi = seurat_subset_oi[, seurat_subset_oi@meta.data[[celltype_id_receiver]] %in% receivers_oi] + + receiver_plots_feature = make_featureplot(seurat_subset_oi, "Receiver UMAP", target_oi, group_oi, background_groups, group_id) + + p =receiver_plots + p_feature = receiver_plots_feature + + return(list( + nebulosa = p, + feature = p_feature + )) +} + +#' @title make_ligand_activity_target_plot +#' +#' @description \code{make_ligand_activity_target_plot} XXXX +#' @usage make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, ligand_activities_targets_DEgenes, contrast_tbl, grouping_tbl, receiver_info, plot_legend = TRUE, heights = NULL, widths = NULL) +#' +#' @param group_oi XXX +#' @param receiver_oi XXX +#' @param prioritized_tbl_oi XXX +#' @param ligand_activities_targets_DEgenes XXX +#' @param contrast_tbl XXX +#' @param grouping_tbl XXX +#' @param receiver_info XXX +#' @param plot_legend XXX +#' @param heights XXX +#' @param widths XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +make_ligand_activity_target_plot = function(group_oi, receiver_oi, prioritized_tbl_oi, ligand_activities_targets_DEgenes, contrast_tbl, grouping_tbl, receiver_info, plot_legend = TRUE, heights = NULL, widths = NULL){ + + best_upstream_ligands = prioritized_tbl_oi$ligand %>% unique() + + # Ligand-Target heatmap + active_ligand_target_links_df = ligand_activities_targets_DEgenes$ligand_activities %>% ungroup() %>% dplyr::inner_join(contrast_tbl) %>% dplyr::filter(ligand %in% best_upstream_ligands & receiver == receiver_oi & group == group_oi) %>% ungroup() %>% dplyr::select(ligand, target, ligand_target_weight ) %>% dplyr::rename(weight = ligand_target_weight ) + + active_ligand_target_links_df = active_ligand_target_links_df %>% dplyr::filter(!is.na(weight)) + if(active_ligand_target_links_df$target %>% unique() %>% length() <= 2){ + cutoff = 0 + } else { + cutoff = 0.2 + } + + active_ligand_target_links = nichenetr::prepare_ligand_target_visualization(ligand_target_df = active_ligand_target_links_df, ligand_target_matrix = ligand_target_matrix, cutoff = cutoff) + + order_ligands_ = generics::intersect(best_upstream_ligands, colnames(active_ligand_target_links)) %>% rev() + order_targets_ = active_ligand_target_links_df$target %>% unique() %>% generics::intersect(rownames(active_ligand_target_links)) + + order_ligands = order_ligands_ %>% make.names() + order_targets = order_targets_ %>% make.names() + + rownames(active_ligand_target_links) = rownames(active_ligand_target_links) %>% make.names() # make.names() for heatmap visualization of genes like H2-T23 + colnames(active_ligand_target_links) = colnames(active_ligand_target_links) %>% make.names() # make.names() for heatmap visualization of genes like H2-T23 + + if(!is.matrix(active_ligand_target_links[order_targets,order_ligands]) ){ + vis_ligand_target = active_ligand_target_links[order_targets,order_ligands] %>% matrix(ncol = 1) + rownames(vis_ligand_target) = order_ligands + colnames(vis_ligand_target) = order_targets + } else { + vis_ligand_target = active_ligand_target_links[order_targets,order_ligands] %>% t() + } + + p_ligand_target_network = vis_ligand_target %>% nichenetr::make_heatmap_ggplot("Prioritized ligands","Predicted target genes", color = "purple",legend_position = "top", x_axis_position = "top",legend_title = "Regulatory\nPotential") + theme(axis.text.x = element_text(face = "italic")) + scale_fill_gradient2(low = "whitesmoke", high = "purple", breaks = c(0,0.0045,0.0090)) + + # Ligand-Activity-Scaled + ligand_pearson_df = ligand_activities_targets_DEgenes$ligand_activities %>% ungroup() %>% dplyr::filter(ligand %in% best_upstream_ligands & receiver == receiver_oi) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::select(ligand, group, activity_scaled) %>% dplyr::distinct() %>% tidyr::spread(group, activity_scaled) + ligand_pearson_matrix = ligand_pearson_df %>% dplyr::select(-ligand) %>% as.matrix() %>% magrittr::set_rownames(ligand_pearson_df$ligand) + rownames(ligand_pearson_matrix) = rownames(ligand_pearson_matrix) %>% make.names() + colnames(ligand_pearson_matrix) = colnames(ligand_pearson_matrix) %>% make.names() + vis_ligand_pearson = ligand_pearson_matrix[order_ligands %>% generics::intersect(rownames(ligand_pearson_matrix)), ] #%>% as.matrix(ncol = 3) %>% magrittr::set_colnames("Pearson") + p_ligand_pearson = vis_ligand_pearson %>% nichenetr::make_heatmap_ggplot("Prioritized ligands","Scaled Ligand activity", color = "purple",legend_position = "top", x_axis_position = "top", legend_title = "Scaled\nLigand\nActivity") + theme(legend.text = element_text(size = 9)) + custom_scale_fill = scale_fill_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "PuRd"),values = c(0, 0.35, 0.425, 0.525, 0.625, 0.75, 1), limits = c(min(vis_ligand_pearson, na.rm =TRUE), max(vis_ligand_pearson, na.rm =TRUE))) + p_ligand_pearson_scaled = p_ligand_pearson + custom_scale_fill + + # Ligand-Activity + ligand_pearson_df = ligand_activities_targets_DEgenes$ligand_activities %>% ungroup() %>% dplyr::filter(ligand %in% best_upstream_ligands & receiver == receiver_oi) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::select(ligand, group, activity) %>% dplyr::distinct() %>% tidyr::spread(group, activity) + ligand_pearson_matrix = ligand_pearson_df %>% dplyr::select(-ligand) %>% as.matrix() %>% magrittr::set_rownames(ligand_pearson_df$ligand) + rownames(ligand_pearson_matrix) = rownames(ligand_pearson_matrix) %>% make.names() + colnames(ligand_pearson_matrix) = colnames(ligand_pearson_matrix) %>% make.names() + vis_ligand_pearson = ligand_pearson_matrix[order_ligands %>% generics::intersect(rownames(ligand_pearson_matrix)), ] #%>% as.matrix(ncol = 3) %>% magrittr::set_colnames("Pearson") + p_ligand_pearson = vis_ligand_pearson %>% nichenetr::make_heatmap_ggplot("Prioritized ligands","Ligand activity", color = "darkorange",legend_position = "top", x_axis_position = "top", legend_title = "Ligand\nActivity") + theme(legend.text = element_text(size = 9)) + custom_scale_fill = scale_fill_gradientn(colours = RColorBrewer::brewer.pal(n = 7, name = "Oranges"),values = c(0, 0.250, 0.5550, 0.675, 0.80, 0.925, 1), limits = c(min(vis_ligand_pearson, na.rm =TRUE), max(vis_ligand_pearson, na.rm =TRUE))) + p_ligand_pearson = p_ligand_pearson + custom_scale_fill + + # Target expression + groups_oi = contrast_tbl %>% pull(group) %>% unique() + p_targets = make_sample_target_plots_reversed(receiver_info, order_targets_, receiver_oi, grouping_tbl %>% dplyr::filter(group %in% groups_oi)) + + # Combine the plots + n_groups = ncol(vis_ligand_pearson) + n_targets = ncol(vis_ligand_target) + n_ligands = nrow(vis_ligand_target) + n_samples = grouping_tbl %>% dplyr::filter(group %in% groups_oi) %>% pull(sample) %>% length() + + legends = patchwork::wrap_plots(ggpubr::as_ggplot(ggpubr::get_legend(p_ligand_pearson)),ggpubr::as_ggplot(ggpubr::get_legend(p_ligand_pearson_scaled)),ggpubr::as_ggplot(ggpubr::get_legend(p_ligand_target_network)), nrow = 2) %>% + patchwork::wrap_plots(ggpubr::as_ggplot(ggpubr::get_legend(p_targets))) + + if(is.null(heights)){ + heights = c(n_ligands + 3, n_samples) + } + if(is.null(widths)){ + widths = c(n_groups + 1.33, n_groups, n_targets) + } + + if(plot_legend == FALSE){ + design <- "AaB + ##C" + combined_plot = patchwork::wrap_plots(A = p_ligand_pearson_scaled + theme(legend.position = "none", axis.ticks = element_blank()) + theme(axis.title.x = element_text()), + a = p_ligand_pearson + theme(legend.position = "none", axis.ticks = element_blank()) + ylab(""), + B = p_ligand_target_network + theme(legend.position = "none", axis.ticks = element_blank()) + ylab(""), + C = p_targets + theme(legend.position = "none"), + nrow = 2, design = design, widths = widths, heights = heights) + return(list(combined_plot = combined_plot, legends = legends)) + + } else { + design <- "AaB + L#C" + + combined_plot = patchwork::wrap_plots(A = p_ligand_pearson_scaled + theme(legend.position = "none", axis.ticks = element_blank()) + theme(axis.title.x = element_text()), + a = p_ligand_pearson + theme(legend.position = "none", axis.ticks = element_blank()) + ylab(""), + B = p_ligand_target_network + theme(legend.position = "none", axis.ticks = element_blank()) + ylab(""), + C = p_targets + theme(legend.position = "none"), + L = legends, nrow = 2, design = design, widths = widths, heights = heights) + return(list(combined_plot = combined_plot, legends = legends)) + } + +} diff --git a/R/prioritization.R b/R/prioritization.R new file mode 100644 index 0000000..191464d --- /dev/null +++ b/R/prioritization.R @@ -0,0 +1,118 @@ +scale_quantile_adapted = function(x){ + y = nichenetr::scale_quantile(x,outlier_cutoff = 0) + y = y + 0.001 + return(y) +} +#' @title generate_prioritization_tables +#' +#' @description \code{generate_prioritization_tables} XXXX +#' @usage generate_prioritization_tables(sender_receiver_info, sender_receiver_de, ligand_activities_targets_DEgenes, contrast_tbl, sender_receiver_tbl, grouping_tbl, prioritizing_weights, fraction_cutoff) +#' +#' @inheritParams ms_mg_nichenet_analysis_combined +#' @inheritParams combine_sender_receiver_info_ic +#' @param sender_receiver_info XXX +#' @param sender_receiver_de XXX +#' @param ligand_activities_targets_DEgenes XXX +#' @param sender_receiver_tbl XXX +#' @param grouping_tbl XXX +#' +#' @return XXXX +#' +#' @import Seurat +#' @import dplyr +#' @import muscat +#' @importFrom purrr map +#' +#' @examples +#' \dontrun{ +#' print("XXXX") +#' } +#' +#' @export +#' +generate_prioritization_tables = function(sender_receiver_info, sender_receiver_de, ligand_activities_targets_DEgenes, contrast_tbl, sender_receiver_tbl, grouping_tbl, prioritizing_weights, fraction_cutoff){ + + # Group prioritization table ------------------------------------------------------------------------------------------------------------------------------------------- + + # receiver-focused prioritization for receptor: contrast - receiver - receptor - lfc_receptor - p_adj_receptor: group by contrast and receiver: score each receptor based on those rankings + receiver_receptor_prioritization = sender_receiver_de %>% dplyr::ungroup() %>% dplyr::select(contrast, receiver, receptor, lfc_receptor, p_val_receptor) %>% dplyr::distinct() %>% dplyr::mutate(scaled_lfc_receptor = scale_quantile_adapted(lfc_receptor), scaled_p_val_receptor = scale_quantile_adapted(-p_val_receptor)) %>% dplyr::arrange(p_val_receptor ) + + # receiver-focused prioritization for ligand: contrast - receiver - ligand - activity_scaled: group by contrast and receiver: score each ligand based on the activity + # receiver_ligand_activity_prioritization = ligand_activities_targets_DEgenes$ligand_activities %>% dplyr::ungroup() %>% dplyr::select(contrast, receiver, ligand, activity_scaled) %>% dplyr::distinct() %>% dplyr::mutate(scaled_activity_scaled = scale_quantile_adapted(activity_scaled)) %>% dplyr::arrange(-activity_scaled ) + receiver_ligand_activity_prioritization = ligand_activities_targets_DEgenes$ligand_activities %>% dplyr::ungroup() %>% dplyr::select(contrast, receiver, ligand, activity, activity_scaled) %>% dplyr::distinct() %>% dplyr::mutate(scaled_activity_scaled = scale_quantile_adapted(activity_scaled), scaled_activity = scale_quantile_adapted(activity)) %>% dplyr::arrange(-activity_scaled ) + + # sender-focused prioritization: contrast - sender - ligand - lfc_ligand - p_adj_ligand: group by contrast and sender: score each ligand based on those rankings + sender_ligand_prioritization = sender_receiver_de %>% dplyr::ungroup() %>% dplyr::select(contrast, sender, ligand, lfc_ligand, p_val_ligand) %>% dplyr::distinct() %>% dplyr::mutate(scaled_lfc_ligand = scale_quantile_adapted(lfc_ligand), scaled_p_val_ligand = scale_quantile_adapted(-p_val_ligand)) %>% dplyr::arrange(p_val_ligand) + + # cell-type and condition specificity of expression of ligand: per ligand: score each sender-condition combination based on expression and fraction + ligand_celltype_specificity_prioritization = sender_receiver_info$avg_df_group %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, sender, ligand, avg_ligand_group ) %>% dplyr::distinct() %>% dplyr::group_by(ligand) %>% dplyr::mutate(scaled_avg_exprs_ligand = scale_quantile_adapted(avg_ligand_group)) %>% dplyr::arrange(-scaled_avg_exprs_ligand) + ligand_celltype_specificity_prioritization_frq = sender_receiver_info$frq_df_group %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, sender, ligand, fraction_ligand_group ) %>% dplyr::distinct() %>% dplyr::group_by(ligand) %>% dplyr::mutate(scaled_avg_frq_ligand = scale_quantile_adapted(fraction_ligand_group)) %>% dplyr::arrange(-scaled_avg_frq_ligand) + + # cell-type and condition specificity of expression of receptor: per receptor: score each receiver-condition combination based on expression and fraction + receptor_celltype_specificity_prioritization = sender_receiver_info$avg_df_group %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, receiver, receptor, avg_receptor_group ) %>% dplyr::distinct() %>% dplyr::group_by(receptor) %>% dplyr::mutate(scaled_avg_exprs_receptor = scale_quantile_adapted(avg_receptor_group)) %>% dplyr::arrange(-scaled_avg_exprs_receptor) + receptor_celltype_specificity_prioritization_frq = sender_receiver_info$frq_df_group %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, receiver, receptor, fraction_receptor_group ) %>% dplyr::distinct() %>% dplyr::group_by(receptor) %>% dplyr::mutate(scaled_avg_frq_receptor = scale_quantile_adapted(fraction_receptor_group)) %>% dplyr::arrange(-scaled_avg_frq_receptor) + + # both receptor and ligand should be expresse! + ligand_receptor_expressed_prioritization = sender_receiver_info$frq_df %>% dplyr::inner_join(grouping_tbl) %>% dplyr::ungroup() %>% dplyr::select(sample, group, sender, receiver, ligand, receptor, fraction_ligand, fraction_receptor ) %>% dplyr::distinct() %>% + dplyr::group_by(ligand, receptor, sender, receiver, group) %>% + dplyr::summarise(n_samples = n(), n_expressing = sum(fraction_ligand > fraction_cutoff & fraction_receptor > fraction_cutoff)) %>% + dplyr::mutate(fraction_expressing_ligand_receptor = n_expressing/n_samples) %>% dplyr::arrange(-fraction_expressing_ligand_receptor) %>% dplyr::select(-n_samples, -n_expressing) %>% dplyr::ungroup() + + # sender-focused prioritization of cell abundance: contrast - sender - rel abundance + sender_abundance_prioritization = sender_receiver_info$rel_abundance_df %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, sender, rel_abundance_scaled_sender) %>% dplyr::distinct() %>% dplyr::arrange(-rel_abundance_scaled_sender ) + + # receiver-focused prioritization of cell abundance: contrast - receiver - rel abundance + receiver_abundance_prioritization = sender_receiver_info$rel_abundance_df %>% dplyr::inner_join(sender_receiver_tbl) %>% dplyr::inner_join(contrast_tbl) %>% dplyr::ungroup() %>% dplyr::select(group, receiver, rel_abundance_scaled_receiver) %>% dplyr::distinct() %>% dplyr::arrange(-rel_abundance_scaled_receiver ) + + + # final group-based prioritization + group_prioritization_tbl = contrast_tbl %>% + dplyr::inner_join(sender_receiver_de) %>% + dplyr::inner_join(ligand_activities_targets_DEgenes$ligand_activities %>% dplyr::select(-target, -ligand_target_weight) %>% dplyr::distinct()) %>% + dplyr::mutate(lr_interaction = paste(ligand, receptor, sep = "_")) %>% dplyr::mutate(id = paste(lr_interaction, sender, receiver, sep = "_")) %>% + dplyr::inner_join(sender_receiver_info$avg_df_group) %>% + dplyr::inner_join(sender_receiver_info$frq_df_group) %>% + dplyr::inner_join(sender_receiver_info$rel_abundance_df) %>% + dplyr::inner_join(sender_ligand_prioritization) %>% + dplyr::inner_join(receiver_receptor_prioritization) %>% + dplyr::inner_join(receiver_ligand_activity_prioritization) %>% + dplyr::inner_join(ligand_celltype_specificity_prioritization) %>% + dplyr::inner_join(ligand_celltype_specificity_prioritization_frq) %>% + dplyr::inner_join(receptor_celltype_specificity_prioritization) %>% + dplyr::inner_join(receptor_celltype_specificity_prioritization_frq) %>% + dplyr::inner_join(ligand_receptor_expressed_prioritization) %>% + dplyr::inner_join(sender_abundance_prioritization) %>% + dplyr::inner_join(receiver_abundance_prioritization) + + # have a weighted average the final score (no product!!) + group_prioritization_tbl = group_prioritization_tbl %>% + dplyr::mutate(prioritization_score = + ((prioritizing_weights["scaled_lfc_ligand"] * scaled_lfc_ligand) + + (prioritizing_weights["scaled_p_val_ligand"] * scaled_p_val_ligand) + + (prioritizing_weights["scaled_lfc_receptor"] * scaled_lfc_receptor) + + (prioritizing_weights["scaled_p_val_receptor"] * scaled_p_val_receptor) + + (prioritizing_weights["scaled_activity_scaled"] * scaled_activity_scaled) + + (prioritizing_weights["scaled_activity"] * scaled_activity) + + (prioritizing_weights["scaled_avg_exprs_ligand"] * scaled_avg_exprs_ligand) + + (prioritizing_weights["scaled_avg_frq_ligand"] * scaled_avg_frq_ligand) + + (prioritizing_weights["scaled_avg_exprs_receptor"] * scaled_avg_exprs_receptor) + + (prioritizing_weights["scaled_avg_frq_receptor"] * scaled_avg_frq_receptor) + + (prioritizing_weights["fraction_expressing_ligand_receptor"] * fraction_expressing_ligand_receptor) + + (prioritizing_weights["scaled_abundance_sender"] * rel_abundance_scaled_sender) + + (prioritizing_weights["scaled_abundance_receiver"] * rel_abundance_scaled_receiver) + )* (1/length(prioritizing_weights))) %>% dplyr::arrange(-prioritization_score) + + + # Sample-based Prioritization ----------------------------------------------- ---------------------------------------------------------------- + # sample_prioritization_tbl = sender_receiver_info$avg_df %>% dplyr::inner_join(sender_receiver_info$frq_df) %>% dplyr::inner_join(grouping_tbl) %>% dplyr::inner_join(group_prioritization_tbl %>% dplyr::distinct(group, sender, receiver, ligand, receptor, prioritization_score)) + sample_prioritization_tbl = sender_receiver_info$avg_df %>% dplyr::inner_join(sender_receiver_info$frq_df) %>% dplyr::inner_join(grouping_tbl) %>% dplyr::left_join(group_prioritization_tbl %>% dplyr::distinct(group, sender, receiver, ligand, receptor, prioritization_score)) + + sample_prioritization_tbl = sample_prioritization_tbl %>% dplyr::mutate(lr_interaction = paste(ligand, receptor, sep = "_")) %>% dplyr::mutate(id = paste(lr_interaction, sender, receiver, sep = "_")) + sample_prioritization_tbl = sample_prioritization_tbl %>% dplyr::group_by(id) %>% dplyr::mutate(scaled_LR_prod = nichenetr::scaling_zscore(ligand_receptor_prod), scaled_LR_frac = nichenetr::scaling_zscore(ligand_receptor_fraction_prod)) %>% dplyr::ungroup() + + # ligand-target information ----------------------------------------------- + ligand_activities_target_de_tbl = ligand_activities_targets_DEgenes$ligand_activities %>% dplyr::inner_join(ligand_activities_targets_DEgenes$de_genes_df %>% dplyr::rename(target = gene, p_val_adj = p_adj.loc)) %>% dplyr::select(contrast, receiver, ligand, activity, activity_scaled, target, ligand_target_weight, logFC, p_val, p_val_adj) %>% dplyr::distinct() + + return(list(group_prioritization_tbl = group_prioritization_tbl, sample_prioritization_tbl = sample_prioritization_tbl, ligand_activities_target_de_tbl = ligand_activities_target_de_tbl)) + +} diff --git a/README.Rmd b/README.Rmd new file mode 100644 index 0000000..7206c15 --- /dev/null +++ b/README.Rmd @@ -0,0 +1,51 @@ +--- +output: + github_document: + html_preview: false +--- + + + + + +# multinichenetr + + +[![R build status](https://github.com/browaeysrobin/multinichenetr/workflows/R-CMD-check-bioc/badge.svg)](https://github.com/browaeysrobin/multinichenetr/actions) +[![Coverage Status](https://codecov.io/gh/browaeysrobin/multinichenetr/branch/master/graph/badge.svg?token=NKZBMJJDYA)](https://codecov.io/gh/browaeysrobin/multinichenetr) + + +**multinichenetr: the R package containing multiple functionalities to computationally study cell-cell communication from single-cell transcriptomics data with complex multi-sample, multi-group design.** The goal of this toolbox is to study differences in intercellular communication between groups of samples of interest (eg patients of different disease subtypes). + + +## Main functionalities of multinichenetr + +Specific functionalities of this package include: + +* Finding differential expressed and active ligand-receptor interactions from different sender-receiver pairs between different sample groups + +## Installation of multinichenetr + +Installation typically takes a few minutes, depending on the number of dependencies that has already been installed on your pc. + +You can install multinichenetr (and required dependencies) from github with: + +```{r gh-installation, eval = FALSE} +# install.packages("devtools") +devtools::install_github("saeyslab/nichenetr") +devtools::install_github("browaeysrobin/multinichenetr") +``` + +multinichenetr was tested on both Windows and Linux (most recently tested R version: R 4.0.3) + +## Learning to use multinichenetr + +In the following vignettes, you can find how to do a multi-sample, multi-group NicheNet analysis: + +* [Multi-Group Multi-Sample Cell-Cell Communication Analysis via NicheNet: HNSCC application](vignettes/basic_analysis.md): `vignette("basic_analysis", package="multinichenetr")` + +## References + +Browaeys, R., Saelens, W. & Saeys, Y. NicheNet: modeling intercellular communication by linking ligands to target genes. Nat Methods (2019) doi:10.1038/s41592-019-0667-5 diff --git a/README.md b/README.md index ce89f9b..0897f81 100644 --- a/README.md +++ b/README.md @@ -1 +1,59 @@ -# multinichenetr \ No newline at end of file + + + +# multinichenetr + + + +[![R build +status](https://github.com/browaeysrobin/multinichenetr/workflows/R-CMD-check-bioc/badge.svg)](https://github.com/browaeysrobin/multinichenetr/actions) +[![Coverage +Status](https://codecov.io/gh/browaeysrobin/multinichenetr/branch/master/graph/badge.svg?token=NKZBMJJDYA)](https://codecov.io/gh/browaeysrobin/multinichenetr) + + +**multinichenetr: the R package containing multiple functionalities to +computationally study cell-cell communication from single-cell +transcriptomics data with complex multi-sample, multi-group design.** +The goal of this toolbox is to study differences in intercellular +communication between groups of samples of interest (eg patients of +different disease subtypes). + +## Main functionalities of multinichenetr + +Specific functionalities of this package include: + +- Finding differential expressed and active ligand-receptor + interactions from different sender-receiver pairs between different + sample groups + +## Installation of multinichenetr + +Installation typically takes a few minutes, depending on the number of +dependencies that has already been installed on your pc. + +You can install multinichenetr (and required dependencies) from github +with: + + # install.packages("devtools") + devtools::install_github("saeyslab/nichenetr") + devtools::install_github("browaeysrobin/multinichenetr") + +multinichenetr was tested on both Windows and Linux (most recently +tested R version: R 4.0.3) + +## Learning to use multinichenetr + +In the following vignettes, you can find how to do a multi-sample, +multi-group NicheNet analysis: + +- [Multi-Group Multi-Sample Cell-Cell Communication Analysis via + NicheNet: HNSCC application](vignettes/basic_analysis.md): + `vignette("basic_analysis", package="multinichenetr")` + +## References + +Browaeys, R., Saelens, W. & Saeys, Y. NicheNet: modeling intercellular +communication by linking ligands to target genes. Nat Methods (2019) + diff --git a/data/seurat_obj.rda b/data/seurat_obj.rda new file mode 100644 index 0000000..d2fad1f Binary files /dev/null and b/data/seurat_obj.rda differ diff --git a/data/seurat_obj_scrnaseq.rda b/data/seurat_obj_scrnaseq.rda new file mode 100644 index 0000000..2718ad2 Binary files /dev/null and b/data/seurat_obj_scrnaseq.rda differ diff --git a/data/seurat_obj_visium.rda b/data/seurat_obj_visium.rda new file mode 100644 index 0000000..4e42f62 Binary files /dev/null and b/data/seurat_obj_visium.rda differ diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..f19b560 --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,15 @@ +citHeader("To cite nichenetr in publications use:") + +citEntry(entry = "Article", + title = "NicheNet: Modeling intercellular communication by linking ligands to target genes", + author = personList(as.person("Robin Browaeys"), + as.person("Wouter Saelens"), as.person("Yvan Saeys")), + journal = "Nature Methods", + year = "2019", + url = {"https://www.nature.com/articles/s41592-019-0667-5"}, + + textVersion = + paste("Robin Browaeys, Wouter Saelens, Yvan Saeys (2019)", + "NicheNet: Modeling intercellular communication by linking ligands to target genes", + "Nature Methods") +) diff --git a/man/combine_sender_receiver_de.Rd b/man/combine_sender_receiver_de.Rd new file mode 100644 index 0000000..94bb29d --- /dev/null +++ b/man/combine_sender_receiver_de.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{combine_sender_receiver_de} +\alias{combine_sender_receiver_de} +\title{combine_sender_receiver_de} +\usage{ +combine_sender_receiver_de(sender_de, receiver_de, senders_oi, receivers_oi, lr_network) +} +\arguments{ +\item{sender_de}{XXX} + +\item{receiver_de}{XXX} + +\item{senders_oi}{XXX} + +\item{receivers_oi}{XXX} + +\item{lr_network}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{combine_sender_receiver_de} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/combine_sender_receiver_info_ic.Rd b/man/combine_sender_receiver_info_ic.Rd new file mode 100644 index 0000000..38dbd99 --- /dev/null +++ b/man/combine_sender_receiver_info_ic.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{combine_sender_receiver_info_ic} +\alias{combine_sender_receiver_info_ic} +\title{combine_sender_receiver_info_ic} +\usage{ +combine_sender_receiver_info_ic(sender_info, receiver_info, senders_oi, receivers_oi, lr_network) +} +\arguments{ +\item{sender_info}{XXX} + +\item{receiver_info}{XXX} + +\item{senders_oi}{XXX} + +\item{receivers_oi}{XXX} + +\item{lr_network}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{combine_sender_receiver_info_ic} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/fix_frq_df.Rd b/man/fix_frq_df.Rd new file mode 100644 index 0000000..e44c86c --- /dev/null +++ b/man/fix_frq_df.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{fix_frq_df} +\alias{fix_frq_df} +\title{fix_frq_df} +\usage{ +fix_frq_df(seurat_obj, frq_celltype_samples) +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{frq_celltype_samples}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{fix_frq_df} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/generate_prioritization_tables.Rd b/man/generate_prioritization_tables.Rd new file mode 100644 index 0000000..fd56c2a --- /dev/null +++ b/man/generate_prioritization_tables.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/prioritization.R +\name{generate_prioritization_tables} +\alias{generate_prioritization_tables} +\title{generate_prioritization_tables} +\usage{ +generate_prioritization_tables(sender_receiver_info, sender_receiver_de, ligand_activities_targets_DEgenes, contrast_tbl, sender_receiver_tbl, grouping_tbl, prioritizing_weights, fraction_cutoff) +} +\arguments{ +\item{sender_receiver_info}{XXX} + +\item{sender_receiver_de}{XXX} + +\item{ligand_activities_targets_DEgenes}{XXX} + +\item{contrast_tbl}{XXXX} + +\item{sender_receiver_tbl}{XXX} + +\item{grouping_tbl}{XXX} + +\item{prioritizing_weights}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{generate_prioritization_tables} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/get_avg_frac_exprs_abund.Rd b/man/get_avg_frac_exprs_abund.Rd new file mode 100644 index 0000000..99ae3d2 --- /dev/null +++ b/man/get_avg_frac_exprs_abund.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{get_avg_frac_exprs_abund} +\alias{get_avg_frac_exprs_abund} +\title{get_avg_frac_exprs_abund} +\usage{ +get_avg_frac_exprs_abund(seurat_obj, sample_id, celltype_id, group_id, assay_oi = "RNA") +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{sample_id}{XXXX} + +\item{celltype_id}{XXXX} + +\item{group_id}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{get_avg_frac_exprs_abund} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/get_ligand_activities_targets_DEgenes.Rd b/man/get_ligand_activities_targets_DEgenes.Rd new file mode 100644 index 0000000..57864c6 --- /dev/null +++ b/man/get_ligand_activities_targets_DEgenes.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ligand_activities.R +\name{get_ligand_activities_targets_DEgenes} +\alias{get_ligand_activities_targets_DEgenes} +\title{get_ligand_activities_targets_DEgenes} +\usage{ +get_ligand_activities_targets_DEgenes(receiver_de, receivers_oi, receiver_frq_df_group, ligand_target_matrix, logFC_threshold = 0.25, p_val_threshold = 0.05, frac_cutoff = 0.05, p_val_adj = FALSE, top_n_target = 250) +} +\arguments{ +\item{receiver_de}{XXX} + +\item{receivers_oi}{XXX} + +\item{receiver_frq_df_group}{XXX} + +\item{ligand_target_matrix}{XXXX} + +\item{logFC_threshold}{XXXX} + +\item{p_val_threshold}{XXXX} + +\item{frac_cutoff}{XXXX} + +\item{p_val_adj}{XXXX} + +\item{top_n_target}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{get_ligand_activities_targets_DEgenes} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/get_muscat_exprs_avg.Rd b/man/get_muscat_exprs_avg.Rd new file mode 100644 index 0000000..0a13175 --- /dev/null +++ b/man/get_muscat_exprs_avg.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{get_muscat_exprs_avg} +\alias{get_muscat_exprs_avg} +\title{get_muscat_exprs_avg} +\usage{ +get_muscat_exprs_avg(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA") +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{sample_id}{XXXX} + +\item{celltype_id}{XXXX} + +\item{group_id}{XXXX} + +\item{assay_oi_sce}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{get_muscat_exprs_avg} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/get_muscat_exprs_frac.Rd b/man/get_muscat_exprs_frac.Rd new file mode 100644 index 0000000..4266861 --- /dev/null +++ b/man/get_muscat_exprs_frac.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{get_muscat_exprs_frac} +\alias{get_muscat_exprs_frac} +\title{get_muscat_exprs_frac} +\usage{ +get_muscat_exprs_frac(seurat_obj, sample_id, celltype_id, group_id, assay_oi_sce = "RNA") +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{sample_id}{XXXX} + +\item{celltype_id}{XXXX} + +\item{group_id}{XXXX} + +\item{assay_oi_sce}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{get_muscat_exprs_frac} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/hello.Rd b/man/hello.Rd new file mode 100644 index 0000000..0fa7c4b --- /dev/null +++ b/man/hello.Rd @@ -0,0 +1,12 @@ +\name{hello} +\alias{hello} +\title{Hello, World!} +\usage{ +hello() +} +\description{ +Prints 'Hello, world!'. +} +\examples{ +hello() +} diff --git a/man/make_circos_group_comparison.Rd b/man/make_circos_group_comparison.Rd new file mode 100644 index 0000000..d839e3a --- /dev/null +++ b/man/make_circos_group_comparison.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_circos_group_comparison} +\alias{make_circos_group_comparison} +\title{make_circos_group_comparison} +\usage{ +make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) +} +\arguments{ +\item{prioritized_tbl_oi}{XXX} + +\item{colors_sender}{XXX} + +\item{colors_receiver}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_circos_group_comparison} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_featureplot.Rd b/man/make_featureplot.Rd new file mode 100644 index 0000000..b46e645 --- /dev/null +++ b/man/make_featureplot.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_featureplot} +\alias{make_featureplot} +\title{make_featureplot} +\usage{ +make_featureplot(seurat_subset_oi, title_umap, gene_oi, group_oi, background_groups, group_id) +} +\arguments{ +\item{seurat_subset_oi}{XXX} + +\item{title_umap}{XXX} + +\item{gene_oi}{XXX} + +\item{group_oi}{XXX} + +\item{background_groups}{XXX} + +\item{group_id}{} +} +\value{ +XXXX +} +\description{ +\code{make_featureplot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_group_lfc_exprs_activity_plot.Rd b/man/make_group_lfc_exprs_activity_plot.Rd new file mode 100644 index 0000000..dea1e4e --- /dev/null +++ b/man/make_group_lfc_exprs_activity_plot.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_group_lfc_exprs_activity_plot} +\alias{make_group_lfc_exprs_activity_plot} +\title{make_group_lfc_exprs_activity_plot} +\usage{ +make_group_lfc_exprs_activity_plot(prioritization_tables, prioritized_tbl_oi, receiver_oi, heights = NULL) +} +\arguments{ +\item{prioritization_tables}{XXX} + +\item{prioritized_tbl_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{heights}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_group_lfc_exprs_activity_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_ligand_activity_plots.Rd b/man/make_ligand_activity_plots.Rd new file mode 100644 index 0000000..923240f --- /dev/null +++ b/man/make_ligand_activity_plots.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_ligand_activity_plots} +\alias{make_ligand_activity_plots} +\title{make_ligand_activity_plots} +\usage{ +make_ligand_activity_plots(prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +} +\arguments{ +\item{prioritization_tables}{XXX} + +\item{ligands_oi}{XXX} + +\item{contrast_tbl}{XXX} + +\item{widths}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_ligand_activity_plots} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_ligand_activity_target_plot.Rd b/man/make_ligand_activity_target_plot.Rd new file mode 100644 index 0000000..6fc47d2 --- /dev/null +++ b/man/make_ligand_activity_target_plot.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_ligand_activity_target_plot} +\alias{make_ligand_activity_target_plot} +\title{make_ligand_activity_target_plot} +\usage{ +make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, ligand_activities_targets_DEgenes, contrast_tbl, grouping_tbl, receiver_info, plot_legend = TRUE, heights = NULL, widths = NULL) +} +\arguments{ +\item{group_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{prioritized_tbl_oi}{XXX} + +\item{ligand_activities_targets_DEgenes}{XXX} + +\item{contrast_tbl}{XXX} + +\item{grouping_tbl}{XXX} + +\item{receiver_info}{XXX} + +\item{plot_legend}{XXX} + +\item{heights}{XXX} + +\item{widths}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_ligand_activity_target_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_ligand_receptor_nebulosa_feature_plot.Rd b/man/make_ligand_receptor_nebulosa_feature_plot.Rd new file mode 100644 index 0000000..81a118a --- /dev/null +++ b/man/make_ligand_receptor_nebulosa_feature_plot.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_ligand_receptor_nebulosa_feature_plot} +\alias{make_ligand_receptor_nebulosa_feature_plot} +\title{make_ligand_receptor_nebulosa_feature_plot} +\usage{ +make_ligand_receptor_nebulosa_feature_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi) +} +\arguments{ +\item{seurat_obj_sender}{XXX} + +\item{seurat_obj_receiver}{XXX} + +\item{ligand_oi}{XXX} + +\item{receptor_oi}{XXX} + +\item{group_oi}{XXX} + +\item{celltype_id_sender}{XXX} + +\item{celltype_id_receiver}{XXX} + +\item{senders_oi}{XXX} + +\item{receivers_oi}{XXX} + +\item{prioritized_tbl_oi}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_ligand_receptor_nebulosa_feature_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_ligand_receptor_violin_plot.Rd b/man/make_ligand_receptor_violin_plot.Rd new file mode 100644 index 0000000..f1753f4 --- /dev/null +++ b/man/make_ligand_receptor_violin_plot.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_ligand_receptor_violin_plot} +\alias{make_ligand_receptor_violin_plot} +\title{make_ligand_receptor_violin_plot} +\usage{ +make_ligand_receptor_violin_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi) +} +\arguments{ +\item{seurat_obj_sender}{XXX} + +\item{seurat_obj_receiver}{XXX} + +\item{ligand_oi}{XXX} + +\item{receptor_oi}{XXX} + +\item{sender_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{group_oi}{XXX} + +\item{group_id}{XXX} + +\item{sample_id}{XXX} + +\item{celltype_id_sender}{XXX} + +\item{celltype_id_receiver}{XXX} + +\item{prioritized_tbl_oi}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_ligand_receptor_violin_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_nebulosa.Rd b/man/make_nebulosa.Rd new file mode 100644 index 0000000..b8951ec --- /dev/null +++ b/man/make_nebulosa.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_nebulosa} +\alias{make_nebulosa} +\title{make_nebulosa} +\usage{ +make_nebulosa(seurat_subset_oi, seurat_subset_bg, title_umap, gene_oi, group_oi, background_groups) +} +\arguments{ +\item{seurat_subset_oi}{XXX} + +\item{seurat_subset_bg}{XXX} + +\item{title_umap}{XXX} + +\item{gene_oi}{XXX} + +\item{group_oi}{XXX} + +\item{background_groups}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_nebulosa} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_sample_lr_prod_activity_plots.Rd b/man/make_sample_lr_prod_activity_plots.Rd new file mode 100644 index 0000000..ef65c5f --- /dev/null +++ b/man/make_sample_lr_prod_activity_plots.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_sample_lr_prod_activity_plots} +\alias{make_sample_lr_prod_activity_plots} +\title{make_sample_lr_prod_activity_plots} +\usage{ +make_sample_lr_prod_activity_plots(prioritization_tables, prioritized_tbl_oi, widths = NULL) +} +\arguments{ +\item{prioritization_tables}{XXX} + +\item{prioritized_tbl_oi}{XXX} + +\item{widths}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_sample_lr_prod_activity_plots} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_sample_lr_prod_plots.Rd b/man/make_sample_lr_prod_plots.Rd new file mode 100644 index 0000000..4268a5c --- /dev/null +++ b/man/make_sample_lr_prod_plots.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_sample_lr_prod_plots} +\alias{make_sample_lr_prod_plots} +\title{make_sample_lr_prod_plots} +\usage{ +make_sample_lr_prod_plots(prioritization_tables, prioritized_tbl_oi) +} +\arguments{ +\item{prioritization_tables}{XXX} + +\item{prioritized_tbl_oi}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_sample_lr_prod_plots} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_sample_target_plots.Rd b/man/make_sample_target_plots.Rd new file mode 100644 index 0000000..49133a2 --- /dev/null +++ b/man/make_sample_target_plots.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_sample_target_plots} +\alias{make_sample_target_plots} +\title{make_sample_target_plots} +\usage{ +make_sample_target_plots(receiver_info, targets_oi, receiver_oi, grouping_tbl) +} +\arguments{ +\item{receiver_info}{XXX} + +\item{targets_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{grouping_tbl}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_sample_target_plots} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_sample_target_plots_reversed.Rd b/man/make_sample_target_plots_reversed.Rd new file mode 100644 index 0000000..d99749e --- /dev/null +++ b/man/make_sample_target_plots_reversed.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_sample_target_plots_reversed} +\alias{make_sample_target_plots_reversed} +\title{make_sample_target_plots_reversed} +\usage{ +make_sample_target_plots_reversed(receiver_info, targets_oi, receiver_oi, grouping_tbl) +} +\arguments{ +\item{receiver_info}{XXX} + +\item{targets_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{grouping_tbl}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_sample_target_plots_reversed} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_target_nebulosa_feature_plot.Rd b/man/make_target_nebulosa_feature_plot.Rd new file mode 100644 index 0000000..0f1b7d5 --- /dev/null +++ b/man/make_target_nebulosa_feature_plot.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_target_nebulosa_feature_plot} +\alias{make_target_nebulosa_feature_plot} +\title{make_target_nebulosa_feature_plot} +\usage{ +make_target_nebulosa_feature_plot(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, prioritized_tbl_oi) +} +\arguments{ +\item{seurat_obj_receiver}{XXX} + +\item{target_oi}{XXX} + +\item{group_oi}{XXX} + +\item{group_id}{XXX} + +\item{celltype_id_receiver}{XXX} + +\item{receivers_oi}{XXX} + +\item{prioritized_tbl_oi}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_target_nebulosa_feature_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/make_target_violin_plot.Rd b/man/make_target_violin_plot.Rd new file mode 100644 index 0000000..afb9745 --- /dev/null +++ b/man/make_target_violin_plot.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plotting.R +\name{make_target_violin_plot} +\alias{make_target_violin_plot} +\title{make_target_violin_plot} +\usage{ +make_target_violin_plot(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, prioritized_tbl_oi) +} +\arguments{ +\item{seurat_obj_receiver}{XXX} + +\item{target_oi}{XXX} + +\item{receiver_oi}{XXX} + +\item{group_oi}{XXX} + +\item{group_id}{XXX} + +\item{sample_id}{XXX} + +\item{celltype_id_receiver}{XXX} + +\item{prioritized_tbl_oi}{XXX} +} +\value{ +XXXX +} +\description{ +\code{make_target_violin_plot} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/ms_mg_nichenet_analysis.Rd b/man/ms_mg_nichenet_analysis.Rd new file mode 100644 index 0000000..02bdb8b --- /dev/null +++ b/man/ms_mg_nichenet_analysis.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipeline.R +\name{ms_mg_nichenet_analysis} +\alias{ms_mg_nichenet_analysis} +\title{ms_mg_nichenet_analysis} +\usage{ +ms_mg_nichenet_analysis(sender_receiver_separate = TRUE, ...) +} +\arguments{ +\item{sender_receiver_separate}{XXXX} + +\item{...}{Arguments to `ms_mg_nichenet_analysis_separate` (default; when `sender_receiver_separate = TRUE`) or `ms_mg_nichenet_analysis_combined` (when `sender_receiver_separate = FALSE`)} +} +\value{ +XXXX +} +\description{ +\code{ms_mg_nichenet_analysis} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/ms_mg_nichenet_analysis_combined.Rd b/man/ms_mg_nichenet_analysis_combined.Rd new file mode 100644 index 0000000..fa1959c --- /dev/null +++ b/man/ms_mg_nichenet_analysis_combined.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipeline.R +\name{ms_mg_nichenet_analysis_combined} +\alias{ms_mg_nichenet_analysis_combined} +\title{ms_mg_nichenet_analysis_combined} +\usage{ +ms_mg_nichenet_analysis_combined( +seurat_obj, celltype_id, sample_id,group_id,lr_network,ligand_target_matrix,contrasts_oi,contrast_tbl, +prioritizing_weights = c("scaled_lfc_ligand" = 1, "scaled_p_val_ligand" = 1, "scaled_lfc_receptor" = 1, "scaled_p_val_receptor" = 1, "scaled_activity_scaled" = 1.5, +"scaled_activity" = 0.5,"scaled_avg_exprs_ligand" = 1,"scaled_avg_frq_ligand" = 1,"scaled_avg_exprs_receptor" = 1, "scaled_avg_frq_receptor" = 1, +"fraction_expressing_ligand_receptor" = 1,"scaled_abundance_sender" = 0, "scaled_abundance_receiver" = 0), +assay_oi_sce = "RNA",assay_oi_pb ="counts",fun_oi_pb = "sum",de_method_oi = "edgeR",min_cells = 10,logFC_threshold = 0.25,p_val_threshold = 0.05,frac_cutoff = 0.05,p_val_adj = FALSE,top_n_target = 250, verbose = TRUE) +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{celltype_id}{XXXX} + +\item{sample_id}{XXXX} + +\item{group_id}{XXXX} + +\item{lr_network}{XXXX} + +\item{ligand_target_matrix}{XXXX} + +\item{contrasts_oi}{XXXX} + +\item{contrast_tbl}{XXXX} + +\item{prioritizing_weights}{XXXX} + +\item{assay_oi_sce}{XXXX} + +\item{assay_oi_pb}{XXXX} + +\item{fun_oi_pb}{XXXX} + +\item{de_method_oi}{XXXX} + +\item{min_cells}{XXXX} + +\item{logFC_threshold}{XXXX} + +\item{p_val_threshold}{XXXX} + +\item{frac_cutoff}{XXXX} + +\item{p_val_adj}{XXXX} + +\item{top_n_target}{XXXX} + +\item{verbose}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{ms_mg_nichenet_analysis_combined} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/ms_mg_nichenet_analysis_separate.Rd b/man/ms_mg_nichenet_analysis_separate.Rd new file mode 100644 index 0000000..d6a2011 --- /dev/null +++ b/man/ms_mg_nichenet_analysis_separate.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipeline.R +\name{ms_mg_nichenet_analysis_separate} +\alias{ms_mg_nichenet_analysis_separate} +\title{ms_mg_nichenet_analysis_separate} +\usage{ +ms_mg_nichenet_analysis_separate( +seurat_obj_receiver,seurat_obj_sender,celltype_id_receiver,celltype_id_sender,sample_id,group_id,lr_network,ligand_target_matrix,contrasts_oi,contrast_tbl, +prioritizing_weights = c("scaled_lfc_ligand" = 1, "scaled_p_val_ligand" = 1, "scaled_lfc_receptor" = 1, "scaled_p_val_receptor" = 1, "scaled_activity_scaled" = 1.5, +"scaled_activity" = 0.5,"scaled_avg_exprs_ligand" = 1,"scaled_avg_frq_ligand" = 1,"scaled_avg_exprs_receptor" = 1, "scaled_avg_frq_receptor" = 1, +"fraction_expressing_ligand_receptor" = 1,"scaled_abundance_sender" = 0, "scaled_abundance_receiver" = 0), +assay_oi_sce = "RNA",assay_oi_pb ="counts",fun_oi_pb = "sum",de_method_oi = "edgeR",min_cells = 10,logFC_threshold = 0.25,p_val_threshold = 0.05,frac_cutoff = 0.05,p_val_adj = FALSE,top_n_target = 250, verbose = TRUE) +} +\arguments{ +\item{seurat_obj_receiver}{XXXX} + +\item{seurat_obj_sender}{XXXX} + +\item{celltype_id_receiver}{XXXX} + +\item{celltype_id_sender}{XXXX} + +\item{sample_id}{XXXX} + +\item{group_id}{XXXX} + +\item{lr_network}{XXXX} + +\item{ligand_target_matrix}{XXXX} + +\item{contrasts_oi}{XXXX} + +\item{contrast_tbl}{XXXX} + +\item{prioritizing_weights}{XXXX} + +\item{assay_oi_sce}{XXXX} + +\item{assay_oi_pb}{XXXX} + +\item{fun_oi_pb}{XXXX} + +\item{de_method_oi}{XXXX} + +\item{min_cells}{XXXX} + +\item{logFC_threshold}{XXXX} + +\item{p_val_threshold}{XXXX} + +\item{frac_cutoff}{XXXX} + +\item{p_val_adj}{XXXX} + +\item{top_n_target}{XXXX} + +\item{verbose}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{ms_mg_nichenet_analysis_separate} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/perform_muscat_de_analysis.Rd b/man/perform_muscat_de_analysis.Rd new file mode 100644 index 0000000..0ceff18 --- /dev/null +++ b/man/perform_muscat_de_analysis.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/muscat_de.R +\name{perform_muscat_de_analysis} +\alias{perform_muscat_de_analysis} +\title{perform_muscat_de_analysis} +\usage{ +perform_muscat_de_analysis(seurat_obj, sample_id, celltype_id, group_id, covariates, contrasts, assay_oi_sce = "RNA", assay_oi_pb = "counts", fun_oi_pb = "sum", de_method_oi = "edgeR", min_cells = 10) +} +\arguments{ +\item{seurat_obj}{XXXX} + +\item{sample_id}{XXXX} + +\item{celltype_id}{XXXX} + +\item{group_id}{XXXX} + +\item{assay_oi_sce}{XXXX} + +\item{assay_oi_pb}{XXXX} + +\item{fun_oi_pb}{XXXX} + +\item{de_method_oi}{XXXX} + +\item{min_cells}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{perform_muscat_de_analysis} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/process_info_to_ic.Rd b/man/process_info_to_ic.Rd new file mode 100644 index 0000000..f1f9d79 --- /dev/null +++ b/man/process_info_to_ic.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/expression_processing.R +\name{process_info_to_ic} +\alias{process_info_to_ic} +\title{process_info_to_ic} +\usage{ +process_info_to_ic(info_object, ic_type = "sender", lr_network) +} +\arguments{ +\item{info_object}{XXX} + +\item{ic_type}{XXX} + +\item{lr_network}{XXXX} +} +\value{ +XXXX +} +\description{ +\code{process_info_to_ic} XXXX +} +\examples{ +\dontrun{ +print("XXXX") +} + +} diff --git a/man/seurat_obj.Rd b/man/seurat_obj.Rd new file mode 100644 index 0000000..da1dd62 --- /dev/null +++ b/man/seurat_obj.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{seurat_obj} +\alias{seurat_obj} +\title{Seurat object containing scRNAseq data (subsampled)} +\format{ +An object of class Seurat +} +\usage{ +seurat_obj +} +\description{ +Seurat object containing scRNAseq data (subsampled). Source of the data: Puram et al., Cell 2017: “Single-Cell Transcriptomic Analysis of Primary and Metastatic Tumor Ecosystems in Head and Neck Cancer.”. This example data was downsampled (features and cells). +} +\keyword{datasets} diff --git a/multinichenetr.Rproj b/multinichenetr.Rproj new file mode 100644 index 0000000..21a4da0 --- /dev/null +++ b/multinichenetr.Rproj @@ -0,0 +1,17 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/tests/test_integration.R b/tests/test_integration.R new file mode 100644 index 0000000..87f24fc --- /dev/null +++ b/tests/test_integration.R @@ -0,0 +1,5 @@ +library(dplyr) +library(Seurat) +library(testthat) + +test_check("spatialnichenetr", filter = "integration") diff --git a/tests/test_utils.R b/tests/test_utils.R new file mode 100644 index 0000000..54db302 --- /dev/null +++ b/tests/test_utils.R @@ -0,0 +1,7 @@ +library(nichenetr) +library(tidyr) +library(dplyr) +library(Seurat) +library(testthat) + +test_check("spatialnichenetr", filter = "utils") diff --git a/tests/test_visium_scrnaseq_ccc.R b/tests/test_visium_scrnaseq_ccc.R new file mode 100644 index 0000000..e5f343e --- /dev/null +++ b/tests/test_visium_scrnaseq_ccc.R @@ -0,0 +1,7 @@ +library(nichenetr) +library(tidyr) +library(dplyr) +library(Seurat) +library(testthat) + +test_check("spatialnichenetr", filter = "visium_scrnaseq_ccc") diff --git a/tests/test_visiumccc.R b/tests/test_visiumccc.R new file mode 100644 index 0000000..e4ad5d2 --- /dev/null +++ b/tests/test_visiumccc.R @@ -0,0 +1,7 @@ +library(nichenetr) +library(tidyr) +library(dplyr) +library(Seurat) +library(testthat) + +test_check("spatialnichenetr", filter = "visiumccc") diff --git a/tests/testthat/test-integration.R b/tests/testthat/test-integration.R new file mode 100644 index 0000000..0581d4f --- /dev/null +++ b/tests/testthat/test-integration.R @@ -0,0 +1,57 @@ +context("Integrate scRNAseq and Visium data") +test_that("Cell type prediction of spots works", { + + seurat_obj_visium2 = predict_celltypes_of_spots(seurat_obj_visium, seurat_obj_scrnaseq) + expect_type(seurat_obj_visium2,"S4") + + prediction_matrix = seurat_obj_visium2[["celltypes"]]@data + seurat_obj_visium3 = add_prediction_matrix(seurat_obj_visium2, prediction_matrix, assay_name = "testCelltypes") + expect_type(seurat_obj_visium3,"S4") + seurat_obj_visium3 = add_prediction_matrix(seurat_obj_visium2, prediction_matrix %>% t(), assay_name = "testCelltypes2") + expect_type(seurat_obj_visium3,"S4") + + # test whether it works with preselected features + features_oi = c(seurat_obj_visium[["SCT"]] %>% rownames() %>% sample(1000)) %>% intersect(seurat_obj_scrnaseq[["SCT"]] %>% rownames() %>% sample(1000)) + + seurat_obj_visium2 = predict_celltypes_of_spots(seurat_obj_visium, seurat_obj_scrnaseq, integration_features = features_oi) + expect_type(seurat_obj_visium2,"S4") + + # test whether input checks are stringent enough + expect_error(predict_celltypes_of_spots(seurat_obj_scrnaseq, seurat_obj_visium)) + expect_error(predict_celltypes_of_spots(seurat_obj_visium, seurat_obj_scrnaseq, integration_method = "ppp")) + + +}) +test_that("Region and pseudospace prediction of cells works", { + + seurat_obj_scrnaseq2 = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + expect_type(seurat_obj_scrnaseq2,"S4") + + prediction_matrix = seurat_obj_scrnaseq2[["regions"]]@data + seurat_obj_scrnaseq3 = add_prediction_matrix(seurat_obj_scrnaseq2, prediction_matrix, assay_name = "testRegions") + expect_type(seurat_obj_scrnaseq3,"S4") + seurat_obj_scrnaseq3 = add_prediction_matrix(seurat_obj_scrnaseq2, prediction_matrix %>% t(), assay_name = "testRegions") + expect_type(seurat_obj_scrnaseq3,"S4") + + expect_error(add_prediction_matrix(seurat_obj_scrnaseq2, c("should","fail"))) + + seurat_obj_scrnaseq2 = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + expect_type(seurat_obj_scrnaseq2,"S4") + + # test whether it works with preselected features + features_oi = c(seurat_obj_visium[["SCT"]] %>% rownames() %>% sample(1000)) %>% intersect(seurat_obj_scrnaseq[["SCT"]] %>% rownames() %>% sample(1000)) + + seurat_obj_scrnaseq2 = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium, integration_features = features_oi) + expect_type(seurat_obj_scrnaseq2,"S4") + + seurat_obj_scrnaseq2 = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium, integration_features = features_oi) + expect_type(seurat_obj_scrnaseq2,"S4") + + # test whether input checks are stringent enough + expect_error(predict_regions_of_cells(seurat_obj_visium, seurat_obj_scrnaseq)) + expect_error(predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium, integration_method = "ppp")) + + expect_error(predict_pseudospace_of_cells(seurat_obj_visium, seurat_obj_scrnaseq)) + expect_error(predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium, integration_method = "ppp")) + +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 0000000..236dbce --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,61 @@ +context("Utils tests") +test_that("Average expression per region can be defined: visium", { + + avg_expression = get_avg_region_expression(genes = c("Glul","Cyp2f2"), seurat_obj_visium, assay_oi = "SCT") + expect_type(avg_expression,"list") + expect_type(avg_expression$expression,"double") + expect_type(avg_expression$gene,"character") + expect_type(avg_expression$region,"integer") + avg_expression = get_avg_region_expression(genes = NULL, seurat_obj_visium, assay_oi = "SCT") + expect_type(avg_expression,"list") + expect_type(avg_expression$expression,"double") + expect_type(avg_expression$gene,"character") + expect_type(avg_expression$region,"integer") + avg_expression = get_avg_region_expression(genes = c("Glul","Cyp2f2"), seurat_obj_visium, assay_oi = "Spatial") + expect_type(avg_expression,"list") + expect_type(avg_expression$expression,"double") + expect_type(avg_expression$gene,"character") + expect_type(avg_expression$region,"integer") + # test whether input checks are stringent enough + expect_error(get_avg_region_expression(genes = c("Glul","Cyp2f2"), seurat_obj_visium, assay_oi = "Integrated")) + expect_error(get_avg_region_expression(genes = c("Glutamine","Glutamate"), seurat_obj_visium, assay_oi = "Integrated")) +}) +test_that("Average expression per region can be defined: scRNAseq object for one celltype", { + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + seurat_obj_scrnaseq_central_hepatocytes = get_seuratObj_celltype_region(seurat_obj_scrnaseq, celltype_oi = "hepatocyte", region_oi = "central", spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) + avg_expression = get_exprs_frac_region(seurat_obj_scrnaseq_central_hepatocytes, exprs_assay_oi = "SCT") + + expect_type(avg_expression,"list") + expect_type(avg_expression$expression,"double") + expect_type(avg_expression$gene,"character") + expect_type(avg_expression$region_oi,"integer") + + ncells_celltype_region = seurat_obj_scrnaseq_central_hepatocytes %>% subset(ident = 1) %>% Cells() %>% length() + ncells_celltype = seurat_obj_scrnaseq_central_hepatocytes %>% Cells() %>% length() + frac_cells = ncells_celltype_region/ncells_celltype + + DE_table_central_hepatocytes = get_DE_celltype_region(seurat_obj_scrnaseq_central_hepatocytes, frac_cells) + expect_type(DE_table_central_hepatocytes,"list") + expect_type(DE_table_central_hepatocytes$p_val,"double") + expect_type(DE_table_central_hepatocytes$avg_logFC,"double") + expect_type(DE_table_central_hepatocytes$gene,"character") + + }) +test_that("Average expression per celltype and celltype markers can be defined", { + assay_oi = "SCT" + features_oi = rownames(seurat_obj_scrnaseq) %>% head(1000) + + exprs_df = get_exprs_frac_celltype(seurat_obj_scrnaseq, exprs_assay_oi = assay_oi) + markers = get_markers(celltype = "hepatocyte", seurat_obj_scrnaseq) + + celltype_markers = c("hepatocyte","cholangiocyte") %>% lapply(get_markers, seurat_obj_scrnaseq, features_oi) + names(celltype_markers) = c("hepatocyte","cholangiocyte") + celltype_expression = get_exprs_frac_celltype(seurat_obj_scrnaseq, features_oi = features_oi, exprs_assay_oi = assay_oi) + + expect_type(exprs_df,"list") + expect_type(markers,"character") + expect_type(celltype_markers,"list") + expect_type(celltype_expression,"list") + + +}) diff --git a/tests/testthat/test-visium_scrnaseq_ccc.R b/tests/testthat/test-visium_scrnaseq_ccc.R new file mode 100644 index 0000000..76ccb9e --- /dev/null +++ b/tests/testthat/test-visium_scrnaseq_ccc.R @@ -0,0 +1,211 @@ +context("Test functions to analyze CCC after integration of Visium with scRNAseq data") +test_that("Extracting region-specific cells into Seurat objects work", { + + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + + seurat_obj_scrnaseq_portal = get_seuratObj_region_seurat(region_oi = "portal", seurat_obj_scrnaseq, spatial_annotation_assay = "regions", label_transfer_cutoff = 0.25) + seurat_obj_scrnaseq_central = get_seuratObj_region(region_oi = "central", seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) + seurat_obj_scrnaseq_portal_triad = get_seuratObj_region(region_oi = c("portal","portaltriad"), seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) + expect_type(seurat_obj_scrnaseq_portal,"S4") + expect_type(seurat_obj_scrnaseq_central,"S4") + expect_type(seurat_obj_scrnaseq_portal_triad,"S4") + + expect_error(get_seuratObj_region(region_oi = c("portal","portaltriad"), seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 1.25)) + expect_error(get_seuratObj_region(region_oi = c("portal","portaltriad"), seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "harmony", label_transfer_cutoff = 0.25)) + expect_error(get_seuratObj_region(region_oi = c("portal","portaltriad"), seurat_obj_scrnaseq, spatial_annotation_assay = "regionss", integration_method = "seurat", label_transfer_cutoff = 0.25)) + expect_error(get_seuratObj_region(region_oi = c("portal","portaltriad","capsule"), seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25)) + + +}) +test_that("Pseudospace-based Extracting region-specific cells into Seurat objects work", { + + seurat_obj_scrnaseq = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + + seurat_obj_scrnaseq_oi = get_seuratObj_pseudospace_seurat(pseudospace_range = c(0.2,0.6), seurat_obj_scrnaseq, pseudospace_assay = "pseudospace") + expect_type(seurat_obj_scrnaseq_oi,"S4") + + expect_error(get_seuratObj_pseudospace(pseudospace_range = c(0.2,0.1), seurat_obj_scrnaseq, pseudospace_assay = "pseudospace", integration_method = "seurat")) + expect_error(get_seuratObj_pseudospace(pseudospace_range = c(0.2,1.1), seurat_obj_scrnaseq, pseudospace_assay = "pseudospace", integration_method = "seurat")) + expect_error(get_seuratObj_pseudospace(pseudospace_range = c("portal","portaltriad"), seurat_obj_scrnaseq, pseudospace_assay = "pseudospace", integration_method = "harmony")) + expect_error(get_seuratObj_pseudospace(pseudospace_range = c(0.2,0.6), seurat_obj_scrnaseq, pseudospace_assay = "pseudospaceX", integration_method = "seurat")) + +}) +test_that("Extracting and annotating celltypes of interest from regions of interest into Seurat objects work", { + + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + seurat_obj_scrnaseq_central_hepatocytes = get_seuratObj_celltype_region(seurat_obj_scrnaseq, celltype_oi = "hepatocyte", region_oi = "central", spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) + expect_type(seurat_obj_scrnaseq_central_hepatocytes,"S4") + expect_type(seurat_obj_scrnaseq_central_hepatocytes %>% Idents(),"integer") + + expect_error(get_seuratObj_celltype_region(seurat_obj_scrnaseq,region_oi = c("portal"), celltype_oi = "unicorns", spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25)) + rm(seurat_obj_scrnaseq) + + seurat_obj_scrnaseq = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + seurat_obj_scrnaseq_range_oi_hepatocytes = get_seuratObj_celltype_pseudospace(seurat_obj_scrnaseq, celltype_oi = "hepatocyte", pseudospace_range = c(0.2, 0.5), pseudospace_assay = "pseudospace", integration_method = "seurat") + expect_type(seurat_obj_scrnaseq_range_oi_hepatocytes,"S4") + expect_type(seurat_obj_scrnaseq_range_oi_hepatocytes %>% Idents(),"integer") + + expect_error(get_seuratObj_celltype_pseudospace(seurat_obj_scrnaseq, celltype_oi = "unicorns", pseudospace_range = c(0.66, 1), pseudospace_assay = "pseudospace", integration_method = "seurat")) + +}) +test_that("Getting all necessary input information for the CCC analysis works + spatially-aware LR network + ligand-target links and activities", { + + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds"))#' head(lr_network) + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + ccc_info_portal_hepatocyte = get_ccc_info_celltype_region(region_oi = "portal", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "region", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + expect_type(ccc_info_portal_hepatocyte,"list") + expect_type(ccc_info_portal_hepatocyte$region,"character") + expect_type(ccc_info_portal_hepatocyte$celltype,"character") + expect_type(ccc_info_portal_hepatocyte$n_cells,"integer") + expect_type(ccc_info_portal_hepatocyte$cells,"character") + expect_type(ccc_info_portal_hepatocyte$frac_cells,"double") + expect_type(ccc_info_portal_hepatocyte$DE_table,"list") + expect_type(ccc_info_portal_hepatocyte$de_genes,"character") + expect_type(ccc_info_portal_hepatocyte$expressed_genes,"character") + expect_type(ccc_info_portal_hepatocyte$ligands_de,"character") + expect_type(ccc_info_portal_hepatocyte$receptors_de,"character") + expect_type(ccc_info_portal_hepatocyte$ligands_expressed,"character") + expect_type(ccc_info_portal_hepatocyte$receptors_expressed,"character") + + expect_error(get_ccc_info_celltype_region(region_oi = "portal", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "something", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10)) + + rm(seurat_obj_scrnaseq) + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + regions_oi = c("central","portal","portaltriad") + ccc_info_hepatocyte = get_ccc_info_celltype_regions_oi(regions_oi = regions_oi, celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "region", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + expect_type(ccc_info_hepatocyte,"list") + expect_type(ccc_info_hepatocyte[[regions_oi[1]]],"list") + expect_type(ccc_info_hepatocyte[[regions_oi[2]]]$region,"character") + expect_type(ccc_info_hepatocyte[[regions_oi[3]]],"list") + expect_type(ccc_info_hepatocyte[[regions_oi[2]]],"list") + + expect_error( get_ccc_info_celltype_regions_oi(regions_oi = c("Mestalla",regions_oi), celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "region", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10)) + expect_error( get_ccc_info_celltype_regions_oi(regions_oi = regions_oi, celltype_oi = "hepatocyteX", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "region", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10)) + + rm(seurat_obj_scrnaseq) + seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + celltypes_oi = c("hepatocyte","cholangiocyte") + regions_oi = c("central","portal") + t1 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = regions_oi, celltypes_oi = celltypes_oi, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + t2 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = regions_oi, celltypes_oi = NULL, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + t3 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = NULL, celltypes_oi = celltypes_oi, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + t4 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = NULL, celltypes_oi = NULL, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + expect_type(t1[[celltypes_oi[2]]],"list") + expect_type(t2[[celltypes_oi[2]]],"list") + expect_type(t3[[celltypes_oi[2]]],"list") + expect_type(t4[[celltypes_oi[2]]],"list") + spatialCCC_info = t4 + + lr_network = lr_network %>% mutate(bonafide_lr = ! database %in% c("ppi_prediction","ppi_prediction_go")) + lr_network = lr_network %>% distinct(from, to, bonafide_lr) + + assay_oi = "SCT" + features = union(lr_network$from, lr_network$to) %>% intersect(rownames(seurat_obj_scrnaseq)) + celltype_markers = spatialCCC_info %>% names() %>% lapply(get_markers, seurat_obj_scrnaseq, features) + names(celltype_markers) = spatialCCC_info %>% names() + celltype_expression = get_exprs_frac_celltype(seurat_obj_scrnaseq, features_oi = features, exprs_assay_oi = assay_oi) + lr_network_portal = get_region_specific_lr_network(region_oi = "portal", seurat_obj_scrnaseq, spatialCCC_info, lr_network, celltype_markers, celltype_expression)#' } + lr_network_all = get_spatial_specific_lr_network(seurat_obj_scrnaseq, spatialCCC_info, lr_network) + expect_type(lr_network_portal,"list") + expect_type(lr_network_all,"list") + expect_gt(nrow(lr_network_portal), 0) + expect_gt(nrow(lr_network_all), 0) + + # now test ligand-activities-targets for one region + # ligand_target_matrix = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/StaticNicheNet/paper/data_nichenet/ligand_target_matrix.rds") + ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) + colnames(ligand_target_matrix) = ligand_target_matrix %>% colnames() %>% convert_human_to_mouse_symbols() + rownames(ligand_target_matrix) = ligand_target_matrix %>% rownames() %>% convert_human_to_mouse_symbols() + ligand_target_matrix = ligand_target_matrix %>% .[!is.na(rownames(ligand_target_matrix)), !is.na(colnames(ligand_target_matrix))] + ligand_activities_targets_portal = get_region_specific_ligand_activities_targets(region_oi = "portal", seurat_obj_scrnaseq, spatialCCC_info, lr_network, ligand_target_matrix, target_n = 100) + expect_type(ligand_activities_targets_portal,"list") + + ligand_activities_targets_all = get_spatial_specific_ligand_activities_targets(seurat_obj_scrnaseq, spatialCCC_info, lr_network, ligand_target_matrix, target_n = 100) + expect_type(ligand_activities_targets_all,"list") + + +}) + +test_that("Getting all necessary input information for the CCC analysis works: pseudospace + spatially-aware LR network", { + + seurat_obj_scrnaseq = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds"))#' head(lr_network) + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + + region2pseudospace = list("central_pseudospace" = c(0,0.3)) + ccc_info_central_pseudotime_hepatocyte = get_ccc_info_celltype_region(region_oi = "central_pseudospace", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "pseudospace", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + + expect_type(ccc_info_central_pseudotime_hepatocyte,"list") + expect_type(ccc_info_central_pseudotime_hepatocyte$region,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$celltype,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$n_cells,"integer") + expect_type(ccc_info_central_pseudotime_hepatocyte$cells,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$frac_cells,"double") + expect_type(ccc_info_central_pseudotime_hepatocyte$DE_table,"list") + expect_type(ccc_info_central_pseudotime_hepatocyte$de_genes,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$expressed_genes,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$ligands_de,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$receptors_de,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$ligands_expressed,"character") + expect_type(ccc_info_central_pseudotime_hepatocyte$receptors_expressed,"character") + + expect_error(get_ccc_info_celltype_region(region_oi = "central_pseudospace", celltype_oi = "hepatocyteX", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "pseudospace", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace)) + expect_error(get_ccc_info_celltype_region(region_oi = "central", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "pseudospace", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace)) + expect_error(get_ccc_info_celltype_region(region_oi = "central_pseudospace", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "region", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace)) + expect_error(get_ccc_info_celltype_region(region_oi = "central_pseudospace", celltype_oi = "hepatocyte", seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "pseudospace", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = NULL)) + + rm(seurat_obj_scrnaseq) + seurat_obj_scrnaseq = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + regions_oi = c("central_pseudospace","portal_pseudospace") + region2pseudospace = list("central_pseudospace" = c(0,0.3), "portal_pseudospace" = c(0.5,1)) + ccc_info_hepatocyte = get_ccc_info_celltype_regions_oi(celltype_oi = "hepatocyte", regions_oi = regions_oi, seurat_obj_scrnaseq = seurat_obj_scrnaseq, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, type = "pseudospace", exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + + expect_type(ccc_info_hepatocyte,"list") + expect_type(ccc_info_hepatocyte[[regions_oi[1]]],"list") + expect_type(ccc_info_hepatocyte[[regions_oi[2]]]$region,"character") + expect_type(ccc_info_hepatocyte[[regions_oi[2]]],"list") + # + # + rm(seurat_obj_scrnaseq) + seurat_obj_scrnaseq = predict_pseudospace_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) + celltypes_oi = c("hepatocyte","cholangiocyte") + regions_oi = c("central_pseudospace","portal_pseudospace") + region2pseudospace = list("central_pseudospace" = c(0,0.3), "portal_pseudospace" = c(0.5,1)) + + #' spatialCCC_info_pseudospace = get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = regions_oi, celltypes_oi = celltypes_oi, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + + t1 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = regions_oi, celltypes_oi = celltypes_oi, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + t2 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = regions_oi, celltypes_oi = NULL, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + t3 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = NULL, celltypes_oi = celltypes_oi, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + t4 = get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = NULL, celltypes_oi = NULL, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = region2pseudospace) + expect_type(t1[[celltypes_oi[2]]],"list") + expect_type(t2[[celltypes_oi[2]]],"list") + expect_type(t3[[celltypes_oi[2]]],"list") + expect_type(t4[[celltypes_oi[2]]],"list") + spatialCCC_info = t4 + expect_error(get_spatialCCC_info(seurat_obj_scrnaseq, type = "pseudospace", spatial_annotation_assay = "pseudospace", regions_oi = NULL, celltypes_oi = NULL, lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10, region2pseudospace = NULL)) + + lr_network = lr_network %>% mutate(bonafide_lr = ! database %in% c("ppi_prediction","ppi_prediction_go")) + lr_network = lr_network %>% distinct(from, to, bonafide_lr) + + assay_oi = "SCT" + features = union(lr_network$from, lr_network$to) %>% intersect(rownames(seurat_obj_scrnaseq)) + celltype_markers = spatialCCC_info %>% names() %>% lapply(get_markers, seurat_obj_scrnaseq, features) + names(celltype_markers) = spatialCCC_info %>% names() + celltype_expression = get_exprs_frac_celltype(seurat_obj_scrnaseq, features_oi = features, exprs_assay_oi = assay_oi) + lr_network_portal = get_region_specific_lr_network(region_oi = "portal_pseudospace", seurat_obj_scrnaseq, spatialCCC_info, lr_network, celltype_markers, celltype_expression)#' } + lr_network_all = get_spatial_specific_lr_network(seurat_obj_scrnaseq, spatialCCC_info, lr_network) + expect_type(lr_network_portal,"list") + expect_type(lr_network_all,"list") + expect_gt(nrow(lr_network_portal), 0) + expect_gt(nrow(lr_network_all), 0) + + + +}) + + + + + diff --git a/tests/testthat/test-visiumccc.R b/tests/testthat/test-visiumccc.R new file mode 100644 index 0000000..76907c7 --- /dev/null +++ b/tests/testthat/test-visiumccc.R @@ -0,0 +1,119 @@ +context("Use only Visium for cell-cell communication analysis") +test_that("Finding region-specific ligands, receptors, and ligand-receptor interactions work", { + + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + region_markers = FindAllMarkers(seurat_obj_visium, min.pct = 0.10, logfc.threshold = 0.15,return.thresh = 0.01, only.pos = TRUE, verbose = FALSE) + region_oi = "central" + lr_network_central = get_ligands_receptors_of_region(region_oi, seurat_obj_visium, region_markers, lr_network) + + expect_type(lr_network_central,"list") + expect_type(lr_network_central$ligands_region,"character") + expect_type(lr_network_central$receptors_region,"character") + expect_type(lr_network_central$lr_network_region,"list") + + # test whether input checks are stringent enough + expect_error(get_ligands_receptors_of_region("blabla", seurat_obj_visium, region_markers, lr_network)) + expect_error(get_ligands_receptors_of_region(region_oi, seurat_obj_visium, region_markers %>% rename(Gene = gene), lr_network)) + expect_error(get_ligands_receptors_of_region(region_oi, seurat_obj_visium, region_markers, lr_network %>% rename(ligand = from, receptor = to))) + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) + expect_warning(get_ligands_receptors_of_region(region_oi, seurat_obj_visium, region_markers, lr_network)) + + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + regions_all = c("central","portal") + lr_network_central_portal = get_ligands_receptors_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network) + expect_type(lr_network_central_portal,"list") + expect_type(lr_network_central_portal$central,"list") + expect_type(lr_network_central_portal$central$ligands_region,"character") + expect_type(lr_network_central_portal$central$receptors_region,"character") + expect_type(lr_network_central_portal$central$lr_network_region,"list") + expect_type(lr_network_central_portal$portal,"list") + expect_type(lr_network_central_portal$portal$ligands_region,"character") + expect_type(lr_network_central_portal$portal$receptors_region,"character") + expect_type(lr_network_central_portal$portal$lr_network_region,"list") + + # test whether input checks are stringent enough + expect_error(get_ligands_receptors_of_all_regions(c("Anil", "Canalla","Fuera","De","Mestalla"), seurat_obj_visium, region_markers, lr_network)) + expect_error(get_ligands_receptors_of_all_regions(regions_all, seurat_obj_visium, region_markers %>% rename(Gene = gene), lr_network)) + expect_error(get_ligands_receptors_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network %>% rename(ligand = from, receptor = to))) + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) + expect_warning(get_ligands_receptors_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network)) + + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + region_markers = FindAllMarkers(seurat_obj_visium, min.pct = 0.10, logfc.threshold = 0.25,return.thresh = 0.01, only.pos = TRUE) + regions_all = seurat_obj_visium %>% Idents() %>% levels() + lr_network_all_regions = get_ligands_receptors_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network) + + spatial_de_lr_network = plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "SCT", merge = "product", lr_network_de_strict = TRUE) + expect_type(spatial_de_lr_network,"list") + expect_type(spatial_de_lr_network$raw_lr_network,"list") + expect_type(spatial_de_lr_network$exprs_lr_network,"list") + expect_type(spatial_de_lr_network$plots,"list") + + expect_error(plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "SCT", merge = "VCF")) + + spatial_de_lr_network = plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "SCT", merge = "product", lr_network_de_strict = FALSE) + expect_type(spatial_de_lr_network,"list") + expect_type(spatial_de_lr_network$raw_lr_network,"list") + expect_type(spatial_de_lr_network$exprs_lr_network,"list") + expect_type(spatial_de_lr_network$plots,"list") + spatial_de_lr_network = plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "SCT", merge = "average", lr_network_de_strict = TRUE) + expect_type(spatial_de_lr_network,"list") + expect_type(spatial_de_lr_network$raw_lr_network,"list") + expect_type(spatial_de_lr_network$exprs_lr_network,"list") + expect_type(spatial_de_lr_network$plots,"list") + spatial_de_lr_network = plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "SCT", merge = "average", lr_network_de_strict = FALSE) + expect_type(spatial_de_lr_network,"list") + expect_type(spatial_de_lr_network$raw_lr_network,"list") + expect_type(spatial_de_lr_network$exprs_lr_network,"list") + expect_type(spatial_de_lr_network$plots,"list") + spatial_de_lr_network = plot_spatial_de_lr_network(lr_network_all_regions, seurat_obj_visium, assay_oi = "Spatial", merge = "product", lr_network_de_strict = TRUE) + expect_type(spatial_de_lr_network,"list") + expect_type(spatial_de_lr_network$raw_lr_network,"list") + expect_type(spatial_de_lr_network$exprs_lr_network,"list") + expect_type(spatial_de_lr_network$plots,"list") + + +}) +test_that("Finding region-specific ligand activities and targets work", { + + lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) + lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() + region_markers = FindAllMarkers(seurat_obj_visium, min.pct = 0.10, logfc.threshold = 0.15,return.thresh = 0.01, only.pos = TRUE, verbose = FALSE) + region_oi = "central" + + ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) + # ligand_target_matrix = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/StaticNicheNet/paper/data_nichenet/ligand_target_matrix.rds") + + colnames(ligand_target_matrix) = ligand_target_matrix %>% colnames() %>% convert_human_to_mouse_symbols() + rownames(ligand_target_matrix) = ligand_target_matrix %>% rownames() %>% convert_human_to_mouse_symbols() + ligand_target_matrix = ligand_target_matrix %>% .[!is.na(rownames(ligand_target_matrix)), !is.na(colnames(ligand_target_matrix))] + + ligand_activities_targets_central = get_ligand_activities_of_region(region_oi, seurat_obj_visium, region_markers, lr_network, ligand_target_matrix, target_n = 100) + + expect_type(ligand_activities_targets_central,"list") + expect_type(ligand_activities_targets_central$ligand_activities,"list") + expect_type(ligand_activities_targets_central$ligand_target_region,"list") + expect_type(ligand_activities_targets_central$ligand_activities_region,"list") + + # test whether input checks are stringent enough + expect_error(get_ligand_activities_of_region("blabla", seurat_obj_visium, region_markers, lr_network, ligand_target_matrix, target_n = 100)) + + regions_all = c("central","portal") + ligand_activities_targets_central_portal = get_ligand_activities_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network, ligand_target_matrix, target_n = 100) + expect_type(ligand_activities_targets_central_portal,"list") + expect_type(ligand_activities_targets_central_portal$central,"list") + expect_type(ligand_activities_targets_central_portal$central$ligand_activities,"list") + expect_type(ligand_activities_targets_central_portal$central$ligand_activities_region,"list") + expect_type(ligand_activities_targets_central_portal$central$ligand_target_region,"list") + expect_type(ligand_activities_targets_central_portal$portal,"list") + expect_type(ligand_activities_targets_central_portal$portal$ligand_activities,"list") + expect_type(ligand_activities_targets_central_portal$portal$ligand_activities_region,"list") + expect_type(ligand_activities_targets_central_portal$portal$ligand_target_region,"list") + + # test whether input checks are stringent enough + expect_error(get_ligand_activities_of_all_regions(regions_all, seurat_obj_visium, region_markers, lr_network, ligand_target_matrix, target_n = c("3",100))) + + +}) diff --git a/vignettes/basic_analysis.Rmd b/vignettes/basic_analysis.Rmd new file mode 100644 index 0000000..6861f49 --- /dev/null +++ b/vignettes/basic_analysis.Rmd @@ -0,0 +1,386 @@ +--- +title: "Multi-Group Multi-Sample Cell-Cell Communication Analysis via NicheNet: HNSCC application" +author: "Robin Browaeys" +date: "2021-02-15" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Basic analysis of cell-cell communication from spatial data: spatial regions approach} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + + + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + # comment = "#>", + warning = FALSE, + message = FALSE +) +``` + +In this vignette, you can learn how to perform a basic spatially aware cell-cell communication analysis. + +The pipeline of a basic analysis consist mainly of the following steps: + +* 1. Integration of scRNAseq with spatial transcriptomics data to spatially annotate cells +* 2. Perform cell-cell communication analysis for cells residing in same spatial regions + +This vignette guides you in detail through all these steps. As example expression data of interacting cells, we will use data from XXX. + +# Step 0: Load required packages and processed scRNAseq and Visium expression data + +To see how to process 10x Visium data: you can check the following vignette [Analyze visium data: clustering and pseudospace inference of spots](analyze_visium.md):`vignette("analyze_visium", package="spatialnichenetr")` + +For the analysis here: we assume that the 10X Visium data contains a metadata column 'region' (and optionally 'pseudospace' if applicable), and that the scRNAseq data contains a metadata column 'celltype', which are also the identities. + +Packages: + +```{r} +library(spatialnichenetr) +library(nichenetr) +library(Seurat) +library(tidyverse) +``` + +scRNAseq data: + +```{r} +seurat_obj_scrnaseq = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/scRNAseq/data_scrnaseq.rds") +DimPlot(seurat_obj_scrnaseq, reduction = "umap",pt.size = 1) +``` + +10X Visium spatial transcriptomics: + +```{r} +seurat_obj_visium = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/visium/data_visium_regions.rds") +DimPlot(seurat_obj_visium, reduction = "umap",pt.size = 1) +SpatialDimPlot(seurat_obj_visium) +``` + +# Step 1: Integrate the spatial transcriptomics (10x Visium) and scRNAseq data: Define cell type composition of spots (optional) + +```{r} +if(DefaultAssay(seurat_obj_visium) != "SCT"){ + DefaultAssay(seurat_obj_visium) = "SCT" +} +if(DefaultAssay(seurat_obj_scrnaseq) != "SCT"){ + DefaultAssay(seurat_obj_scrnaseq) = "SCT" +} +seurat_obj_visium = predict_celltypes_of_spots(seurat_obj_visium, seurat_obj_scrnaseq) +DefaultAssay(seurat_obj_visium) = "celltypes" # for visualization +``` + +Visualize the cell type prediction scores of each spot: tissue view + +```{r, fig.width=11, fig.height=8} +# all cell types at once +basic_plot = SpatialFeaturePlot(seurat_obj_visium, features = rownames(seurat_obj_visium), ncol = 4, combine = FALSE, crop = TRUE, pt.size.factor = 1.66) + +custom_scale_fill = scale_fill_gradientn(colours = RColorBrewer::brewer.pal(n = 8, name = "Spectral") %>% rev(),values = c(0,0.025,0.05,0.10,0.15,0.22,0.30,0.40,0.60, 1), limits = c(0, 1)) + +custom_plots = lapply(basic_plot, function (x) x + custom_scale_fill + theme(legend.position = "top")) %>% patchwork::wrap_plots() +custom_plots +``` + + +# Step 2: Integrate the spatial transcriptomics (10x Visium) and scRNAseq data: spatially annotate cells + +Define spatial region of cells + +```{r} +if(DefaultAssay(seurat_obj_visium) != "SCT"){ + DefaultAssay(seurat_obj_visium) = "SCT" +} +if(DefaultAssay(seurat_obj_scrnaseq) != "SCT"){ + DefaultAssay(seurat_obj_scrnaseq) = "SCT" +} +seurat_obj_scrnaseq = predict_regions_of_cells(seurat_obj_scrnaseq, seurat_obj_visium) +DefaultAssay(seurat_obj_scrnaseq) = "regions" + +``` + +Visualize the 'region prediction scores' of each cell + +```{r, fig.width=10} +basic_plot = FeaturePlot(seurat_obj_scrnaseq, features = c("central","midcentral","centralHbbMt","mid", "midportal","portalHbbIfn","portal","portaltriad"), ncol = 4, combine = FALSE) + +custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 4, name = "RdBu") %>% rev(),values = c(0,0.2, 0.4, 0.6, 1), limits = c(0, 1)) + +custom_plots = lapply(basic_plot, function (x) x + custom_scale_fill + theme(legend.position = "none")) %>% patchwork::wrap_plots(ncol = 4) + +custom_plots + +# compare to the cell type predictions +DimPlot(seurat_obj_scrnaseq,label = T) +``` + + +# Step 3: save new integrated objects + +Save both the scRNAseq and the Visium Seurat objects after integration. These saved objects will be used as input later for the spatially aware cell-cell communication analyis. + +```{r} +if(DefaultAssay(seurat_obj_visium) != "SCT"){ + DefaultAssay(seurat_obj_visium) = "SCT" +} +if(DefaultAssay(seurat_obj_scrnaseq) != "SCT"){ + DefaultAssay(seurat_obj_scrnaseq) = "SCT" +} +seurat_obj_visium %>% saveRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/visium/data_visium_integrated.rds") +seurat_obj_scrnaseq %>% saveRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/scrnaseq/data_scrnaseq_integrated.rds") +``` + +# Step 4: spatially aware cell-cell communication inference + +## Step4A: Extract cells from region of interest + +First, we will demonstrate how to extract cells that are only present in a region (or regions) of interest + +As examples: we will take the central vein as one region of interest, and for another object, we will consider both the portal vein and the portaltriad. + +```{r} +seurat_obj_visium = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/visium/data_visium_integrated.rds") +seurat_obj_scrnaseq = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/NicheNet_visium/data/liver/scrnaseq/data_scrnaseq_integrated.rds") +``` + +```{r} +seurat_obj_scrnaseq_central = get_seuratObj_region(region_oi = "central", seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) +seurat_obj_scrnaseq_portal_triad = get_seuratObj_region(region_oi = c("portal","portaltriad"), seurat_obj_scrnaseq, spatial_annotation_assay = "regions", integration_method = "seurat", label_transfer_cutoff = 0.25) +``` + +We will show now in a UMAP which of the original cells were kept (and compare to the scored cells above): + +```{r} +central_plot_scores = FeaturePlot(seurat_obj_scrnaseq, features = c("central")) + scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 4, name = "RdBu") %>% rev(),values = c(0,0.2, 0.4, 0.6, 1), limits = c(0, 1)) +central_plot_scores + +central_plot_cells = DimPlot(seurat_obj_scrnaseq_central) +central_plot_cells +``` +```{r} +basic_plot = FeaturePlot(seurat_obj_scrnaseq, features = c("portal","portaltriad"), ncol = 2, combine = FALSE) +custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 4, name = "RdBu") %>% rev(),values = c(0,0.2, 0.4, 0.6, 1), limits = c(0, 1)) +portal_plot_scores = lapply(basic_plot, function (x) x + custom_scale_fill + theme(legend.position = "none")) %>% patchwork::wrap_plots(ncol = 2) +portal_plot_scores + +portal_plot_cells = DimPlot(seurat_obj_scrnaseq_portal_triad) +portal_plot_cells + +``` + +These Seurat objects can now be used as input for classic ligand-receptor analysis methods, CellPhoneDB and NicheNet. In this way, you have now filtered the dataset to only consider cells that are located in the same spatial regions. + + +## Step 4B Perform Spatially-aware Cell-cell communication analysis: region-specific cell-cell communication inference and spatial NicheNet + +### Step 4B.1: Extract information necessary as input for cell-cell communication analysis + +In this step, we will define the following elements for each cell type of interest over all regions of interest: the number and fraction of cells of a cell type belonging to a specific region, the genes expressed in cells from that celltype/region, the genes upregulated in those cells, the ligands and receptors expressed in that region, and also the ligands and receptors upregulated in that region. + +Because this might take a few minutes to run for all celltypes and all regions (because of several DE and expression calculations), we will here demonstrate how to get this information in one go for a few cell types and regions. The line of code necessary to do it for all cell types and all regions will be commented. + +```{r} +# lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) +lr_network = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/StaticNicheNet/paper/data_nichenet/lr_network.rds") +lr_network = lr_network %>% mutate(from = convert_human_to_mouse_symbols(from), to = convert_human_to_mouse_symbols(to)) %>% drop_na() # because we have mouse data +lr_network = lr_network %>% mutate(bonafide_lr = ! database %in% c("ppi_prediction","ppi_prediction_go")) # to indicate whether a LR interaction is documented in manually annotated databases or predicted +lr_network = lr_network %>% distinct(from, to, bonafide_lr) +``` + +```{r} +celltypes_oi = c("hepatocyte","cholangiocyte","kupffer", "endothelial","stellate") +regions_oi = c("central", "midcentral", "mid","midportal", "portal", "portaltriad") + +spatialCCC_info = get_spatialCCC_info(seurat_obj_scrnaseq = seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = regions_oi, celltypes_oi = celltypes_oi, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) + +# spatialCCC_info = get_spatialCCC_info(seurat_obj_scrnaseq = seurat_obj_scrnaseq, type = "region", spatial_annotation_assay = "regions", regions_oi = NULL, celltypes_oi = NULL, lr_network = lr_network, cutoff_ncells = 10, cutoff_frac_cells = 0.001, exprs_assay_oi = "SCT", exprs_frac_cutoff = 0.10) # this will consider all celltypes and regions of interest +``` + +We will now briefly show the type of information you can find in these objects: + +For example: list the region-specific ligands + +```{r} +spatialCCC_info[["hepatocyte"]][["central"]]$ligands_de +spatialCCC_info[["hepatocyte"]][["portal"]]$ligands_de +``` + +Let's now visualize some of these ligands in a FeaturePlot, and compare to the UMAP showing region predictions to demonstrate their spatially differential expression + +```{r} +basic_plot = FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = "hepatocyte"), features = c("portal")) +custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 4, name = "RdBu") %>% rev(),values = c(0,0.2, 0.4, 0.6, 1), limits = c(0, 1)) +region_plot = basic_plot + custom_scale_fill + +ligand_plot = FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = "hepatocyte"), features = c("Cdh1")) + +combined_plot = patchwork::wrap_plots(region_plot, ligand_plot, ncol = 2) +combined_plot +``` + +To get more deeper in hepatocytes around the portal vein, you could extract a specific SeuratObj containing hepatocytes only and annotating whether cells belong to the portal vein (identity = 1) or not (identity = 0) + +```{r, fig.width=10} +seurat_obj_hep_portal = get_seuratObj_celltype_region(seurat_obj_scrnaseq = seurat_obj_scrnaseq, celltype_oi = "hepatocyte", region_oi = "portal") +VlnPlot(seurat_obj_hep_portal, features = "Cdh1") +DotPlot(seurat_obj_hep_portal, features = c(spatialCCC_info[["hepatocyte"]][["portal"]]$ligands_de, spatialCCC_info[["hepatocyte"]][["central"]]$ligands_de)) +``` + + +This information will allow us now to perform several types of analysis, which we will showcase now. + +### Step 4B.2: get a spatially-aware ligand-receptor network + +With the following command, we will construct a ligand-receptor network between all cells from the cell types in `spatialCCC_info` for each region in `spatialCCC_info` separately. Each ligand-receptor interaction will also be annotated by additional such as the spatially DE status of ligand/receptor, whether sesnder/receiver cell types are region-specific, the average expression of the ligand/receptor and product of both, scaled over the different regions,.... + +```{r} +spatial_lr_network = get_spatial_specific_lr_network(seurat_obj_scrnaseq, spatialCCC_info, lr_network) +head(spatial_lr_network) +nrow(spatial_lr_network) +``` + +As you can see, this table contains much information. Therefore we will do some prioritization to find back the most region-specific ligand-receptor pairs: +For example: in first instance, we might be most interested in a ligand-receptor interaction of which at least one of both ligand and receptor is higher expressed in the region of interest, one of both is also cell-type specific, and sender cell type is different from receiver cell type. + +```{r} +spatial_lr_network_filtered = spatial_lr_network %>% filter( (ligand_spatial_de) | (receptor_spatial_de)) %>% + filter(ligand_sender_marker | receptor_receiver_marker) %>% filter(sender != receiver) +head(spatial_lr_network_filtered) +nrow(spatial_lr_network_filtered) +``` + +Apparently, there are still many interactions left, so we will filter even more deeply before prioritization, e.g. by focusing on differential interactions between two cell types in more than one region + +```{r} +sender_receiver_oi = spatial_lr_network_filtered %>% ungroup() %>% distinct(sender_receiver, region) %>% group_by(sender_receiver) %>% count() %>% filter(n > 1) +sender_receiver_oi +sender_receiver_oi = sender_receiver_oi %>% pull(sender_receiver) + +spatial_lr_network_filtered = spatial_lr_network_filtered %>% filter(sender_receiver %in% sender_receiver_oi) +lr_interactions_filtered = spatial_lr_network_filtered %>% pull(lr_interaction) %>% unique() +sender_receiver_filtered = spatial_lr_network_filtered %>% pull(sender_receiver) %>% unique() + +``` + +So let's make now a figure only showing these relevant lr interactions + +Let's now visualize these interactions in a dotplot (color of dots = product of quantile scaled expression of ligand and receptor, size = bona fide interaction or not) + +```{r, fig.height= 8, fig.width = 21} +spatial_lr_network %>% filter(sender_receiver %in% sender_receiver_filtered & lr_interaction %in% lr_interactions_filtered) %>% + ggplot(aes(lr_interaction, region)) + + geom_point(aes(color = quantile_scaled_expression_lr_region, size = quantile_scaled_expression_lr_celltype)) + facet_grid(sender_receiver~.) + + scale_x_discrete(position = "top") + + scale_color_distiller(palette = "RdYlBu", direction = -1, na.value = "white") + + theme_classic() + + theme(axis.ticks = element_blank(), axis.title.x = element_text(size = 12), axis.text.y = element_text(face = "italic", size = 9), axis.text.x = element_text(size = 9, angle = 90,hjust = 0)) +``` + + +```{r, fig.height= 8, fig.width = 21} +spatial_lr_network %>% filter(sender_receiver %in% sender_receiver_filtered & lr_interaction %in% lr_interactions_filtered) %>% + ggplot(aes(lr_interaction, region)) + + geom_point(aes(color = scaled_expression_lr_region, size = scaled_expression_lr_celltype)) + facet_grid(sender_receiver~.) + + scale_x_discrete(position = "top") + + scale_color_distiller(palette = "RdYlBu", direction = -1, na.value = "white") + + theme_classic() + + theme(axis.ticks = element_blank(), axis.title.x = element_text(size = 12), axis.text.y = element_text(face = "italic", size = 9), axis.text.x = element_text(size = 9, angle = 90,hjust = 0)) +``` + + +### Step 4B.3: Spatial NicheNet: Extract ligand activities and target genes of a ligand in each receiver/region combination + +Read in the NicheNet ligand-target matrix + +```{r} +ligand_target_matrix = readRDS("C:/Users/rbrowaey/work/Research/NicheNet/StaticNicheNet/paper/data_nichenet/ligand_target_matrix.rds") +# ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) +colnames(ligand_target_matrix) = ligand_target_matrix %>% colnames() %>% convert_human_to_mouse_symbols() +rownames(ligand_target_matrix) = ligand_target_matrix %>% rownames() %>% convert_human_to_mouse_symbols() +ligand_target_matrix = ligand_target_matrix %>% .[!is.na(rownames(ligand_target_matrix)), !is.na(colnames(ligand_target_matrix))] +``` + +Define activities and targets and check some ligands with high spatially-specific activity + +```{r} +ligand_activities_targets_all = get_spatial_specific_ligand_activities_targets(seurat_obj_scrnaseq, spatialCCC_info, lr_network, ligand_target_matrix, target_n = 100) +ligand_activities_targets_all %>% arrange(-pearson_specific_bg) %>% distinct(ligand, region, receiver, pearson_specific_bg, target) %>% head(25) +``` + +Remarkably, we see some high ligand activities for inflammatory cytokines (Il1b, Tnf) in midportal hepatocytes. In a next step we will check whether there are some midportal cells expressing these cytokines there by combining the ligand-receptor with ligand activity information. + +### Step 4B.4: Combine the ligand-receptor information with the ligand activities and ligand-target links + +```{r} +ligand_receptor_activities_targets = inner_join(spatial_lr_network, ligand_activities_targets_all, by = c("ligand", "receiver", "region")) +ligand_receptor_activities_targets %>% filter(ligand_spatial_de | receptor_spatial_de | sender_region_specific | receiver_region_specific) %>% arrange(-pearson_specific_bg) %>% select(lr_interaction, ligand, receptor, sender, receiver, region, pearson_specific_bg, ligand_spatial_de, receptor_spatial_de, sender_region_specific, receiver_region_specific) %>% distinct() +``` + +And indeed, midportal KCs seem to express Il1b! Also interestingly is that the Il1-receptor is higher expressed in midportal hepatocytes than other regions. Altough Il1b expression in portal KCs seems to be higher than midportal, this might be an interesting predicion. + +Therefore, we will visually check this now by first checking expression of ligand, receptor and targets on the visium data, and secondly on the spatially annotated single-cell data. + +```{r} +ligands_oi = c("Il1b","Il1rn") +receptors_oi = c("Il1r1") +targets_oi = ligand_receptor_activities_targets %>% filter(ligand == "Il1b", receiver == "hepatocyte" & region == "midportal") %>% pull(target) %>% unique() +``` + +```{r} +SpatialFeaturePlot(seurat_obj_visium, ligands_oi) +SpatialFeaturePlot(seurat_obj_visium, receptors_oi) +SpatialFeaturePlot(seurat_obj_visium, targets_oi) + +VlnPlot(seurat_obj_visium, ligands_oi) +VlnPlot(seurat_obj_visium, receptors_oi) +VlnPlot(seurat_obj_visium, targets_oi) + +FeaturePlot(seurat_obj_visium, ligands_oi) +FeatureScatter(seurat_obj_visium, feature1 = ligands_oi[1], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = ligands_oi[2], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = targets_oi[1], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = targets_oi[2], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = targets_oi[3], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = targets_oi[4], feature2 = receptors_oi) +FeatureScatter(seurat_obj_visium, feature1 = targets_oi[6], feature2 = receptors_oi) + +``` + + +Expression on Visium does not seem very nice, but we can still check the spatially annotated scRNAseq data + +```{r, fig.width=10} +basic_plot = FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte","kupffer")), features = c("mid", "midportal","portal"), ncol = 3, combine = FALSE, label = T) + +custom_scale_fill = scale_color_gradientn(colours = RColorBrewer::brewer.pal(n = 4, name = "RdBu") %>% rev(),values = c(0,0.2, 0.4, 0.6, 1), limits = c(0, 1)) + +custom_plots = lapply(basic_plot, function (x) x + custom_scale_fill + theme(legend.position = "none")) %>% patchwork::wrap_plots(ncol = 3) + +custom_plots +``` + +```{r, fig.width=10} +FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte","kupffer")), features = c(ligands_oi)) +FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte","kupffer")), features = c(receptors_oi)) +FeaturePlot(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte","kupffer")), features = c(targets_oi)) +``` + +```{r, fig.width=10} +seurat_obj_scrnaseq@meta.data$midportal = seurat_obj_scrnaseq@assays$regions["midportal",] %>% as.numeric() +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = receptors_oi, feature2 = "midportal") +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = targets_oi[1], feature2 = "midportal") +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = targets_oi[2], feature2 = "midportal") +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = targets_oi[3], feature2 = "midportal") +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = targets_oi[4], feature2 = "midportal") +FeatureScatter(seurat_obj_scrnaseq %>% subset(ident = c("hepatocyte")), feature1 = targets_oi[6], feature2 = "midportal") + +``` + + +Not so nice :( + +not so stringent enough? diff --git a/vignettes/pipeline_ms_mg_nichenet_wrapper_CRC.Rmd b/vignettes/pipeline_ms_mg_nichenet_wrapper_CRC.Rmd new file mode 100644 index 0000000..442c717 --- /dev/null +++ b/vignettes/pipeline_ms_mg_nichenet_wrapper_CRC.Rmd @@ -0,0 +1,360 @@ +--- +title: 'Multi-Group Multi-Sample Cell-Cell Communication Analysis via NicheNet: HNSCC + application' +author: "Robin Browaeys" +date: "5-2-2021" +output: html_document +--- + + +```{r setup, include = FALSE} +# knitr::opts_knit$set( +# collapse = TRUE, +# # comment = "#>", +# warning = FALSE, +# message = FALSE, +# # root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' +# root.dir = '../' +# +# ) +knitr::opts_knit$set(root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' ) + +``` + +In this analysis we will analyze differential cell-cell communication between different patient groups in colorectal cancer. + +# Step 0: Load packages and NicheNet ligand-receptor network and ligand-target matrix + +```{r} +library(Seurat) +library(BiocStyle) +library(Nebulosa) +library(cowplot) +library(tidyverse) +library(limma) +library(muscat) +library(ExperimentHub) +library(scater) +library(circlize) +library(RColorBrewer) +source("scripts/functions_muscat_de.R") +``` + +```{r} +# LR network +lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) +lr_network = lr_network %>% filter(! database %in% c("ppi_prediction","ppi_prediction_go")) +lr_network = lr_network %>% dplyr::rename(ligand = from, receptor = to) %>% distinct(ligand, receptor) +``` + +```{r} +ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) +``` + +# Step 1: Prepare Seurat Objects for Sender and Receiver cells + +## T cells as receiver + +Set the cell type label of interest as cell identity and keep only good samples. +In this analysis we are only interested in MSI, CMS2 and CMS4 patients, therefore we will pool all the other samples so that we don't remove cell types that have too few cells in patient groups that are not of interest to our comparison. + +```{r} +getwd() +seurat_obj_receiver = readRDS("data/201013KULSMCAllTFiltered.rds") +seurat_obj_receiver@meta.data$TmajorScaled = seurat_obj_receiver@meta.data$TmajorScaled %>% make.names() +seurat_obj_receiver = SetIdent(seurat_obj_receiver, value = "TmajorScaled") +good_samples = c("EXT001","EXT002","EXT003","EXT009","EXT010","EXT011","EXT012","EXT013","EXT031","EXT032","EXT048","EXT049","EXT050","EXT093","EXT094","EXT095","EXT097","EXT098","EXT099","EXT121","EXT122","EXT123","EXT127","EXT128","EXT129","PM0001N","PM0001T","PM0002N","PM0002T","PM0003T","PM0004N", "PM0004T","PM0005N","PM0005T","PM0010N","PM0010T","PM0011T","PM0014T","PM0016T","PM0017T","PM0018T","PM0019T","PM0020T","PM0021T","PM0022T","PM0023T","PM0024T","PM0025T","SMC0010T","SMC057T","SMC063T","SMC071T","SMC083T","SMC105T","SMC108T","SMC112T","SMC119T","SMC125T","SMC126T","SMC136T","SMC145T","SMC164T","SMC174T","SMC179T","SMC180T","SMC197T","SMC200T","SMC215T","SMC216T","SMC217T") +seurat_obj_receiver = subset(seurat_obj_receiver, subset = sample_ID %in% good_samples) +seurat_obj_receiver@meta.data$CMSMSItis[seurat_obj_receiver@meta.data$CMSMSItis == "NA"] = "CMS_NA" # because NA as name will result in errors later on + +# because our contrasts of interest have to do with CMS2-CMS4-MSI, we will pool the groups that are not of interest! +# This will help us in having more cell types for which we can do the DE analysis +seurat_obj_receiver@meta.data$CMSMSItis[seurat_obj_receiver@meta.data$CMSMSItis == "CMS_NA"] = "Other" # because NA as name will result in errors later on +seurat_obj_receiver@meta.data$CMSMSItis[seurat_obj_receiver@meta.data$CMSMSItis == "CMS1"] = "Other" # because NA as name will result in errors later on +seurat_obj_receiver@meta.data$CMSMSItis[seurat_obj_receiver@meta.data$CMSMSItis == "CMS3"] = "Other" # because NA as name will result in errors later on +seurat_obj_receiver@meta.data$CMSMSItis[seurat_obj_receiver@meta.data$CMSMSItis == "Normal"] = "Other" # because NA as name will result in errors later on +table(seurat_obj_receiver@meta.data$CMSMSItis, seurat_obj_receiver@meta.data$TmajorScaled) +DimPlot(seurat_obj_receiver) +``` + +## Myeloid cells as receiver +```{r} +getwd() +seurat_obj_sender = readRDS("data/201111KULSMCallMyeloid.rds") +seurat_obj_sender@meta.data$FinalMyeloidLabel0.4 = seurat_obj_sender@meta.data$FinalMyeloidLabel0.4 %>% make.names() +seurat_obj_sender@meta.data$sample_ID = seurat_obj_sender@meta.data$sample_ID %>% toupper() +seurat_obj_sender = SetIdent(seurat_obj_sender, value = "FinalMyeloidLabel0.4") +good_samples = c("EXT001","EXT002","EXT003","EXT009","EXT010","EXT011","EXT012","EXT013","EXT031","EXT032","EXT048","EXT049","EXT050","EXT093","EXT094","EXT095","EXT097","EXT098","EXT099","EXT121","EXT122","EXT123","EXT127","EXT128","EXT129","PM0001N","PM0001T","PM0002N","PM0002T","PM0003T","PM0004N", "PM0004T","PM0005N","PM0005T","PM0010N","PM0010T","PM0011T","PM0014T","PM0016T","PM0017T","PM0018T","PM0019T","PM0020T","PM0021T","PM0022T","PM0023T","PM0024T","PM0025T","SMC0010T","SMC057T","SMC063T","SMC071T","SMC083T","SMC105T","SMC108T","SMC112T","SMC119T","SMC125T","SMC126T","SMC136T","SMC145T","SMC164T","SMC174T","SMC179T","SMC180T","SMC197T","SMC200T","SMC215T","SMC216T","SMC217T") +seurat_obj_sender = subset(seurat_obj_sender, subset = sample_ID %in% good_samples) +seurat_obj_sender@meta.data$msitis %>% table() +seurat_obj_sender@meta.data$CMSMSItis[seurat_obj_sender@meta.data$CMSMSItis == "MSS"] = "CMS_NA" # because NA as name will result in errors later on +# seurat_obj_sender@meta.data$FinalMyeloidLabel0.4[seurat_obj_sender@meta.data$FinalMyeloidLabel0.4 == "Pro.inflammatory.myeloid"] = "Monocytes" +# seurat_obj_sender@meta.data$FinalMyeloidLabel0.4[seurat_obj_sender@meta.data$FinalMyeloidLabel0.4 == "Migratory.DC"] = "cDC2" +seurat_obj_sender@meta.data$CMSMSItis[seurat_obj_sender@meta.data$CMSMSItis == "CMS_NA"] = "Other" # because NA as name will result in errors later on +seurat_obj_sender@meta.data$CMSMSItis[seurat_obj_sender@meta.data$CMSMSItis == "CMS1"] = "Other" # because NA as name will result in errors later on +seurat_obj_sender@meta.data$CMSMSItis[seurat_obj_sender@meta.data$CMSMSItis == "CMS3"] = "Other" # because NA as name will result in errors later on +seurat_obj_sender@meta.data$CMSMSItis[seurat_obj_sender@meta.data$CMSMSItis == "Normal"] = "Other" # because NA as name will result in errors later on +table(seurat_obj_sender@meta.data$CMSMSItis, seurat_obj_sender@meta.data$FinalMyeloidLabel0.4) +DimPlot(seurat_obj_sender) +``` + +# Step 2: Prepare the cell-cell communication analysis + +## Define senders and receivers of interest + +```{r} +senders_oi = c("Monocytes","cDC1","cDC2","Macrophages","CD3.myeloid.diverse","proliferating","Pro.inflammatory.myeloid","Migratory.DC","pDC") +receivers_oi = c("CD4","CD8") + +seurat_obj_sender = seurat_obj_sender %>% subset(idents = senders_oi) +seurat_obj_receiver = seurat_obj_receiver %>% subset(idents = receivers_oi) +``` + +## Define in which metadata columns we can find the group, sample and cell type IDs + +```{r} +sample_id = "sample_ID" +group_id = "CMSMSItis" +celltype_id_receiver = "TmajorScaled" +celltype_id_sender = "FinalMyeloidLabel0.4" +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +covariates = c("dataset") +contrasts_oi = c("'CMS4-(CMS2+MSI)/2','CMS2-(CMS4+MSI)/2','MSI-(CMS2+CMS4)/2'") +contrast_tbl = tibble(contrast = + c("CMS4-(CMS2+MSI)/2","CMS2-(CMS4+MSI)/2","MSI-(CMS2+CMS4)/2"), + group = c("CMS4","CMS2","MSI")) +min_cells = 10 + +``` + +## Define the parameters for the NicheNet ligand activity analysis + +```{r} +logFC_threshold = 0.33 +p_val_threshold = 0.05 +frac_cutoff = 0.05 +p_val_adj = FALSE +top_n_target = 500 +``` + + +## Define the weights of the prioritization of both expression, differential expression and NicheNet activity information + + +```{r} +prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0) +``` + +# Step 3: Perform the cell-cell communication analysis + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) + +``` + +```{r} +saveRDS(output, "output/ms_mg_nichenet_output") +``` + +# Step 4: Visualize the results of the cell-cell communication analysis + +## Visualization of scaled_LR_prod (average expression) and scaled_LR_frac (average fraction) per sample + +```{r} +group_oi = "MSI" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(75, prioritization_score) + +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +## Visualization of expression-logFC per group and ligand activity + +```{r} +receiver_oi = "CD4" +group_oi = "MSI" +``` + +```{r, fig.width=15, fig.height=12} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(100, prioritization_score) + +plot_oi = make_group_lfc_exprs_activity_plot(output$prioritization_tables, prioritized_tbl_oi, receiver_oi) +plot_oi + +``` + +## Circos plot of top-prioritized links + +```{r, fig.width=15, fig.height=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% group_by(group) %>% top_n(25, prioritization_score) + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(id %in% prioritized_tbl_oi$id) %>% + distinct(id, sender, receiver, ligand, receptor, group) %>% left_join(prioritized_tbl_oi) +prioritized_tbl_oi$prioritization_score[is.na(prioritized_tbl_oi$prioritization_score)] = 0 + + +n_senders = prioritized_tbl_oi$sender %>% unique() %>% length() +n_receivers = prioritized_tbl_oi$receiver %>% unique() %>% length() + +colors_sender = c("orange","tomato","red","violetred3", "orchid2","mediumpurple1","steelblue2", "royalblue") +# colors_sender = brewer.pal(8, "Spectral") +colors_receiver = c("limegreen","darkolivegreen2") + +circos_list = make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) + +``` + +## Single-cell-based Nebulosa, Feature, and Violin plots of ligand-receptor interaction of interest + +```{r} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score) %>% + group_by(group, receiver) %>% top_n(5, prioritization_score) +prioritized_tbl_oi +``` + +```{r} +ligand_oi = "TNFSF15" +receptor_oi = "TNFRSF25" +group_oi = "MSI" +sender_oi = "Pro.inflammatory.myeloid" +receiver_oi = "CD4" +``` + +```{r, fig.width=9, fig.height=7} +plot_list = make_ligand_receptor_nebulosa_feature_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi) +plot_list$nebulosa +plot_list$feature +``` + +```{r, fig.width=9, fig.height=7} +plot_list2 = make_ligand_receptor_violin_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi) +plot_list2$violin_group +plot_list2$violin_sample +``` + +## Visualization of ligand-activity, ligand-target links, and target gene expression + +```{r} +group_oi = "MSI" +receiver_oi = "CD4" +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor, activity_scaled) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% + group_by(group) %>% top_n(100, prioritization_score) %>% top_n(50, activity_scaled) %>% arrange(-activity_scaled) +``` + + +```{r, fig.width=16, fig.height=13} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$receiver_info) +combined_plot +``` + +## Make target gene violin and nebulosa plots + +```{r} +receiver_oi = "CD4" +group_oi = "MSI" + +output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(100, logFC) %>% top_n(5, max_frac) +``` + + +```{r, fig.width=14, fig.height=8} +target_oi = "CST7" + +make_target_violin_plot(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, output$prioritization_tables$group_prioritization_tbl) +make_target_nebulosa_feature_plot(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, output$prioritization_tables$group_prioritization_tbl) + +``` + +## Make Dotplot for all DE genes/targets + +```{r} +receiver_oi = "CD4" +group_oi = "MSI" + +targets_oi1 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% pull(gene) %>% unique() + +targets_oi2 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(100, -p_val) %>% top_n(50, logFC) %>% pull(gene) + +targets_oi = intersect(targets_oi1, targets_oi2) + +``` + +```{r, fig.width=12, fig.height=15} +p_target = make_sample_target_plots(output$receiver_info, targets_oi, receiver_oi, output$grouping_tbl %>% filter(group %in% c("CMS2","CMS4","MSI"))) +p_target +``` + +Example figure to demonstrate how to add covariates + +```{r} +p_covariate = output$grouping_tbl %>% filter(group %in% c("CMS2","CMS4","MSI")) %>% mutate(dataset_ = " Dataset ") %>% + ggplot(aes(sample, dataset_, fill = dataset)) + + geom_tile(color = "black") + + facet_grid(.~group, scales = "free", space = "free") + + scale_x_discrete(position = "top") + + theme_light() + + theme( + axis.ticks = element_blank(), + axis.title.x = element_text(size = 0), + axis.title.y = element_text(size = 0), + axis.text.y = element_text(face = "bold", size = 9), + axis.text.x = element_text(size = 9, angle = 90,hjust = 0), + strip.text.x.top = element_text(angle = 0), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.spacing.x = unit(2.5, "lines"), + panel.spacing.y = unit(0.25, "lines"), + strip.text.x = element_text(size = 11, color = "black", face = "bold"), + strip.text.y = element_text(size = 9, color = "black", face = "bold", angle = 0), + strip.background = element_rect(color="darkgrey", fill="whitesmoke", size=1.5, linetype="solid") + ) + scale_fill_brewer(palette = "Set2") +p_covariate +``` + +```{r, fig.width=12, fig.height=16} +plot = patchwork::wrap_plots(p_covariate, p_target, nrow = 2, heights = c(2,length(targets_oi)), guides = "collect") +plot +``` + + \ No newline at end of file diff --git a/vignettes/pipeline_ms_mg_nichenet_wrapper_test.Rmd b/vignettes/pipeline_ms_mg_nichenet_wrapper_test.Rmd new file mode 100644 index 0000000..e3941bb --- /dev/null +++ b/vignettes/pipeline_ms_mg_nichenet_wrapper_test.Rmd @@ -0,0 +1,545 @@ +--- +title: 'Multi-Group Multi-Sample Cell-Cell Communication Analysis via NicheNet: HNSCC + application' +author: "Robin Browaeys" +date: "5-2-2021" +output: html_document +--- + + +```{r setup, include = FALSE} +# knitr::opts_knit$set( +# collapse = TRUE, +# # comment = "#>", +# warning = FALSE, +# message = FALSE, +# # root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' +# root.dir = '../' +# +# ) +knitr::opts_knit$set(root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' ) + +``` + +In this analysis we will analyze differential cell-cell communication between different patient groups in colorectal cancer. + +# Step 0: Load packages and NicheNet ligand-receptor network and ligand-target matrix + +```{r} +library(Seurat) +library(BiocStyle) +library(Nebulosa) +library(cowplot) +library(tidyverse) +library(limma) +library(muscat) +library(ExperimentHub) +library(scater) +library(circlize) +library(RColorBrewer) +source("scripts/functions_muscat_de.R") +``` + +```{r} +# LR network +lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) +lr_network = lr_network %>% filter(! database %in% c("ppi_prediction","ppi_prediction_go")) +lr_network = lr_network %>% dplyr::rename(ligand = from, receptor = to) %>% distinct(ligand, receptor) +``` + +```{r} +ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) +``` + +# Step 1: Prepare Seurat Objects for Sender and Receiver cells + +## T cells as receiver + +Set the cell type label of interest as cell identity and keep only good samples. +In this analysis we are only interested in MSI, CMS2 and CMS4 patients, therefore we will pool all the other samples so that we don't remove cell types that have too few cells in patient groups that are not of interest to our comparison. + +```{r} +getwd() +seurat_obj_receiver = readRDS("data/seurat_obj_hnscc.rds") %>% subset(subset = celltype == "Malignant") +DimPlot(seurat_obj_receiver) +DimPlot(seurat_obj_receiver, group.by = "pEMT") +DimPlot(seurat_obj_receiver, group.by = "pEMT_fine") +``` + +## Myeloid cells as receiver +```{r} +getwd() +seurat_obj_sender = readRDS("data/seurat_obj_hnscc.rds") %>% subset(subset = celltype != "Malignant") +DimPlot(seurat_obj_sender) +DimPlot(seurat_obj_receiver, group.by = "pEMT") +DimPlot(seurat_obj_receiver, group.by = "pEMT_fine") +``` + +# Step 2: Prepare the cell-cell communication analysis + +## Define senders and receivers of interest + +```{r} +senders_oi = seurat_obj_sender %>% Idents() %>% unique() +# senders_oi = c("CAF","myofibroblast") +receivers_oi = seurat_obj_receiver %>% Idents() %>% unique() + +seurat_obj_sender = seurat_obj_sender %>% subset(idents = senders_oi) +seurat_obj_receiver = seurat_obj_receiver %>% subset(idents = receivers_oi) +``` + +## Define in which metadata columns we can find the group, sample and cell type IDs + +```{r} +sample_id = "tumor" +group_id = "pEMT" +celltype_id_receiver = "celltype" +celltype_id_sender = "celltype" +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +covariates = NA +contrasts_oi = c("'High-Low','Low-High'") +contrast_tbl = tibble(contrast = + c("High-Low","Low-High"), + group = c("High","Low")) +min_cells = 1 + +``` + +## Define the parameters for the NicheNet ligand activity analysis + +```{r} +logFC_threshold = 1 +p_val_threshold = 0.05 +frac_cutoff = 0.05 +p_val_adj = FALSE +top_n_target = 250 +``` + + +## Define the weights of the prioritization of both expression, differential expression and NicheNet activity information + + +```{r} +prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0) +``` + +# Step 3: Perform the cell-cell communication analysis + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) + +``` + +```{r} +saveRDS(output, "output/ms_mg_nichenet_output_hnscc_test") +``` + +# Step 4: Visualize the results of the cell-cell communication analysis + +## Visualization of scaled_LR_prod (average expression) and scaled_LR_frac (average fraction) per sample + +```{r} +group_oi = "High" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(75, prioritization_score) + +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +## Visualization of expression-logFC per group and ligand activity + +```{r} +receiver_oi = "Malignant" +group_oi = "High" +``` + +```{r, fig.width=15, fig.height=12} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(75, prioritization_score) + +plot_oi = make_group_lfc_exprs_activity_plot(output$prioritization_tables, prioritized_tbl_oi, receiver_oi) +plot_oi + +``` + +```{r, fig.width=15, fig.height=12} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(75, prioritization_score) + +plot_oi = make_group_lfc_exprs_activity_plot(output$prioritization_tables, prioritized_tbl_oi, receiver_oi, heights = c(10,1,1)) +plot_oi + +``` + +## Circos plot of top-prioritized links + +```{r, fig.width=15, fig.height=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% top_n(100, prioritization_score) + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(id %in% prioritized_tbl_oi$id) %>% + distinct(id, sender, receiver, ligand, receptor, group) %>% left_join(prioritized_tbl_oi) +prioritized_tbl_oi$prioritization_score[is.na(prioritized_tbl_oi$prioritization_score)] = 0 + + +n_senders = prioritized_tbl_oi$sender %>% unique() %>% length() +n_receivers = prioritized_tbl_oi$receiver %>% unique() %>% length() + + +colors_sender = c("tomato","violetred3", "mediumpurple1", "royalblue") +colors_receiver = c("darkolivegreen2") + +circos_list = make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) + +``` + +## Single-cell-based Nebulosa, Feature, and Violin plots of ligand-receptor interaction of interest + +```{r} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score) %>% + group_by(group, receiver) %>% top_n(5, prioritization_score) +``` + +```{r} +ligand_oi = "IL24" +receptor_oi = "IL20RB" +group_oi = "High" +sender_oi = "CAF" +receiver_oi = "Malignant" +``` + +```{r, fig.width=9, fig.height=7} +plot_list = make_ligand_receptor_nebulosa_feature_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi) +plot_list$nebulosa +plot_list$feature +``` + +```{r, fig.width=9, fig.height=7} +plot_list2 = make_ligand_receptor_violin_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi) +plot_list2$violin_group +plot_list2$violin_sample +``` + +## Visualization of ligand-activity, ligand-target links, and target gene expression + +```{r} +group_oi = "High" +receiver_oi = "Malignant" +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor, activity_scaled) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% + group_by(group) %>% top_n(100, prioritization_score) %>% top_n(50, activity_scaled) %>% arrange(-activity_scaled) +``` + + +```{r, fig.width=18, fig.height=10} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$receiver_info) +combined_plot +``` + + +```{r, fig.width=18, fig.height=10} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$receiver_info, plot_legend = FALSE) +combined_plot +``` + +```{r, fig.width=18, fig.height=10} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$receiver_info, plot_legend = FALSE, heights = c(1,1.2), widths = c(1,1,17)) +combined_plot +``` + +## Make target gene violin and nebulosa plots + +```{r} +receiver_oi = "Malignant" +group_oi = "High" + +output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(100, logFC) %>% top_n(5, max_frac) +``` + + +```{r, fig.width=10, fig.height=10} +target_oi = "CA2" + +make_target_violin_plot(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, output$prioritization_tables$group_prioritization_tbl) +make_target_nebulosa_feature_plot(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, output$prioritization_tables$group_prioritization_tbl) # erro? + +``` + +## Make Dotplot for all DE genes/targets + +```{r} +receiver_oi = "Malignant" +group_oi = "High" + +targets_oi1 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% pull(gene) %>% unique() + +targets_oi2 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(250, -p_val) %>% top_n(75, logFC) %>% pull(gene) + +targets_oi = intersect(targets_oi1, targets_oi2) + +``` + +```{r, fig.width=8, fig.height=15} +make_sample_target_plots(output$receiver_info, targets_oi, receiver_oi, output$grouping_tbl) +``` + + +## Show ligand activities for each receiver-group combination + +Both scaled and absolute activities. + +In combination with ligand-receptor expression per sample + + +```{r} +receiver_oi = "Malignant" +group_oi = "High" +``` + +```{r, fig.width=15, fig.height=12} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(75, prioritization_score) + +plot_oi = make_sample_lr_prod_activity_plots(output$prioritization_tables,prioritized_tbl_oi) +plot_oi +plot_oi +``` + +Both scaled and absolute activities. + +Without ligand-receptor expression per sample + +Show top ligands based on ligand activity (agnostic of expression in sender) + +```{r, fig.width=5, fig.height=8} + +ligands_oi = output$prioritization_tables$ligand_activities_target_de_tbl %>% inner_join(contrast_tbl) %>% + group_by(group, receiver) %>% distinct(ligand, receiver, group, activity) %>% + top_n(20, activity) %>% pull(ligand) %>% unique() + +plot_oi = make_ligand_activity_plots(output$prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +plot_oi + +``` +Show top ligands based on prioritization scores + +```{r, fig.width=5, fig.height=8} + +ligands_oi = output$prioritization_tables$group_prioritization_tbl %>% + group_by(group, receiver) %>% distinct(ligand, receiver, group, prioritization_score) %>% + top_n(25, prioritization_score) %>% pull(ligand) %>% unique() + +plot_oi = make_ligand_activity_plots(output$prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +plot_oi + +``` + +# Alternative analysis and demonstration of how to compare multiple groups in the contrasts + + +```{r} +group_id = "pEMT_fine" +contrasts_oi = c("'High-(Medium+Low)/2'") +contrast_tbl = tibble(contrast = + c("High-(Medium+Low)/2"), + group = c("High")) + +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) +``` + +```{r} +group_oi = "High" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(50, prioritization_score) + +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi + +output$prioritization_tables$sample_prioritization_tbl = output$prioritization_tables$sample_prioritization_tbl %>% mutate(group = factor(group, levels = c("High","Medium","Low"))) +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +Change the ordering of the groups: + +```{r, fig.height=18, fig.width=12} +output$prioritization_tables$sample_prioritization_tbl = output$prioritization_tables$sample_prioritization_tbl %>% mutate(group = factor(group, levels = c("High","Medium","Low"))) +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + + +```{r} +group_id = "pEMT_fine" +contrasts_oi = c("'High-Low'") +contrast_tbl = tibble(contrast = + c("High-Low"), + group = c("High")) +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) +``` + +```{r} +group_oi = "High" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(50) +output$prioritization_tables$sample_prioritization_tbl = output$prioritization_tables$sample_prioritization_tbl %>% mutate(group = factor(group, levels = c("High","Medium","Low"))) +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +```{r} +group_id = "pEMT_fine" +contrasts_oi = c("'(High+Medium)/2-Low'") +contrast_tbl = tibble(contrast = + c("(High+Medium)/2-Low"), + group = c("High")) + +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) +``` + +```{r} +group_oi = "High" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(50) +output$prioritization_tables$sample_prioritization_tbl = output$prioritization_tables$sample_prioritization_tbl %>% mutate(group = factor(group, levels = c("High","Medium","Low"))) +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +# Additional analysis: unsupervised analysis of patients based on ligand-receptor expression product + +PCA on ligand-receptor expression product values + +```{r} +library(factoextra) + +lr_prod_mat_pca = prcomp(output$lr_prod_mat, center = TRUE,scale. = TRUE) + +res_ind = get_pca_ind(lr_prod_mat_pca) +head(res_ind$coord) +head(res_ind$contrib ) + +var_info = get_pca_var(lr_prod_mat_pca) +head(var_info$contrib) + +var_info$contrib[,1] %>% sort(decreasing = T) %>% head(10) +var_info$contrib[,2] %>% sort(decreasing = T) %>% head(10) +var_info$contrib[,3] %>% sort(decreasing = T) %>% head(10) + +res_ind$coord %>% data.frame() %>% rownames_to_column("sample") %>% as_tibble() %>% inner_join(output$grouping_tbl) %>% + ggplot(aes(Dim.1, Dim.2, color = group)) + + geom_point(size = 4) + theme_bw() + scale_colour_brewer(palette = "Paired") + +``` + +Check the most important PCs to predict the patient group + +```{r} +rf_randomForest = randomForest::randomForest(group~., data = res_ind$coord %>% data.frame() %>% rownames_to_column("sample") %>% as_tibble() %>% inner_join(output$grouping_tbl) %>% select(-sample) %>% mutate(group = factor(group, levels = c("High","Medium","Low"))), ntree = 1000, importance = TRUE, do.trace=F) +randomForest::varImpPlot(rf_randomForest) +``` + +```{r} +res_ind$coord %>% data.frame() %>% rownames_to_column("sample") %>% as_tibble() %>% inner_join(output$grouping_tbl) %>% + ggplot(aes(Dim.1, Dim.10, color = group)) + + geom_point(size = 4) + theme_bw() + scale_colour_brewer(palette = "Dark2") +res_ind$coord %>% data.frame() %>% rownames_to_column("sample") %>% as_tibble() %>% inner_join(output$grouping_tbl) %>% + ggplot(aes(Dim.1, Dim.6, color = group)) + + geom_point(size = 4) + theme_bw() + scale_colour_brewer(palette = "Dark2") +var_info$contrib[,1] %>% sort(decreasing = T) %>% head(10) +var_info$contrib[,10] %>% sort(decreasing = T) %>% head(10) +var_info$contrib[,6] %>% sort(decreasing = T) %>% head(10) + +``` + +References: + +XXXX \ No newline at end of file diff --git a/vignettes/pipeline_ms_mg_nichenet_wrapper_test_allVSall.Rmd b/vignettes/pipeline_ms_mg_nichenet_wrapper_test_allVSall.Rmd new file mode 100644 index 0000000..85edfdf --- /dev/null +++ b/vignettes/pipeline_ms_mg_nichenet_wrapper_test_allVSall.Rmd @@ -0,0 +1,263 @@ +--- +title: 'Multi-Group Multi-Sample Cell-Cell Communication analysis via NicheNet: HNSCC + application - all-vs-all' +author: "Robin Browaeys" +date: "9-2-2021" +output: html_document +--- + +```{r setup, include = FALSE} +# knitr::opts_knit$set( +# collapse = TRUE, +# # comment = "#>", +# warning = FALSE, +# message = FALSE, +# # root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' +# root.dir = '../' +# +# ) +knitr::opts_knit$set(root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' ) + +``` + +In this analysis we will analyze differential cell-cell communication between different patient groups in colorectal cancer. In contrast to the other vignette, this vignette will show how to do an all-vs-all analysis in which you consider all cell types of interest as possible senders and receivers. + +# Step 0: Load packages and NicheNet ligand-receptor network and ligand-target matrix + +```{r} +library(Seurat) +library(BiocStyle) +library(Nebulosa) +library(cowplot) +library(tidyverse) +library(limma) +library(muscat) +library(ExperimentHub) +library(scater) +library(circlize) +library(RColorBrewer) +source("scripts/functions_muscat_de.R") +``` + +```{r} +# LR network +lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) +lr_network = lr_network %>% filter(! database %in% c("ppi_prediction","ppi_prediction_go")) +lr_network = lr_network %>% dplyr::rename(ligand = from, receptor = to) %>% distinct(ligand, receptor) +``` + +```{r} +ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) +``` + +# Step 1: Prepare Seurat Objects for Sender and Receiver cells + + +```{r} +getwd() +seurat_obj = readRDS("data/seurat_obj_hnscc.rds") +DimPlot(seurat_obj) +DimPlot(seurat_obj, group.by = "pEMT") +DimPlot(seurat_obj, group.by = "pEMT_fine") +``` + +# Step 2: Prepare the cell-cell communication analysis + + +## Define in which metadata columns we can find the group, sample and cell type IDs + +```{r} +sample_id = "tumor" +group_id = "pEMT" +celltype_id = "celltype" +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +covariates = NA +contrasts_oi = c("'High-Low','Low-High'") +contrast_tbl = tibble(contrast = + c("High-Low","Low-High"), + group = c("High","Low")) +min_cells = 1 + +``` + +## Define the parameters for the NicheNet ligand activity analysis + +```{r} +logFC_threshold = 1 +p_val_threshold = 0.05 +frac_cutoff = 0.05 +p_val_adj = FALSE +top_n_target = 250 +``` + + +## Define the weights of the prioritization of both expression, differential expression and NicheNet activity information + + +```{r} +prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0) +``` + +# Step 3: Perform the cell-cell communication analysis + +sender_receiver_separate = FALSE: to demonstrate that our senders and receivers are in the same object + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj = seurat_obj, celltype_id = celltype_id, sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target, sender_receiver_separate = FALSE) + +``` + +# Step 4: Visualize the results of the cell-cell communication analysis + +## Visualization of scaled_LR_prod (average expression) and scaled_LR_frac (average fraction) per sample + +```{r} +group_oi = "High" +``` + +```{r, fig.height=18, fig.width=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(75, prioritization_score) + +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +## Visualization of expression-logFC per group and ligand activity + +```{r} +receiver_oi = "Malignant" +group_oi = "High" +``` + +```{r, fig.width=15, fig.height=12} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(75, prioritization_score) + +plot_oi = make_group_lfc_exprs_activity_plot(output$prioritization_tables, prioritized_tbl_oi, receiver_oi) +plot_oi + +``` + + +## Circos plot of top-prioritized links + +```{r, fig.width=15, fig.height=12} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% top_n(100, prioritization_score) + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(id %in% prioritized_tbl_oi$id) %>% + distinct(id, sender, receiver, ligand, receptor, group) %>% left_join(prioritized_tbl_oi) +prioritized_tbl_oi$prioritization_score[is.na(prioritized_tbl_oi$prioritization_score)] = 0 + + +n_senders = prioritized_tbl_oi$sender %>% unique() %>% length() +n_receivers = prioritized_tbl_oi$receiver %>% unique() %>% length() + + +colors_sender = c("red","tomato","violetred3", "mediumpurple1", "royalblue") +colors_receiver = c("darkolivegreen1", "darkolivegreen2", "darkolivegreen3", "lawngreen", "limegreen") + +circos_list = make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) + +``` + +## Visualization of ligand-activity, ligand-target links, and target gene expression + +```{r} +group_oi = "High" +receiver_oi = "Myeloid" +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor, activity_scaled) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% + group_by(group) %>% top_n(50, prioritization_score) %>% top_n(25, activity_scaled) %>% arrange(-activity_scaled) +``` + +```{r, fig.width=18, fig.height=10} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$celltype_info, plot_legend = FALSE) +combined_plot +``` +## Show ligand activities for each receiver-group combination + + + +Both scaled and absolute activities. + +In combination with ligand-receptor expression per sample + + +```{r} +group_oi = "High" +``` + +```{r, fig.width=20, fig.height=22} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% top_n(250, prioritization_score) %>% group_by(receiver) %>% top_n(10) + +plot_oi = make_sample_lr_prod_activity_plots(output$prioritization_tables,prioritized_tbl_oi, widths = c(8,2,2)) +plot_oi +plot_oi +``` + +Both scaled and absolute activities. + +Without ligand-receptor expression per sample + +Show top ligands based on ligand activity (agnostic of expression in sender) + +```{r, fig.width=5, fig.height=8} + +ligands_oi = output$prioritization_tables$ligand_activities_target_de_tbl %>% inner_join(contrast_tbl) %>% + group_by(group, receiver) %>% distinct(ligand, receiver, group, activity) %>% + top_n(5, activity) %>% pull(ligand) %>% unique() + +plot_oi = make_ligand_activity_plots(output$prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +plot_oi + +``` +Show top ligands based on prioritization scores + +```{r, fig.width=5, fig.height=8} + +ligands_oi = output$prioritization_tables$group_prioritization_tbl %>% + group_by(group, receiver) %>% distinct(ligand, receiver, group, prioritization_score) %>% + top_n(5, prioritization_score) %>% pull(ligand) %>% unique() + +plot_oi = make_ligand_activity_plots(output$prioritization_tables, ligands_oi, contrast_tbl, widths = NULL) +plot_oi + +``` diff --git a/vignettes/pipeline_ms_mg_nichenet_wrapper_test_lite.Rmd b/vignettes/pipeline_ms_mg_nichenet_wrapper_test_lite.Rmd new file mode 100644 index 0000000..9d9aa36 --- /dev/null +++ b/vignettes/pipeline_ms_mg_nichenet_wrapper_test_lite.Rmd @@ -0,0 +1,299 @@ +--- +title: 'Multi-Group Multi-Sample Cell-Cell Communication Analysis via NicheNet: HNSCC + application' +author: "Robin Browaeys" +date: "5-2-2021" +output: html_document +--- + + +```{r setup, include = FALSE} +# knitr::opts_knit$set( +# collapse = TRUE, +# # comment = "#>", +# warning = FALSE, +# message = FALSE, +# # root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' +# root.dir = '../' +# +# ) +knitr::opts_knit$set(root.dir = 'C:/Users/rbrowaey/work/Research/NicheNet/current_projects/CRC_NicheNet' ) + +``` + +In this analysis we will analyze differential cell-cell communication between different patient groups in colorectal cancer. + +# Step 0: Load packages and NicheNet ligand-receptor network and ligand-target matrix + +```{r} +library(Seurat) +library(BiocStyle) +library(Nebulosa) +library(cowplot) +library(tidyverse) +library(limma) +library(muscat) +library(ExperimentHub) +library(scater) +library(circlize) +library(RColorBrewer) +source("scripts/functions_muscat_de.R") +``` + +```{r} +# LR network +lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds")) +lr_network = lr_network %>% filter(! database %in% c("ppi_prediction","ppi_prediction_go")) +lr_network = lr_network %>% dplyr::rename(ligand = from, receptor = to) %>% distinct(ligand, receptor) +``` + +```{r} +ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds")) +``` + +# Step 1: Prepare Seurat Objects for Sender and Receiver cells + +## T cells as receiver + +Set the cell type label of interest as cell identity and keep only good samples. +In this analysis we are only interested in MSI, CMS2 and CMS4 patients, therefore we will pool all the other samples so that we don't remove cell types that have too few cells in patient groups that are not of interest to our comparison. + +```{r} +getwd() +seurat_obj_receiver = readRDS("data/seurat_obj_lite_hnscc.rds") %>% subset(subset = celltype == "Malignant") +DimPlot(seurat_obj_receiver) +``` + +## Myeloid cells as receiver +```{r} +getwd() +seurat_obj_sender = readRDS("data/seurat_obj_lite_hnscc.rds") %>% subset(subset = celltype != "Malignant") +DimPlot(seurat_obj_sender) +``` + +# Step 2: Prepare the cell-cell communication analysis + +## Define senders and receivers of interest + +```{r} +senders_oi = seurat_obj_sender %>% Idents() %>% unique() +# senders_oi = c("CAF","myofibroblast") +receivers_oi = seurat_obj_receiver %>% Idents() %>% unique() + +seurat_obj_sender = seurat_obj_sender %>% subset(idents = senders_oi) +seurat_obj_receiver = seurat_obj_receiver %>% subset(idents = receivers_oi) +``` + +## Define in which metadata columns we can find the group, sample and cell type IDs + +```{r} +sample_id = "tumor" +group_id = "pEMT" +celltype_id_receiver = "celltype" +celltype_id_sender = "celltype" +``` + +## Define the contrasts and covariates of interest for the DE analysis, and the minimal number of cells of a cell type that each sample should have. + +```{r} +covariates = NA +contrasts_oi = c("'High-Low','Low-High'") +contrast_tbl = tibble(contrast = + c("High-Low","Low-High"), + group = c("High","Low")) +min_cells = 1 + +``` + +## Define the parameters for the NicheNet ligand activity analysis + +```{r} +logFC_threshold = 1 +p_val_threshold = 0.05 +frac_cutoff = 0.05 +p_val_adj = FALSE +top_n_target = 250 +``` + + +## Define the weights of the prioritization of both expression, differential expression and NicheNet activity information + + +```{r} +prioritizing_weights = c("scaled_lfc_ligand" = 1, + "scaled_p_val_ligand" = 1, + "scaled_lfc_receptor" = 1, + "scaled_p_val_receptor" = 1, + "scaled_activity_scaled" = 1.5, + "scaled_activity" = 0.5, + "scaled_avg_exprs_ligand" = 1, + "scaled_avg_frq_ligand" = 1, + "scaled_avg_exprs_receptor" = 1, + "scaled_avg_frq_receptor" = 1, + "fraction_expressing_ligand_receptor" = 1, + "scaled_abundance_sender" = 0, + "scaled_abundance_receiver" = 0) +``` + +# Step 3: Perform the cell-cell communication analysis + +```{r} +output = ms_mg_nichenet_analysis(seurat_obj_receiver = seurat_obj_receiver, seurat_obj_sender = seurat_obj_sender, + celltype_id_receiver = celltype_id_receiver, celltype_id_sender = celltype_id_sender,sample_id = sample_id, group_id = group_id, + lr_network = lr_network, ligand_target_matrix = ligand_target_matrix, contrasts_oi = contrasts_oi, contrast_tbl = contrast_tbl, + prioritizing_weights = prioritizing_weights, min_cells = min_cells, logFC_threshold = logFC_threshold, p_val_threshold = p_val_threshold, + frac_cutoff = frac_cutoff, p_val_adj = p_val_adj, top_n_target = top_n_target) + +``` + +```{r} +saveRDS(output, "output/ms_mg_nichenet_output_hnscc_test_lite") +``` + +# Step 4: Visualize the results of the cell-cell communication analysis + +## Visualization of scaled_LR_prod (average expression) and scaled_LR_frac (average fraction) per sample + +```{r} +group_oi = "High" +``` + +```{r, fig.height=7, fig.width=8} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_expressing_ligand_receptor, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi) %>% group_by(group) %>% top_n(50, prioritization_score) + +plot_oi = make_sample_lr_prod_plots(output$prioritization_tables, prioritized_tbl_oi) +plot_oi +``` + +## Visualization of expression-logFC per group and ligand activity + +```{r} +receiver_oi = "Malignant" +group_oi = "High" +``` + +```{r, fig.width=9, fig.height=7} + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, lr_interaction, group, ligand_receptor_lfc_avg, activity_scaled, fraction_ligand_group, fraction_expressing_ligand_receptor, scaled_avg_exprs_ligand, prioritization_score) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% top_n(50, prioritization_score) + +plot_oi = make_group_lfc_exprs_activity_plot(output$prioritization_tables, prioritized_tbl_oi, receiver_oi) +plot_oi + +``` + +## Circos plot of top-prioritized links + +```{r, fig.width=13, fig.height=11} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% top_n(50, prioritization_score) + +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(id %in% prioritized_tbl_oi$id) %>% + distinct(id, sender, receiver, ligand, receptor, group) %>% left_join(prioritized_tbl_oi) +prioritized_tbl_oi$prioritization_score[is.na(prioritized_tbl_oi$prioritization_score)] = 0 + + +n_senders = prioritized_tbl_oi$sender %>% unique() %>% length() +n_receivers = prioritized_tbl_oi$receiver %>% unique() %>% length() + + +colors_sender = c("royalblue") +colors_receiver = c("darkolivegreen2") + +circos_list = make_circos_group_comparison(prioritized_tbl_oi, colors_sender, colors_receiver) + +``` + +## Single-cell-based Nebulosa, Feature, and Violin plots of ligand-receptor interaction of interest + +```{r} +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score) %>% + group_by(group, receiver) %>% top_n(5, prioritization_score) +prioritized_tbl_oi +``` + +```{r} +ligand_oi = "TNFSF10" +receptor_oi = "TNFRSF10B" +group_oi = "High" +sender_oi = "CAF" +receiver_oi = "Malignant" +``` + +```{r, fig.width=9, fig.height=7} +plot_list = make_ligand_receptor_nebulosa_feature_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, group_oi, group_id, celltype_id_sender, celltype_id_receiver, senders_oi, receivers_oi, prioritized_tbl_oi) +plot_list$nebulosa +plot_list$feature +``` + +```{r, fig.width=9, fig.height=7} +plot_list2 = make_ligand_receptor_violin_plot(seurat_obj_sender, seurat_obj_receiver, ligand_oi, receptor_oi, sender_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_sender, celltype_id_receiver, prioritized_tbl_oi) +plot_list2$violin_group +plot_list2$violin_sample +``` + +## Visualization of ligand-activity, ligand-target links, and target gene expression + +```{r} +group_oi = "High" +receiver_oi = "Malignant" +prioritized_tbl_oi = output$prioritization_tables$group_prioritization_tbl %>% + filter(fraction_ligand_group > frac_cutoff & fraction_receptor_group > frac_cutoff) %>% + distinct(id, sender, receiver, ligand, receptor, group, prioritization_score, ligand_receptor_lfc_avg, fraction_expressing_ligand_receptor, activity_scaled) %>% + filter(ligand_receptor_lfc_avg > 0 & fraction_expressing_ligand_receptor > 0) %>% + filter(group == group_oi & receiver == receiver_oi) %>% + group_by(group) %>% top_n(100, prioritization_score) %>% top_n(50, activity_scaled) %>% arrange(-activity_scaled) +``` + + +```{r, fig.width=18, fig.height=10} +combined_plot = make_ligand_activity_target_plot(group_oi, receiver_oi, prioritized_tbl_oi, output$ligand_activities_targets_DEgenes, contrast_tbl, output$grouping_tbl, output$receiver_info) +combined_plot +``` + +## Make target gene violin and nebulosa plots + +```{r} +receiver_oi = "Malignant" +group_oi = "High" + +output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(100, logFC) %>% top_n(5, max_frac) +``` + + +```{r, fig.width=10, fig.height=10} +target_oi = "CAV1" + +make_target_violin_plot(seurat_obj_receiver, target_oi, receiver_oi, group_oi, group_id, sample_id, celltype_id_receiver, output$prioritization_tables$group_prioritization_tbl) +make_target_nebulosa_feature_plot(seurat_obj_receiver, target_oi, group_oi, group_id, celltype_id_receiver, receivers_oi, output$prioritization_tables$group_prioritization_tbl) # erro? + +``` + +## Make Dotplot for all DE genes/targets + +```{r} +receiver_oi = "Malignant" +group_oi = "High" + +targets_oi1 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% pull(gene) %>% unique() + +targets_oi2 = output$ligand_activities_targets_DEgenes$de_genes_df %>% inner_join(contrast_tbl) %>% filter(group == group_oi) %>% arrange(p_val) %>% filter(receiver == receiver_oi) %>% top_n(250, -p_val) %>% top_n(75, logFC) %>% pull(gene) + +targets_oi = intersect(targets_oi1, targets_oi2) + +``` + +```{r, fig.width=8, fig.height=15} +make_sample_target_plots(output$receiver_info, targets_oi, receiver_oi, output$grouping_tbl) +``` \ No newline at end of file