[
  {
    "path": ".Rbuildignore",
    "content": "^.*\\.Rproj$\n^\\.Rproj\\.user$\n^_pkgdown\\.yml$\n^docs$\n^pkgdown$\n"
  },
  {
    "path": ".github/workflows/check-bioc.yml",
    "content": "## Read more about GitHub actions the features of this GitHub Actions workflow\n## at https://lcolladotor.github.io/biocthis/articles/biocthis.html#use_bioc_github_action\n##\n## For more details, check the biocthis developer notes vignette at\n## https://lcolladotor.github.io/biocthis/articles/biocthis_dev_notes.html\n##\n## You can add this workflow to other packages using:\n## > biocthis::use_bioc_github_action()\n##\n## Using GitHub Actions exposes you to many details about how R packages are\n## compiled and installed in several operating system.s\n### If you need help, please follow the steps listed at\n## https://github.com/r-lib/actions#where-to-find-help\n##\n## If you found an issue specific to biocthis's GHA workflow, please report it\n## with the information that will make it easier for others to help you.\n## Thank you!\n\n## Acronyms:\n## * GHA: GitHub Action\n## * OS: operating system\n\non:\n  push:\n  pull_request:\n\nname: R-CMD-check-bioc\n\n## These environment variables control whether to run GHA code later on that is\n## specific to testthat, covr, and pkgdown.\n##\n## If you need to clear the cache of packages, update the number inside\n## cache-version as discussed at https://github.com/r-lib/actions/issues/86.\n## Note that you can always run a GHA test without the cache by using the word\n## \"/nocache\" in the commit message.\nenv:\n  has_testthat: 'true'\n  run_covr: 'true'\n  run_pkgdown: 'true'\n  has_RUnit: 'false'\n  cache-version: 'cache-v1'\n  run_docker: 'false'\n\njobs:\n  build-check:\n    runs-on: ${{ matrix.config.os }}\n    name: ${{ matrix.config.os }} (${{ matrix.config.r }})\n    container: ${{ matrix.config.cont }}\n    ## Environment variables unique to this job.\n\n    strategy:\n      fail-fast: false\n      matrix:\n        config:\n          - { os: ubuntu-latest, r: '4.1', bioc: '3.14', cont: \"bioconductor/bioconductor_docker:RELEASE_3_14\", rspm: \"https://packagemanager.rstudio.com/cran/__linux__/focal/latest\" }\n          - { os: ubuntu-latest, r: '4.2', bioc: '3.15', cont: \"bioconductor/bioconductor_docker:devel\", rspm: \"https://packagemanager.rstudio.com/cran/__linux__/focal/latest\" }\n          - { os: macOS-latest, r: '4.1', bioc: '3.14'}\n          # - { os: macOS-latest, r: '4.2', bioc: '3.15'}\n          - { os: windows-latest, r: '4.1', bioc: '3.14'}\n          # - { os: windows-latest, r: '4.2', bioc: '3.15'}\n          ## Check https://github.com/r-lib/actions/tree/bioc/examples\n          ## for examples using the http-user-agent\n    env:\n      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true\n      RSPM: ${{ matrix.config.rspm }}\n      NOT_CRAN: true\n      TZ: UTC\n      GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}\n      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}\n\n    steps:\n\n      ## Set the R library to the directory matching the\n      ## R packages cache step further below when running on Docker (Linux).\n      - name: Set R Library home on Linux\n        if: runner.os == 'Linux'\n        run: |\n          mkdir /__w/_temp/Library\n          echo \".libPaths('/__w/_temp/Library')\" > ~/.Rprofile\n\n      ## Most of these steps are the same as the ones in\n      ## https://github.com/r-lib/actions/blob/bioc/examples/check-standard.yaml\n      ## If they update their steps, we will also need to update ours.\n      - name: Checkout Repository\n        uses: actions/checkout@v2\n\n      ## R is already included in the Bioconductor docker images\n      - name: Setup R from r-lib\n        if: runner.os != 'Linux'\n        uses: r-lib/actions/setup-r@master\n        with:\n          r-version: ${{ matrix.config.r }}\n          http-user-agent: ${{ matrix.config.http-user-agent }}\n\n      ## pandoc is already included in the Bioconductor docker images\n      - name: Setup pandoc from r-lib\n        if: runner.os != 'Linux'\n        uses: r-lib/actions/setup-pandoc@master\n\n      - name: Query dependencies\n        run: |\n          install.packages('remotes')\n          saveRDS(remotes::dev_package_deps(dependencies = TRUE), \".github/depends.Rds\", version = 2)\n        shell: Rscript {0}\n\n      - name: Restore R package cache\n        if: \"!contains(github.event.head_commit.message, '/nocache') && runner.os != 'Linux'\"\n        uses: actions/cache@v2\n        with:\n          path: ${{ env.R_LIBS_USER }}\n          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_14-r-4.1-${{ hashFiles('.github/depends.Rds') }}\n          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_14-r-4.1-\n\n      - name: Cache R packages on Linux\n        if: \"!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' \"\n        uses: actions/cache@v2\n        with:\n          path: /home/runner/work/_temp/Library\n          key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_14-r-4.1-${{ hashFiles('.github/depends.Rds') }}\n          restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_14-r-4.1-\n\n      - name: Install Linux system dependencies\n        if: runner.os == 'Linux'\n        run: |\n          sysreqs=$(Rscript -e 'cat(\"apt-get update -y && apt-get install -y\", paste(gsub(\"apt-get install -y \", \"\", remotes::system_requirements(\"ubuntu\", \"20.04\")), collapse = \" \"))')\n          echo $sysreqs\n          sudo -s eval \"$sysreqs\"\n\n      - name: Install macOS system dependencies\n        if: matrix.config.os == 'macOS-latest'\n        run: |\n          ## Enable installing XML from source if needed\n          brew install libxml2\n          echo \"XML_CONFIG=/usr/local/opt/libxml2/bin/xml2-config\" >> $GITHUB_ENV\n\n          ## Required to install magick as noted at\n          ## https://github.com/r-lib/usethis/commit/f1f1e0d10c1ebc75fd4c18fa7e2de4551fd9978f#diff-9bfee71065492f63457918efcd912cf2\n          brew install imagemagick@6\n\n          ## For textshaping, required by ragg, and required by pkgdown\n          brew install harfbuzz fribidi\n\n          ## For installing usethis's dependency gert\n          brew install libgit2\n\n          ## Required for tcltk\n          brew install xquartz --cask\n\n      - name: Install Windows system dependencies\n        if: runner.os == 'Windows'\n        run: |\n          ## Edit below if you have any Windows system dependencies\n        shell: Rscript {0}\n\n      - name: Install BiocManager\n        run: |\n          message(paste('****', Sys.time(), 'installing BiocManager ****'))\n          remotes::install_cran(\"BiocManager\")\n        shell: Rscript {0}\n\n      - name: Set BiocVersion\n        run: |\n          BiocManager::install(version = \"${{ matrix.config.bioc }}\", ask = FALSE, force = TRUE)\n        shell: Rscript {0}\n\n      - name: Install dependencies pass 1\n        run: |\n          ## Try installing the package dependencies in steps. First the local\n          ## dependencies, then any remaining dependencies to avoid the\n          ## issues described at\n          ## https://stat.ethz.ch/pipermail/bioc-devel/2020-April/016675.html\n          ## https://github.com/r-lib/remotes/issues/296\n          ## Ideally, all dependencies should get installed in the first pass.\n          ## First install basic packages\n          install.packages(c(\"knitr\", \"rmarkdown\", \"devtools\", \"sessioninfo\"))\n          ## Next install Imports from CRAN\n          install.packages(c(\"ggplot2\" \"Matrix\", \"matrixStats\",\n          \"nnls\", \"SeuratObject\"))\n          ## Next install adjacent dependencies\n          install.packages(c( \"ggcorrplot\", \"grid\", \"igraph\", \"jpeg\", \"methods\",\n          \"png\", \"scater\", \"scatterpie\", \"Seurat\"))\n          ## Next Bioconductor packages\n          BiocManager::install(c( \"BiocStyle\", \"SummarizedExperiment\",\n          \"SingleCellExperiment\", \"ExperimentHub\", \"scran\",\n          \"TENxVisiumData\", \"TabulaMurisSenisData\", \"SpatialExperiment\"))\n          ## Github packages\n          suppressWarnings(devtools::install_github(\"satijalab/seurat-data\"))\n          ## Set the repos source depending on the OS\n          ## Alternatively use https://storage.googleapis.com/bioconductor_docker/packages/\n          ## though based on https://bit.ly/bioc2021-package-binaries\n          ## the Azure link will be the main one going forward.\n          gha_repos <- if(\n              .Platform$OS.type == \"unix\" && Sys.info()[\"sysname\"] != \"Darwin\"\n          ) c(\n              \"AnVIL\" = \"https://bioconductordocker.blob.core.windows.net/packages/3.14/bioc\",\n              BiocManager::repositories()\n              ) else BiocManager::repositories()\n\n          ## For running the checks\n          message(paste('****', Sys.time(), 'installing rcmdcheck and BiocCheck ****'))\n          install.packages(\"rcmdcheck\", repos = gha_repos)\n          BiocManager::install(\"BiocCheck\")\n\n          ## Pass #1 at installing dependencies\n          ## This pass uses AnVIL-powered fast binaries\n          ## details at https://github.com/nturaga/bioc2021-bioconductor-binaries\n          ## The speed gains only apply to the docker builds.\n          message(paste('****', Sys.time(), 'pass number 1 at installing dependencies: local dependencies ****'))\n          remotes::install_local(dependencies = TRUE, repos = gha_repos, build_vignettes = FALSE, upgrade = TRUE)\n        continue-on-error: true\n        shell: Rscript {0}\n\n      - name: Install dependencies pass 2\n        run: |\n          ## Pass #2 at installing dependencies\n          ## This pass does not use AnVIL and will thus update any packages\n          ## that have seen been updated in Bioconductor\n          message(paste('****', Sys.time(), 'pass number 2 at installing dependencies: any remaining dependencies ****'))\n          remotes::install_local(dependencies = TRUE, repos = BiocManager::repositories(), build_vignettes = TRUE, upgrade = TRUE, force = TRUE)\n        shell: Rscript {0}\n\n      - name: Install BiocGenerics\n        if:  env.has_RUnit == 'true'\n        run: |\n          ## Install BiocGenerics\n          BiocManager::install(\"BiocGenerics\")\n        shell: Rscript {0}\n\n      - name: Install covr\n        if: github.ref == 'refs/heads/main' && env.run_covr == 'true' && runner.os == 'Linux'\n        run: |\n          remotes::install_cran(\"covr\")\n        shell: Rscript {0}\n\n      - name: Install pkgdown\n        if: github.ref == 'refs/heads/main' && env.run_pkgdown == 'true' && runner.os == 'Linux'\n        run: |\n          remotes::install_cran(\"pkgdown\")\n        shell: Rscript {0}\n\n      - name: Session info\n        run: |\n          options(width = 100)\n          pkgs <- installed.packages()[, \"Package\"]\n          sessioninfo::session_info(pkgs, include_base = TRUE)\n        shell: Rscript {0}\n\n      - name: Run CMD check\n        env:\n          _R_CHECK_CRAN_INCOMING_: false\n          DISPLAY: 99.0\n        run: |\n          options(crayon.enabled = TRUE)\n          rcmdcheck::rcmdcheck(\n              args = c(\"--no-manual\", \"--no-vignettes\", \"--timings\"),\n              build_args = c(\"--no-manual\", \"--keep-empty-dirs\", \"--no-resave-data\"),\n              error_on = \"warning\",\n              check_dir = \"check\"\n          )\n        shell: Rscript {0}\n\n      ## Might need an to add this to the if:  && runner.os == 'Linux'\n      - name: Reveal testthat details\n        if:  env.has_testthat == 'true'\n        run: find . -name testthat.Rout -exec cat '{}' ';'\n\n      - name: Run RUnit tests\n        if:  env.has_RUnit == 'true'\n        run: |\n          BiocGenerics:::testPackage()\n        shell: Rscript {0}\n\n      - name: Run BiocCheck\n        env:\n          DISPLAY: 99.0\n        run: |\n          BiocCheck::BiocCheck(\n              dir('check', 'tar.gz$', full.names = TRUE),\n              `quit-with-status` = TRUE,\n              `no-check-R-ver` = TRUE,\n              `no-check-bioc-help` = TRUE\n              # `no-check-pkg-size` = TRUE\n          ) \n              \n        shell: Rscript {0}\n\n      - name: Test coverage\n\n        if: github.ref == 'refs/heads/main' && env.run_covr == 'true' && runner.os == 'Linux'\n        run: |\n          covr::codecov()\n        shell: Rscript {0}\n\n      - name: Install package\n        if: github.ref == 'refs/heads/main' && env.run_pkgdown == 'true' && runner.os == 'Linux'\n        run: R CMD INSTALL .\n\n      - name: Build and deploy pkgdown site\n        if: github.ref == 'refs/heads/main' && env.run_pkgdown == 'true' && runner.os == 'Linux'\n        run: |\n          git config --local user.name \"$GITHUB_ACTOR\"\n          git config --local user.email \"$GITHUB_ACTOR@users.noreply.github.com\"\n          Rscript -e \"pkgdown::deploy_to_branch(new_process = FALSE)\"\n        shell: bash {0}\n        ## Note that you need to run pkgdown::deploy_to_branch(new_process = FALSE)\n        ## at least one locally before this will work. This creates the gh-pages\n        ## branch (erasing anything you haven't version controlled!) and\n        ## makes the git history recognizable by pkgdown.\n\n      - name: Upload check results\n        if: failure()\n        uses: actions/upload-artifact@master\n        with:\n          name: ${{ runner.os }}-biocversion-RELEASE_3_14-r-4.1-results\n          path: check\n\n      - uses: docker/build-push-action@v1\n        if: \"!contains(github.event.head_commit.message, '/nodocker') && env.run_docker == 'true' && runner.os == 'Linux' \"\n        with:\n          username: ${{ secrets.DOCKER_USERNAME }}\n          password: ${{ secrets.DOCKER_PASSWORD }}\n          repository: marcelosua/spotlight\n          tag_with_ref: true\n          tag_with_sha: true\n          tags: latest\n\n\n\n"
  },
  {
    "path": ".gitignore",
    "content": ".Rproj.user\n*.Rproj\n.git/\n.DS_Store\n.Rhistory\n.RData\n.Ruserdata\nvignettes/*.html\nvignettes/*/\n*.pdf\n*/**/.pdf\ndocs\n"
  },
  {
    "path": "DESCRIPTION",
    "content": "Package: SPOTlight\nVersion: 1.13.2\nType: Package\nTitle: `SPOTlight`: Spatial Transcriptomics Deconvolution\nDescription: `SPOTlight` provides a method to deconvolute spatial transcriptomics\n    spots using a seeded NMF approach along with visualization tools to assess\n    the results. Spatially resolved gene expression profiles are key to\n    understand tissue organization and function. However, novel spatial \n    transcriptomics (ST) profiling techniques lack single-cell resolution and \n    require a combination with single-cell RNA sequencing (scRNA-seq) \n    information to deconvolute the spatially indexed datasets. Leveraging the \n    strengths of both data types, we developed SPOTlight, a computational tool \n    that enables the integration of ST with scRNA-seq data to infer the location\n    of cell types and states within a complex tissue. SPOTlight is centered \n    around a seeded non-negative matrix factorization (NMF) regression, \n    initialized using cell-type marker genes and non-negative least squares\n    (NNLS) to subsequently deconvolute ST capture locations (spots).\nAuthors@R: c(\n  person(\"Marc\", \"Elosua-Bayes\", email=\"elosua.marc@gmail.com\", role=c(\"aut\", \"cre\")),\n  person(\"Zachary\", \"DeBruine\", email=\"zacharydebruine@gmail.com\", role=\"aut\"),\n  person(\"Helena L.\", \"Crowell\", email=\"helena@crowell.eu\", role=\"aut\"))\nDepends: R (>= 4.5.0)\nImports:\n  ggplot2,\n  Matrix,\n  SingleCellExperiment,\n  sparseMatrixStats,\n  stats\nSuggests:\n  BiocStyle,\n  colorBlindness,\n  DelayedArray,\n  DropletUtils,\n  ExperimentHub,\n  ggcorrplot,\n  grDevices,\n  grid,\n  igraph,\n  jpeg,\n  knitr,\n  methods,\n  png,\n  rmarkdown,\n  scater,\n  scatterpie,\n  scran,\n  SpatialExperiment,\n  SummarizedExperiment,\n  S4Vectors,\n  TabulaMurisSenisData,\n  TENxVisiumData,\n  testthat\nLinkingTo: \n    Rcpp, \n    RcppEigen\nbiocViews: \n  SingleCell, \n  Spatial,\n  StatisticalMethod\nLicense: GPL-3\nEncoding: UTF-8\nRoxygenNote: 7.3.3\nVignetteBuilder: knitr\nURL: https://github.com/MarcElosua/SPOTlight\nBugReports: https://github.com/MarcElosua/SPOTlight/issues\n"
  },
  {
    "path": "LICENSE.md",
    "content": "GNU General Public License\n==========================\n\n_Version 3, 29 June 2007_  \n_Copyright © 2007 Free Software Foundation, Inc. &lt;<http://fsf.org/>&gt;_\n\nEveryone is permitted to copy and distribute verbatim copies of this license\ndocument, but changing it is not allowed.\n\n## Preamble\n\nThe GNU General Public License is a free, copyleft license for software and other\nkinds of works.\n\nThe licenses for most software and other practical works are designed to take away\nyour freedom to share and change the works. By contrast, the GNU General Public\nLicense is intended to guarantee your freedom to share and change all versions of a\nprogram--to make sure it remains free software for all its users. We, the Free\nSoftware Foundation, use the GNU General Public License for most of our software; it\napplies also to any other work released this way by its authors. You can apply it to\nyour programs, too.\n\nWhen we speak of free software, we are referring to freedom, not price. Our General\nPublic Licenses are designed to make sure that you have the freedom to distribute\ncopies of free software (and charge for them if you wish), that you receive source\ncode or can get it if you want it, that you can change the software or use pieces of\nit in new free programs, and that you know you can do these things.\n\nTo protect your rights, we need to prevent others from denying you these rights or\nasking you to surrender the rights. Therefore, you have certain responsibilities if\nyou distribute copies of the software, or if you modify it: responsibilities to\nrespect the freedom of others.\n\nFor example, if you distribute copies of such a program, whether gratis or for a fee,\nyou must pass on to the recipients the same freedoms that you received. You must make\nsure that they, too, receive or can get the source code. And you must show them these\nterms so they know their rights.\n\nDevelopers that use the GNU GPL protect your rights with two steps: **(1)** assert\ncopyright on the software, and **(2)** offer you this License giving you legal permission\nto copy, distribute and/or modify it.\n\nFor the developers' and authors' protection, the GPL clearly explains that there is\nno warranty for this free software. For both users' and authors' sake, the GPL\nrequires that modified versions be marked as changed, so that their problems will not\nbe attributed erroneously to authors of previous versions.\n\nSome devices are designed to deny users access to install or run modified versions of\nthe software inside them, although the manufacturer can do so. This is fundamentally\nincompatible with the aim of protecting users' freedom to change the software. The\nsystematic pattern of such abuse occurs in the area of products for individuals to\nuse, which is precisely where it is most unacceptable. Therefore, we have designed\nthis version of the GPL to prohibit the practice for those products. If such problems\narise substantially in other domains, we stand ready to extend this provision to\nthose domains in future versions of the GPL, as needed to protect the freedom of\nusers.\n\nFinally, every program is threatened constantly by software patents. States should\nnot allow patents to restrict development and use of software on general-purpose\ncomputers, but in those that do, we wish to avoid the special danger that patents\napplied to a free program could make it effectively proprietary. To prevent this, the\nGPL assures that patents cannot be used to render the program non-free.\n\nThe precise terms and conditions for copying, distribution and modification follow.\n\n## TERMS AND CONDITIONS\n\n### 0. Definitions\n\n“This License” refers to version 3 of the GNU General Public License.\n\n“Copyright” also means copyright-like laws that apply to other kinds of\nworks, such as semiconductor masks.\n\n“The Program” refers to any copyrightable work licensed under this\nLicense. Each licensee is addressed as “you”. “Licensees” and\n“recipients” may be individuals or organizations.\n\nTo “modify” a work means to copy from or adapt all or part of the work in\na fashion requiring copyright permission, other than the making of an exact copy. The\nresulting work is called a “modified version” of the earlier work or a\nwork “based on” the earlier work.\n\nA “covered work” means either the unmodified Program or a work based on\nthe Program.\n\nTo “propagate” a work means to do anything with it that, without\npermission, would make you directly or secondarily liable for infringement under\napplicable copyright law, except executing it on a computer or modifying a private\ncopy. Propagation includes copying, distribution (with or without modification),\nmaking available to the public, and in some countries other activities as well.\n\nTo “convey” a work means any kind of propagation that enables other\nparties to make or receive copies. Mere interaction with a user through a computer\nnetwork, with no transfer of a copy, is not conveying.\n\nAn interactive user interface displays “Appropriate Legal Notices” to the\nextent that it includes a convenient and prominently visible feature that **(1)**\ndisplays an appropriate copyright notice, and **(2)** tells the user that there is no\nwarranty for the work (except to the extent that warranties are provided), that\nlicensees may convey the work under this License, and how to view a copy of this\nLicense. If the interface presents a list of user commands or options, such as a\nmenu, a prominent item in the list meets this criterion.\n\n### 1. Source Code\n\nThe “source code” for a work means the preferred form of the work for\nmaking modifications to it. “Object code” means any non-source form of a\nwork.\n\nA “Standard Interface” means an interface that either is an official\nstandard defined by a recognized standards body, or, in the case of interfaces\nspecified for a particular programming language, one that is widely used among\ndevelopers working in that language.\n\nThe “System Libraries” of an executable work include anything, other than\nthe work as a whole, that **(a)** is included in the normal form of packaging a Major\nComponent, but which is not part of that Major Component, and **(b)** serves only to\nenable use of the work with that Major Component, or to implement a Standard\nInterface for which an implementation is available to the public in source code form.\nA “Major Component”, in this context, means a major essential component\n(kernel, window system, and so on) of the specific operating system (if any) on which\nthe executable work runs, or a compiler used to produce the work, or an object code\ninterpreter used to run it.\n\nThe “Corresponding Source” for a work in object code form means all the\nsource code needed to generate, install, and (for an executable work) run the object\ncode and to modify the work, including scripts to control those activities. However,\nit does not include the work's System Libraries, or general-purpose tools or\ngenerally available free programs which are used unmodified in performing those\nactivities but which are not part of the work. For example, Corresponding Source\nincludes interface definition files associated with source files for the work, and\nthe source code for shared libraries and dynamically linked subprograms that the work\nis specifically designed to require, such as by intimate data communication or\ncontrol flow between those subprograms and other parts of the work.\n\nThe Corresponding Source need not include anything that users can regenerate\nautomatically from other parts of the Corresponding Source.\n\nThe Corresponding Source for a work in source code form is that same work.\n\n### 2. Basic Permissions\n\nAll rights granted under this License are granted for the term of copyright on the\nProgram, and are irrevocable provided the stated conditions are met. This License\nexplicitly affirms your unlimited permission to run the unmodified Program. The\noutput from running a covered work is covered by this License only if the output,\ngiven its content, constitutes a covered work. This License acknowledges your rights\nof fair use or other equivalent, as provided by copyright law.\n\nYou may make, run and propagate covered works that you do not convey, without\nconditions so long as your license otherwise remains in force. You may convey covered\nworks to others for the sole purpose of having them make modifications exclusively\nfor you, or provide you with facilities for running those works, provided that you\ncomply with the terms of this License in conveying all material for which you do not\ncontrol copyright. Those thus making or running the covered works for you must do so\nexclusively on your behalf, under your direction and control, on terms that prohibit\nthem from making any copies of your copyrighted material outside their relationship\nwith you.\n\nConveying under any other circumstances is permitted solely under the conditions\nstated below. Sublicensing is not allowed; section 10 makes it unnecessary.\n\n### 3. Protecting Users' Legal Rights From Anti-Circumvention Law\n\nNo covered work shall be deemed part of an effective technological measure under any\napplicable law fulfilling obligations under article 11 of the WIPO copyright treaty\nadopted on 20 December 1996, or similar laws prohibiting or restricting circumvention\nof such measures.\n\nWhen you convey a covered work, you waive any legal power to forbid circumvention of\ntechnological measures to the extent such circumvention is effected by exercising\nrights under this License with respect to the covered work, and you disclaim any\nintention to limit operation or modification of the work as a means of enforcing,\nagainst the work's users, your or third parties' legal rights to forbid circumvention\nof technological measures.\n\n### 4. Conveying Verbatim Copies\n\nYou may convey verbatim copies of the Program's source code as you receive it, in any\nmedium, provided that you conspicuously and appropriately publish on each copy an\nappropriate copyright notice; keep intact all notices stating that this License and\nany non-permissive terms added in accord with section 7 apply to the code; keep\nintact all notices of the absence of any warranty; and give all recipients a copy of\nthis License along with the Program.\n\nYou may charge any price or no price for each copy that you convey, and you may offer\nsupport or warranty protection for a fee.\n\n### 5. Conveying Modified Source Versions\n\nYou may convey a work based on the Program, or the modifications to produce it from\nthe Program, in the form of source code under the terms of section 4, provided that\nyou also meet all of these conditions:\n\n* **a)** The work must carry prominent notices stating that you modified it, and giving a\nrelevant date.\n* **b)** The work must carry prominent notices stating that it is released under this\nLicense and any conditions added under section 7. This requirement modifies the\nrequirement in section 4 to “keep intact all notices”.\n* **c)** You must license the entire work, as a whole, under this License to anyone who\ncomes into possession of a copy. This License will therefore apply, along with any\napplicable section 7 additional terms, to the whole of the work, and all its parts,\nregardless of how they are packaged. This License gives no permission to license the\nwork in any other way, but it does not invalidate such permission if you have\nseparately received it.\n* **d)** If the work has interactive user interfaces, each must display Appropriate Legal\nNotices; however, if the Program has interactive interfaces that do not display\nAppropriate Legal Notices, your work need not make them do so.\n\nA compilation of a covered work with other separate and independent works, which are\nnot by their nature extensions of the covered work, and which are not combined with\nit such as to form a larger program, in or on a volume of a storage or distribution\nmedium, is called an “aggregate” if the compilation and its resulting\ncopyright are not used to limit the access or legal rights of the compilation's users\nbeyond what the individual works permit. Inclusion of a covered work in an aggregate\ndoes not cause this License to apply to the other parts of the aggregate.\n\n### 6. Conveying Non-Source Forms\n\nYou may convey a covered work in object code form under the terms of sections 4 and\n5, provided that you also convey the machine-readable Corresponding Source under the\nterms of this License, in one of these ways:\n\n* **a)** Convey the object code in, or embodied in, a physical product (including a\nphysical distribution medium), accompanied by the Corresponding Source fixed on a\ndurable physical medium customarily used for software interchange.\n* **b)** Convey the object code in, or embodied in, a physical product (including a\nphysical distribution medium), accompanied by a written offer, valid for at least\nthree years and valid for as long as you offer spare parts or customer support for\nthat product model, to give anyone who possesses the object code either **(1)** a copy of\nthe Corresponding Source for all the software in the product that is covered by this\nLicense, on a durable physical medium customarily used for software interchange, for\na price no more than your reasonable cost of physically performing this conveying of\nsource, or **(2)** access to copy the Corresponding Source from a network server at no\ncharge.\n* **c)** Convey individual copies of the object code with a copy of the written offer to\nprovide the Corresponding Source. This alternative is allowed only occasionally and\nnoncommercially, and only if you received the object code with such an offer, in\naccord with subsection 6b.\n* **d)** Convey the object code by offering access from a designated place (gratis or for\na charge), and offer equivalent access to the Corresponding Source in the same way\nthrough the same place at no further charge. You need not require recipients to copy\nthe Corresponding Source along with the object code. If the place to copy the object\ncode is a network server, the Corresponding Source may be on a different server\n(operated by you or a third party) that supports equivalent copying facilities,\nprovided you maintain clear directions next to the object code saying where to find\nthe Corresponding Source. Regardless of what server hosts the Corresponding Source,\nyou remain obligated to ensure that it is available for as long as needed to satisfy\nthese requirements.\n* **e)** Convey the object code using peer-to-peer transmission, provided you inform\nother peers where the object code and Corresponding Source of the work are being\noffered to the general public at no charge under subsection 6d.\n\nA separable portion of the object code, whose source code is excluded from the\nCorresponding Source as a System Library, need not be included in conveying the\nobject code work.\n\nA “User Product” is either **(1)** a “consumer product”, which\nmeans any tangible personal property which is normally used for personal, family, or\nhousehold purposes, or **(2)** anything designed or sold for incorporation into a\ndwelling. In determining whether a product is a consumer product, doubtful cases\nshall be resolved in favor of coverage. For a particular product received by a\nparticular user, “normally used” refers to a typical or common use of\nthat class of product, regardless of the status of the particular user or of the way\nin which the particular user actually uses, or expects or is expected to use, the\nproduct. A product is a consumer product regardless of whether the product has\nsubstantial commercial, industrial or non-consumer uses, unless such uses represent\nthe only significant mode of use of the product.\n\n“Installation Information” for a User Product means any methods,\nprocedures, authorization keys, or other information required to install and execute\nmodified versions of a covered work in that User Product from a modified version of\nits Corresponding Source. The information must suffice to ensure that the continued\nfunctioning of the modified object code is in no case prevented or interfered with\nsolely because modification has been made.\n\nIf you convey an object code work under this section in, or with, or specifically for\nuse in, a User Product, and the conveying occurs as part of a transaction in which\nthe right of possession and use of the User Product is transferred to the recipient\nin perpetuity or for a fixed term (regardless of how the transaction is\ncharacterized), the Corresponding Source conveyed under this section must be\naccompanied by the Installation Information. But this requirement does not apply if\nneither you nor any third party retains the ability to install modified object code\non the User Product (for example, the work has been installed in ROM).\n\nThe requirement to provide Installation Information does not include a requirement to\ncontinue to provide support service, warranty, or updates for a work that has been\nmodified or installed by the recipient, or for the User Product in which it has been\nmodified or installed. Access to a network may be denied when the modification itself\nmaterially and adversely affects the operation of the network or violates the rules\nand protocols for communication across the network.\n\nCorresponding Source conveyed, and Installation Information provided, in accord with\nthis section must be in a format that is publicly documented (and with an\nimplementation available to the public in source code form), and must require no\nspecial password or key for unpacking, reading or copying.\n\n### 7. Additional Terms\n\n“Additional permissions” are terms that supplement the terms of this\nLicense by making exceptions from one or more of its conditions. Additional\npermissions that are applicable to the entire Program shall be treated as though they\nwere included in this License, to the extent that they are valid under applicable\nlaw. If additional permissions apply only to part of the Program, that part may be\nused separately under those permissions, but the entire Program remains governed by\nthis License without regard to the additional permissions.\n\nWhen you convey a copy of a covered work, you may at your option remove any\nadditional permissions from that copy, or from any part of it. (Additional\npermissions may be written to require their own removal in certain cases when you\nmodify the work.) You may place additional permissions on material, added by you to a\ncovered work, for which you have or can give appropriate copyright permission.\n\nNotwithstanding any other provision of this License, for material you add to a\ncovered work, you may (if authorized by the copyright holders of that material)\nsupplement the terms of this License with terms:\n\n* **a)** Disclaiming warranty or limiting liability differently from the terms of\nsections 15 and 16 of this License; or\n* **b)** Requiring preservation of specified reasonable legal notices or author\nattributions in that material or in the Appropriate Legal Notices displayed by works\ncontaining it; or\n* **c)** Prohibiting misrepresentation of the origin of that material, or requiring that\nmodified versions of such material be marked in reasonable ways as different from the\noriginal version; or\n* **d)** Limiting the use for publicity purposes of names of licensors or authors of the\nmaterial; or\n* **e)** Declining to grant rights under trademark law for use of some trade names,\ntrademarks, or service marks; or\n* **f)** Requiring indemnification of licensors and authors of that material by anyone\nwho conveys the material (or modified versions of it) with contractual assumptions of\nliability to the recipient, for any liability that these contractual assumptions\ndirectly impose on those licensors and authors.\n\nAll other non-permissive additional terms are considered “further\nrestrictions” within the meaning of section 10. If the Program as you received\nit, or any part of it, contains a notice stating that it is governed by this License\nalong with a term that is a further restriction, you may remove that term. If a\nlicense document contains a further restriction but permits relicensing or conveying\nunder this License, you may add to a covered work material governed by the terms of\nthat license document, provided that the further restriction does not survive such\nrelicensing or conveying.\n\nIf you add terms to a covered work in accord with this section, you must place, in\nthe relevant source files, a statement of the additional terms that apply to those\nfiles, or a notice indicating where to find the applicable terms.\n\nAdditional terms, permissive or non-permissive, may be stated in the form of a\nseparately written license, or stated as exceptions; the above requirements apply\neither way.\n\n### 8. Termination\n\nYou may not propagate or modify a covered work except as expressly provided under\nthis License. Any attempt otherwise to propagate or modify it is void, and will\nautomatically terminate your rights under this License (including any patent licenses\ngranted under the third paragraph of section 11).\n\nHowever, if you cease all violation of this License, then your license from a\nparticular copyright holder is reinstated **(a)** provisionally, unless and until the\ncopyright holder explicitly and finally terminates your license, and **(b)** permanently,\nif the copyright holder fails to notify you of the violation by some reasonable means\nprior to 60 days after the cessation.\n\nMoreover, your license from a particular copyright holder is reinstated permanently\nif the copyright holder notifies you of the violation by some reasonable means, this\nis the first time you have received notice of violation of this License (for any\nwork) from that copyright holder, and you cure the violation prior to 30 days after\nyour receipt of the notice.\n\nTermination of your rights under this section does not terminate the licenses of\nparties who have received copies or rights from you under this License. If your\nrights have been terminated and not permanently reinstated, you do not qualify to\nreceive new licenses for the same material under section 10.\n\n### 9. Acceptance Not Required for Having Copies\n\nYou are not required to accept this License in order to receive or run a copy of the\nProgram. Ancillary propagation of a covered work occurring solely as a consequence of\nusing peer-to-peer transmission to receive a copy likewise does not require\nacceptance. However, nothing other than this License grants you permission to\npropagate or modify any covered work. These actions infringe copyright if you do not\naccept this License. Therefore, by modifying or propagating a covered work, you\nindicate your acceptance of this License to do so.\n\n### 10. Automatic Licensing of Downstream Recipients\n\nEach time you convey a covered work, the recipient automatically receives a license\nfrom the original licensors, to run, modify and propagate that work, subject to this\nLicense. You are not responsible for enforcing compliance by third parties with this\nLicense.\n\nAn “entity transaction” is a transaction transferring control of an\norganization, or substantially all assets of one, or subdividing an organization, or\nmerging organizations. If propagation of a covered work results from an entity\ntransaction, each party to that transaction who receives a copy of the work also\nreceives whatever licenses to the work the party's predecessor in interest had or\ncould give under the previous paragraph, plus a right to possession of the\nCorresponding Source of the work from the predecessor in interest, if the predecessor\nhas it or can get it with reasonable efforts.\n\nYou may not impose any further restrictions on the exercise of the rights granted or\naffirmed under this License. For example, you may not impose a license fee, royalty,\nor other charge for exercise of rights granted under this License, and you may not\ninitiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging\nthat any patent claim is infringed by making, using, selling, offering for sale, or\nimporting the Program or any portion of it.\n\n### 11. Patents\n\nA “contributor” is a copyright holder who authorizes use under this\nLicense of the Program or a work on which the Program is based. The work thus\nlicensed is called the contributor's “contributor version”.\n\nA contributor's “essential patent claims” are all patent claims owned or\ncontrolled by the contributor, whether already acquired or hereafter acquired, that\nwould be infringed by some manner, permitted by this License, of making, using, or\nselling its contributor version, but do not include claims that would be infringed\nonly as a consequence of further modification of the contributor version. For\npurposes of this definition, “control” includes the right to grant patent\nsublicenses in a manner consistent with the requirements of this License.\n\nEach contributor grants you a non-exclusive, worldwide, royalty-free patent license\nunder the contributor's essential patent claims, to make, use, sell, offer for sale,\nimport and otherwise run, modify and propagate the contents of its contributor\nversion.\n\nIn the following three paragraphs, a “patent license” is any express\nagreement or commitment, however denominated, not to enforce a patent (such as an\nexpress permission to practice a patent or covenant not to sue for patent\ninfringement). To “grant” such a patent license to a party means to make\nsuch an agreement or commitment not to enforce a patent against the party.\n\nIf you convey a covered work, knowingly relying on a patent license, and the\nCorresponding Source of the work is not available for anyone to copy, free of charge\nand under the terms of this License, through a publicly available network server or\nother readily accessible means, then you must either **(1)** cause the Corresponding\nSource to be so available, or **(2)** arrange to deprive yourself of the benefit of the\npatent license for this particular work, or **(3)** arrange, in a manner consistent with\nthe requirements of this License, to extend the patent license to downstream\nrecipients. “Knowingly relying” means you have actual knowledge that, but\nfor the patent license, your conveying the covered work in a country, or your\nrecipient's use of the covered work in a country, would infringe one or more\nidentifiable patents in that country that you have reason to believe are valid.\n\nIf, pursuant to or in connection with a single transaction or arrangement, you\nconvey, or propagate by procuring conveyance of, a covered work, and grant a patent\nlicense to some of the parties receiving the covered work authorizing them to use,\npropagate, modify or convey a specific copy of the covered work, then the patent\nlicense you grant is automatically extended to all recipients of the covered work and\nworks based on it.\n\nA patent license is “discriminatory” if it does not include within the\nscope of its coverage, prohibits the exercise of, or is conditioned on the\nnon-exercise of one or more of the rights that are specifically granted under this\nLicense. You may not convey a covered work if you are a party to an arrangement with\na third party that is in the business of distributing software, under which you make\npayment to the third party based on the extent of your activity of conveying the\nwork, and under which the third party grants, to any of the parties who would receive\nthe covered work from you, a discriminatory patent license **(a)** in connection with\ncopies of the covered work conveyed by you (or copies made from those copies), or **(b)**\nprimarily for and in connection with specific products or compilations that contain\nthe covered work, unless you entered into that arrangement, or that patent license\nwas granted, prior to 28 March 2007.\n\nNothing in this License shall be construed as excluding or limiting any implied\nlicense or other defenses to infringement that may otherwise be available to you\nunder applicable patent law.\n\n### 12. No Surrender of Others' Freedom\n\nIf conditions are imposed on you (whether by court order, agreement or otherwise)\nthat contradict the conditions of this License, they do not excuse you from the\nconditions of this License. If you cannot convey a covered work so as to satisfy\nsimultaneously your obligations under this License and any other pertinent\nobligations, then as a consequence you may not convey it at all. For example, if you\nagree to terms that obligate you to collect a royalty for further conveying from\nthose to whom you convey the Program, the only way you could satisfy both those terms\nand this License would be to refrain entirely from conveying the Program.\n\n### 13. Use with the GNU Affero General Public License\n\nNotwithstanding any other provision of this License, you have permission to link or\ncombine any covered work with a work licensed under version 3 of the GNU Affero\nGeneral Public License into a single combined work, and to convey the resulting work.\nThe terms of this License will continue to apply to the part which is the covered\nwork, but the special requirements of the GNU Affero General Public License, section\n13, concerning interaction through a network will apply to the combination as such.\n\n### 14. Revised Versions of this License\n\nThe Free Software Foundation may publish revised and/or new versions of the GNU\nGeneral Public License from time to time. Such new versions will be similar in spirit\nto the present version, but may differ in detail to address new problems or concerns.\n\nEach version is given a distinguishing version number. If the Program specifies that\na certain numbered version of the GNU General Public License “or any later\nversion” applies to it, you have the option of following the terms and\nconditions either of that numbered version or of any later version published by the\nFree Software Foundation. If the Program does not specify a version number of the GNU\nGeneral Public License, you may choose any version ever published by the Free\nSoftware Foundation.\n\nIf the Program specifies that a proxy can decide which future versions of the GNU\nGeneral Public License can be used, that proxy's public statement of acceptance of a\nversion permanently authorizes you to choose that version for the Program.\n\nLater license versions may give you additional or different permissions. However, no\nadditional obligations are imposed on any author or copyright holder as a result of\nyour choosing to follow a later version.\n\n### 15. Disclaimer of Warranty\n\nTHERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.\nEXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES\nPROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER\nEXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\nMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE\nQUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE\nDEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.\n\n### 16. Limitation of Liability\n\nIN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY\nCOPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS\nPERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL,\nINCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE\nPROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE\nOR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE\nWITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE\nPOSSIBILITY OF SUCH DAMAGES.\n\n### 17. Interpretation of Sections 15 and 16\n\nIf the disclaimer of warranty and limitation of liability provided above cannot be\ngiven local legal effect according to their terms, reviewing courts shall apply local\nlaw that most closely approximates an absolute waiver of all civil liability in\nconnection with the Program, unless a warranty or assumption of liability accompanies\na copy of the Program in return for a fee.\n\n_END OF TERMS AND CONDITIONS_\n\n## How to Apply These Terms to Your New Programs\n\nIf you develop a new program, and you want it to be of the greatest possible use to\nthe public, the best way to achieve this is to make it free software which everyone\ncan redistribute and change under these terms.\n\nTo do so, attach the following notices to the program. It is safest to attach them\nto the start of each source file to most effectively state the exclusion of warranty;\nand each file should have at least the “copyright” line and a pointer to\nwhere the full notice is found.\n\n    <one line to give the program's name and a brief idea of what it does.>\n    Copyright (C) <year>  <name of author>\n\n    This program is free software: you can redistribute it and/or modify\n    it under the terms of the GNU General Public License as published by\n    the Free Software Foundation, either version 3 of the License, or\n    (at your option) any later version.\n\n    This program is distributed in the hope that it will be useful,\n    but WITHOUT ANY WARRANTY; without even the implied warranty of\n    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n    GNU General Public License for more details.\n\n    You should have received a copy of the GNU General Public License\n    along with this program.  If not, see <http://www.gnu.org/licenses/>.\n\nAlso add information on how to contact you by electronic and paper mail.\n\nIf the program does terminal interaction, make it output a short notice like this\nwhen it starts in an interactive mode:\n\n    <program>  Copyright (C) <year>  <name of author>\n    This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'.\n    This is free software, and you are welcome to redistribute it\n    under certain conditions; type 'show c' for details.\n\nThe hypothetical commands `show w` and `show c` should show the appropriate parts of\nthe General Public License. Of course, your program's commands might be different;\nfor a GUI interface, you would use an “about box”.\n\nYou should also get your employer (if you work as a programmer) or school, if any, to\nsign a “copyright disclaimer” for the program, if necessary. For more\ninformation on this, and how to apply and follow the GNU GPL, see\n&lt;<http://www.gnu.org/licenses/>&gt;.\n\nThe GNU General Public License does not permit incorporating your program into\nproprietary programs. If your program is a subroutine library, you may consider it\nmore useful to permit linking proprietary applications with the library. If this is\nwhat you want to do, use the GNU Lesser General Public License instead of this\nLicense. But first, please read\n&lt;<http://www.gnu.org/philosophy/why-not-lgpl.html>&gt;.\n"
  },
  {
    "path": "NAMESPACE",
    "content": "# Generated by roxygen2: do not edit by hand\n\nexport(SPOTlight)\nexport(getMGS)\nexport(mockSC)\nexport(mockSP)\nexport(plotCorrelationMatrix)\nexport(plotImage)\nexport(plotInteractions)\nexport(plotSpatialScatterpie)\nexport(plotTopicProfiles)\nexport(runDeconvolution)\nexport(trainNMF)\nimport(ggplot2)\nimportFrom(Matrix,Matrix)\nimportFrom(Matrix,colSums)\nimportFrom(Matrix,rowSums)\nimportFrom(Matrix,t)\nimportFrom(SingleCellExperiment,SingleCellExperiment)\nimportFrom(SingleCellExperiment,cbind)\nimportFrom(SingleCellExperiment,colLabels)\nimportFrom(SingleCellExperiment,counts)\nimportFrom(grid,rasterGrob)\nimportFrom(grid,unit)\nimportFrom(sparseMatrixStats,colMedians)\nimportFrom(sparseMatrixStats,rowAlls)\nimportFrom(sparseMatrixStats,rowSds)\nimportFrom(sparseMatrixStats,rowSums2)\nimportFrom(stats,aggregate)\nimportFrom(stats,cor)\nimportFrom(stats,median)\nimportFrom(stats,rnbinom)\nimportFrom(stats,runif)\nuseDynLib(SPOTlight, .registration = TRUE)\n"
  },
  {
    "path": "NEWS",
    "content": "v0.99.1 ------------------------------------------------------------------------\n\n- text\n\nv0.99.0 ------------------------------------------------------------------------\n\n- initial submission to Bioc devel v3.15"
  },
  {
    "path": "R/RcppExports.R",
    "content": "# Generated by using Rcpp::compileAttributes() -> do not edit by hand\n# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393\n\npredict_nmf <- function(A_, w, L1, L2, threads) {\n    .Call(`_SPOTlight_predict_nmf`, A_, w, L1, L2, threads)\n}\n\nrun_nmf <- function(A_, At_, tol, maxit, verbose, L1, L2, threads, w) {\n    .Call(`_SPOTlight_run_nmf`, A_, At_, tol, maxit, verbose, L1, L2, threads, w)\n}\n\n"
  },
  {
    "path": "R/SPOTlight.R",
    "content": "#' @name SPOTlight\n#' @title Deconvolution of mixture using single-cell data\n#'\n#' @description This is the backbone function which takes in single cell\n#'   expression data to deconvolute spatial transcriptomics spots.\n#'\n#' @param x,y single-cell and mixture dataset, respectively. Can be a\n#'   numeric matrix or \\code{SingleCellExperiment}..\n#' @param groups character vector of group labels for cells in \\code{x}.\n#'   When \\code{x} is a \\code{SingleCellExperiment}.,\n#'   defaults to \\code{colLabels(x)} and \\code{Idents(x)}, respectively.\n#'   Make sure groups is not a Factor.\n#' @param mgs \\code{data.frame} or \\code{DataFrame} of marker genes.\n#'   Must contain columns holding gene identifiers, group labels and\n#'   the weight (e.g., logFC, -log(p-value) a feature has in a given group.\n#' @param hvg character vector containing hvg to include in the model.\n#'   By default NULL.\n#' @param gene_id,group_id,weight_id character specifying the column\n#'   in \\code{mgs} containing gene identifiers, group labels and weights,\n#'   respectively.\n#' @param scale logical specifying whether to scale single-cell counts to unit\n#'   variance. This gives the user the option to normalize the data beforehand\n#'   as you see fit (CPM, FPKM, ...) when passing a matrix or specifying the\n#'   slot from where to extract the count data.\n#' @param n_top integer scalar specifying the number of markers to select per\n#'  group. By default NULL uses all the marker genes to initialize the model.\n#' @param slot_sc,slot_sp If the object is of class \\code{SingleCellExperiment}\n#'   indicates matrix to use. By default \"counts\".\n#' @param L1_nmf LASSO penalty in the range (0, 1] for NMF,\n#'   larger values increase sparsity of each factor\n#' @param L2_nmf RUDGE penalty >0 for NMF,\n#'  larger values increase angle between factors and thus sparsity.\n#' @param tol tolerance of the NMF model at convergence, the Pearson correlation \n#'   distance between models across consecutive iterations (1e-5 is publication quality)\n#' @param maxit maximum number of NMF iterations for fitting\n#' @param threads number of threads to use, default 0 (all threads)\n#' @param verbose logical. Should information on progress be reported?\n#' @param min_prop scalar in [0,1] setting the minimum contribution\n#'   expected from a cell type in \\code{x} to observations in \\code{y}.\n#'   By default 0.\n#' @param L1_nnls_topics,L1_nnls_prop LASSO penalty in the range (0, 1] for NNLS\n#'   when computing cell type topic profiles and cell type proportions\n#'   respectively. Larger values remove \"noisy\" contributions more aggressively.\n#' @param L2_nnls_topics,L2_nnls_prop RIDGE penalty >0 for NNLS when computing\n#'   cell type topic profiles and cell type proportions respectively.\n#'   Larger values remove \"noisy\" contributions more aggressively.\n#' @param ... additional parameters.\n#'\n#' @return a numeric matrix with rows corresponding to samples\n#'   and columns to groups\n#'\n#' @author Marc Elosua Bayes, Zach DeBruine, and Helena L Crowell\n#'\n#' @details SPOTlight uses a Non-Negative Matrix Factorization approach to learn\n#'   which genes are important for each cell type. In order to drive the\n#'   factorization and give more importance to cell type marker genes we\n#'   previously compute them and use them to initialize the basis matrix. This\n#'   initialized matrices will then be used to carry out the factorization with\n#'   the single cell expression data. Once the model has learn the topic\n#'   profiles for each cell type we use non-negative least squares (NNLS) to\n#'   obtain the topic contributions to each spot. Lastly, NNLS is again used to\n#'   obtain the proportion of each cell type for each spot by finding the\n#'   fitting the single-cell topic profiles to the spots topic contributions.\n#'\n#' @examples\n#' library(scater)\n#' library(scran)\n#' \n#' # Use Mock data\n#' # Refer to the vignette for a full workflow\n#' sce <- mockSC(ng = 200, nc = 10, nt = 3)\n#' spe <- mockSP(sce)\n#' mgs <- getMGS(sce)\n#' \n#' res <- SPOTlight(\n#'     x = counts(sce),\n#'     y = counts(spe),\n#'     groups = as.character(sce$type),\n#'     mgs = mgs,\n#'     hvg = NULL,\n#'     weight_id = \"weight\",\n#'     group_id = \"type\",\n#'     gene_id = \"gene\")\nNULL\n\n#' @rdname SPOTlight\n#' @export\n#' @useDynLib SPOTlight, .registration = TRUE\n#' \nSPOTlight <- function(\n    x,\n    y,\n    groups = NULL,\n    mgs,\n    n_top = NULL,\n    gene_id = \"gene\",\n    group_id = \"cluster\",\n    weight_id = \"weight\",\n    hvg = NULL,\n    scale = TRUE,\n    min_prop = 0.01,\n    verbose = TRUE,\n    slot_sc = \"counts\",\n    slot_sp = \"counts\",\n    L1_nmf = 0,\n    L2_nmf = 0,\n    maxit = 100,\n    threads = 0,\n    tol = 1e-5,\n    L1_nnls_topics = 0,\n    L2_nnls_topics = 0,\n    L1_nnls_prop = 0,\n    L2_nnls_prop = 0,\n  ...) {\n    \n    # train NMF model\n    mod_ls <- trainNMF(\n        x = x,\n        y = rownames(y),\n        groups = groups,\n        mgs = mgs,\n        n_top = n_top,\n        gene_id = gene_id, \n        group_id = group_id, \n        weight_id = weight_id, \n        hvg = hvg, \n        verbose = verbose,\n        slot_sc = slot_sc,\n        L1_nmf = L1_nmf,\n        L2_nmf = L2_nmf,\n        tol = tol,\n        threads = threads,\n        maxit = maxit,\n        ...)\n    \n    # perform deconvolution\n    res <- runDeconvolution(\n        x = y,\n        mod = mod_ls[[\"mod\"]], \n        ref = mod_ls[[\"topic\"]], \n        scale = scale, \n        min_prop = min_prop, \n        verbose = verbose,\n        slot = slot_sp,\n        L1_nnls_topics = L1_nnls_topics,\n        L2_nnls_topics = L2_nnls_topics,\n        L1_nnls_prop = L1_nnls_prop,\n        L2_nnls_prop = L2_nnls_prop)\n    \n    # return list of NMF model & deconvolution matrix\n    list(\n        \"mat\" = res[[\"mat\"]],\n        \"res_ss\" = res[[\"res_ss\"]],\n        \"NMF\" = mod_ls[[\"mod\"]])\n    \n}\n"
  },
  {
    "path": "R/data.R",
    "content": "#' @rdname data\n#' @name data\n#' @aliases mockSC mockSP getMGS\n#' @title Synthetic single-cell, mixture and marker data\n#'\n#' @description\n#' \\code{mockSC/mockSP()} are designed to generate synthetic single-cell and\n#' spatial mixture data. These data are not meant to represent biologically\n#' meaningful use-cases, but are solely intended for use in examples, for\n#' unit-testing, and to demonstrate \\code{SPOTlight}'s general functionality.\n#' Finally, \\code{.get_mgs()} implements a statistically naive way to select\n#' markers from single-cell data; again, please don't use it in real life.\n#'\n#' @param ng,nc,nt,ns integer scalar specifying the number\n#'   of genes, cells, types (groups) and spots to simulate.\n#' @param n_top integer scalar specifying the number\n#'   of markers to select per group.\n#'\n#' @return\n#' \\itemize{\n#' \\item{\\code{mockSC} returns a \\code{SingleCellExperiment}\n#'   with rows = genes, columns = single cells, and cell metadata\n#'   (\\code{colData}) column \\code{type} containing group identifiers.}\n#' \\item{\\code{mockSP} returns a \\code{SingleCellExperiment}\n#'   with rows = genes, columns = single cells, and cell metadata\n#'   (\\code{colData}) column \\code{type} containing group identifiers.}\n#' \\item{\\code{getMGS} returns a \\code{data.frame} with \\code{nt*n_top}\n#'   rows and 3 columns: gene and type (group) identifier, as well as the\n#'   gene's weight = the proportion of counts accounted for by that type.}\n#' }\n#'\n#' @examples\n#' sce <- mockSC()\n#' spe <- mockSP(sce)\n#' mgs <- getMGS(sce)\nNULL\n\n#' @rdname data\n#' @importFrom SingleCellExperiment cbind SingleCellExperiment\n#' @importFrom stats rnbinom runif\n#' @export\nmockSC <- function(ng = 200, nc = 50, nt = 3) {\n    z <- lapply(seq_len(nt), function(t) {\n        ms <- 2^runif(ng, 2, 10)\n        ds <- 0.5 + 100 / ms\n        y <- rnbinom(ng * nc, mu = ms, size = 1 / ds)\n        y <- matrix(y, nrow = ng, ncol = nc)\n        dimnames(y) <- list(\n            paste0(\"gene\", seq_len(ng)),\n            paste0(\"cell\", seq_len(nc))\n        )\n        x <- SingleCellExperiment(list(counts = y))\n        x$type <- factor(\n            paste0(\"type\", t),\n            paste0(\"type\", seq_len(nt))\n        )\n        return(x)\n    })\n    zbind <- do.call(cbind, z)\n    colnames(zbind) <- make.unique(colnames(zbind))\n    zbind\n}\n\n#' @rdname data\n#' @param x Single cell experiment object\n#' @importFrom Matrix rowSums\n#' @importFrom SingleCellExperiment SingleCellExperiment\n#' @export\nmockSP <- function(x, ns = 100) {\n    z <- replicate(ns, {\n        # sample number of cells\n        nc <- sample(5, 1)\n        # sample reference cells\n        cs <- sample(ncol(x), nc)\n        # sum up counts & rescale\n        y <- counts(x[, cs])\n        y <- rowSums(y)\n        # compute composition\n        n <- table(x$type[cs]) / nc\n        n <- c(unclass(n))\n        list(y, n)\n    })\n    # get counts\n    y <- t(do.call(rbind, z[1, ]))\n    dimnames(y) <- list(\n        rownames(x),\n        paste0(\"spot\", seq_len(ns))\n    )\n    # get compositions\n    fq <- do.call(rbind, z[2, ])\n    rownames(fq) <- colnames(y)\n    # sample coordinates\n    xy <- matrix(runif(2 * ns), ncol = 2)\n    dimnames(xy) <- list(colnames(y), c(\"x\", \"y\"))\n    SingleCellExperiment(\n        list(counts = y),\n        colData = data.frame(xy),\n        metadata = list(props = fq)\n    )\n}\n\n#' @rdname data\n#' @param n_top integer specifying the number of\n#'   marker genes to extract for each cluster.\n#' @importFrom Matrix colSums rowSums\n#' @importFrom SingleCellExperiment counts\n#' @importFrom stats aggregate\n#' @export\ngetMGS <- function(x, n_top = 10) {\n    # compute sum of counts by group\n    y <- aggregate(t(counts(x)), list(x$type), sum)\n    rownames(y) <- y[, 1]\n    # Remove group column\n    y <- t(y[, -1])\n    # get proportion of counts by group\n    z <- lapply(rownames(y), function(gene) {\n        p <- prop.table(y[gene, ])\n        i <- which.max(p)\n        type <- names(i)\n        weight <- p[i]\n        data.frame(gene, type, weight)\n    })\n    z <- do.call(rbind, z)\n    rownames(z) <- NULL\n    # select 'top_n' in each group\n    z <- split(z, z$type)\n    # Iterate over groups and sort within them\n    z <- lapply(z, function(.) {\n        # Get indexes of the positions in the sorted order\n        o <- order(.$weight, decreasing = TRUE)\n        # order the markers\n        n <- nrow(.)\n        if (n < n_top)\n            n_top <- n\n        .[o, ][seq_len(n_top), ]\n    })\n    z <- do.call(rbind, z)\n    rownames(z) <- NULL\n    return(z)\n}\n"
  },
  {
    "path": "R/plotCorrelationMatrix.R",
    "content": "#' @rdname plotCorrelationMatrix\n#' @name plotCorrelationMatrix\n#' @title Plot Correlation Matrix\n#'\n#' @description This function takes in a matrix with the predicted proportions\n#'   for each spot and returns a correlation matrix between cell types.\n#'\n#' @param x numeric matrix with rows = samples and columns = cell types\n#'   Must have at least two rows and two columns.\n#' @param cor.method Method to use for correlation:\n#'   c(\"pearson\", \"kendall\", \"spearman\"). By default pearson.\n#' @param insig character, specialized insignificant correlation coefficients,\n#'   \"pch\", \"blank\" (default). If \"blank\", wipe away the corresponding glyphs;\n#'   if \"pch\", add characters (see pch for details) on corresponding glyphs.\n#' @param colors character vector with three colors indicating the lower, mid,\n#'   and high color. By default c(\"#6D9EC1\", \"white\", \"#E46726\").\n#' @param hc.order logical value. If TRUE, correlation matrix will be\n#'   hc.ordered using hclust function.\n#' @param p.mat logical value. If TRUE (default), correlation significance\n#'   will be used. If FALSE arguments sig.level, insig, pch, pch.col,\n#'   pch.cex are invalid.\n#' @param ... additional graphical parameters passed to \\code{ggcorrplot}.\n#'\n#' @return \\code{ggplot} object\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' set.seed(321)\n#' x <- replicate(m <- 25, runif(10, 0, 1))\n#' rownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\n#' colnames(x) <- paste0(\"type\", seq_len(ncol(x)))\n#'\n#' # The most basic example\n#' plotCorrelationMatrix(x = x)\n#'\n#' # Showing the non-significant correlatinos\n#' plotCorrelationMatrix(x = x, insig = \"pch\")\n#'\n#' # A more elaborated\n#' plotCorrelationMatrix(\n#'     x = x,\n#'     hc.order = FALSE,\n#'     type = \"lower\",\n#'     outline.col = \"lightgrey\",\n#'     method = \"circle\",\n#'     colors = c(\"#64ccc9\", \"#b860bd\", \"#e3345d\"))\n#'\nNULL\n\n#' @rdname plotCorrelationMatrix\n#' @importFrom Matrix colSums\n#' @importFrom stats cor median\n#' @import ggplot2\n#' @export\n\nplotCorrelationMatrix <- function(\n    x,\n    cor.method = c(\"pearson\", \"kendall\", \"spearman\"),\n    insig = c(\"blank\", \"pch\"),\n    colors = c(\"#6D9EC1\", \"white\", \"#E46726\"),\n    hc.order = TRUE,\n    p.mat = TRUE,\n    ...) {\n        # Check necessary packages are installed and if not STOP\n        .test_installed(\"ggcorrplot\")\n        # If the following are left undefined select\n        # the first element of the vector\n        cor.method <- match.arg(cor.method)\n        insig <- match.arg(insig)\n\n        stopifnot(\n            is.matrix(x), is.numeric(x),\n            all(dim(x) > 0), ncol(x) > 1,\n            is.character(colors), length(colors) == 3,\n            is.logical(hc.order), length(hc.order) == 1,\n            is.logical(p.mat), length(p.mat) == 1)\n\n        # Remove columns that are all 0\n        x <- x[, colSums(x) > 0]\n        # return error if there are NAs in x\n        if (NA %in% x)\n            stop(\"There are NAs in x, please consider passing na.omit(x)\",\n                 \" to the x argument\")\n        corr <- cor(x)\n\n        # Compute correlation P-value\n        p.mat <- if (p.mat) {\n            ggcorrplot::cor_pmat(\n                x = x,\n                conf_int = 0.95,\n                method = cor.method)\n        }\n\n        # Plot correlation matrix as a heatmap\n        ggcorrplot::ggcorrplot(\n            corr = corr,\n            p.mat = p.mat,\n            hc.order = hc.order,\n            insig = insig,\n            lab = FALSE,\n            colors = colors,\n            ...) +\n            theme(\n                plot.title = element_text(hjust = 0.5, face = \"bold\"),\n                axis.text.x = element_text(angle = 60, vjust = 1),\n                axis.text = element_text(vjust = 0.5))\n    }\n"
  },
  {
    "path": "R/plotImage.R",
    "content": "#' @rdname plotImage\n#' @name plotImage\n#' @title Plot JP(E)G/PNG/Raster/RGB images\n#'\n#' @description This function takes in an image-related object - path to\n#'   JP(E)G/PNG file, raster object, RGBarray. It returns a ggplot object with\n#'   the selected image.\n#'\n#' @param x A variety of objects can be passed: character string corresponding\n#'   to an image file path, valid file types are JPG, JPEG and PNG. It can also\n#'   take as input objects of class raster and RGB arrays. It can also take\n#'   a SpatialExperiment from which the image will be extracted.\n#' @param slice Character string indicating which image slice to use when\n#'   SpatialExperiment objects are passed. By default uses the first\n#'   slice available.\n#' @return \\code{ggplot} object\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' # Filename\n#' path <- file.path(\n#'   system.file(package = \"SPOTlight\"), \n#'   \"extdata/SPOTlight.png\")\n#' plotImage(x = path)\n#' # array\n#' png_img <- png::readPNG(path)\n#' plotImage(png_img)\n#' # SpatialExperiment\nNULL\n#' @export\nplotImage <- function(x, slice = NULL) {\n    # check validity of input arguments\n    stopifnot(\n        # Check for valid x classes\n        is.matrix(x) | is.character(x) | is.array(x) | is(x, \"rastergrob\") | \n            is(x, \"SpatialExperiment\"),\n        # Check for valid slice classes\n        is.null(slice) | is.character(slice))\n    \n    if (!is.array(x))\n        x <- .extract_image(x)\n        \n    # Plot image\n    plt <- .plot_image(x)\n}\n"
  },
  {
    "path": "R/plotInteractions.R",
    "content": "#' @rdname plotInteractions\n#' @title Plot group interactions\n#'\n#' @aliases plotHeatmap plotNetwork\n#'\n#' @description This function takes in a matrix with the predicted proportions\n#'   for each spot and returns a heatmap \\code{which = plotHeatmap} or a network\n#'    graph \\code{which = plotNetwork} to show which cells are interacting\n#'    spatially.\n#'\n#' @param x numeric matrix with rows = samples and columns = groups.\n#'   Must have at least one row and column, and at least two columns.\n#' @param which character string specifying the type of\n#'   visualization: one of \"heatmap\" or \"network\".\n#' @param min_prop scalar specifying the value above which\n#'   a group is considered to be contributing to a given sample.\n#'   An interaction between groups i and j is counted for sample s\n#'   only when both x[s, i] and x[s, j] fall above \\code{min_prop}.\n#' @param metric character string specifying which metric to show:\n#'   one of \"prop\" or \"jaccard\".\n#' @param ... additional graphical parameters passed\n#'   to \\code{plot.igraph} when \\code{which = \"network\"}\n#'   (see \\code{?igraph.plotting}).\n#'\n#' @return base R plot\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' library(ggplot2)\n#' mat <- replicate(8, rnorm(100, runif(1, -1, 1)))\n#' # Basic example\n#' plotInteractions(mat)\n#'\n#' ### heatmap ###\n#' # This returns a ggplot object that can be modified as such\n#' plotInteractions(mat, which = \"heatmap\") +\n#'     scale_fill_gradient(low = \"#f2e552\", high = \"#850000\") +\n#'     labs(title = \"Interaction heatmap\", fill = \"proportion\")\n#'         \n#' ### Network ###\n#' # specify node names\n#' nms <- letters[seq_len(ncol(mat))]\n#' plotInteractions(mat, which = \"network\", vertex.label = nms)\n#'\n#' # or set column names instead\n#' colnames(mat) <- nms\n#' plotInteractions(mat, which = \"network\")\n#'\n#' # pass additional graphical parameters for aesthetics\n#' plotInteractions(mat,\n#'     which = \"network\",\n#'     edge.color = \"cyan\",\n#'     vertex.color = \"pink\",\n#'     vertex.label.font = 2,\n#'     vertex.label.color = \"maroon\")\n\n#' @export\nplotInteractions <- function(x,\n    which = c(\"heatmap\", \"network\"),\n    metric = c(\"prop\", \"jaccard\"),\n    min_prop = 0, ...) {\n    # check validity of input arguments\n    which <- match.arg(which)\n    metric <- match.arg(metric)\n    stopifnot(\n        is.matrix(x), is.numeric(x),\n        all(dim(x) > 0), ncol(x) > 1,\n        is.numeric(min_prop), length(min_prop) == 1)\n\n    # get interactions table\n    if (is.null(colnames(x))) {\n        colnames(x) <- seq_len(ncol(x))\n    }\n    df <- .count_interactions(x, min_prop)\n    df <- .statistics_interaction(x, df)\n\n    switch(which,\n        heatmap = .plot_heatmap(x, df, metric),\n        network = .plot_network(x, df, metric, ...))\n}\n\n#' @importFrom sparseMatrixStats rowAlls\n.count_interactions <- function(x, min_prop) {\n    # for each pair of groups count how many\n    # samples have value above 'min_prop'\n    x <- x > min_prop\n    ij <- utils::combn(colnames(x), 2)\n    y <- apply(ij, 2, function(.) sum(rowAlls(x[, ., drop = FALSE])))\n\n    # construct 'data.frame'\n    df <- data.frame(t(ij), y)\n    names(df) <- c(\"from\", \"to\", \"n\")\n    \n    # assure are properly ordered\n    y <- colnames(x)\n    df$i <- factor(df$from, y)\n    df$j <- factor(df$to, rev(y))\n    \n    return(df)\n}\n\n.statistics_interaction <- function(x, df) {\n    # compute proportion of samples that have all groups\n    y <- colnames(x)\n    t <- colSums(x > 0)\n    i <- match(df$from, y)\n    j <- match(df$to, y)\n    df$ti <- t[i]\n    df$tj <- t[j]\n    df$pi <- df$n / df$ti\n    df$pj <- df$n / df$tj\n    # As suggested by @astrid12345\n    # https://github.com/MarcElosua/SPOTlight/issues/42\n    df$jaccard <- df$n / (df$ti + df$tj - df$n)\n    return(df)\n}\n#' @import ggplot2\n#' @importFrom Matrix colSums\n.plot_heatmap <- function(x, df, metric) {\n    \n    # Initialize ggplot\n    p <- ggplot(df)\n    \n    # Add pertinent layers\n    if (metric == \"prop\") {\n\n        # Add tile layers\n        p <- p + geom_tile(aes(.data$i, .data$j, fill = .data$pi)) +\n            geom_tile(aes(.data$j, .data$i, fill = .data$pj))\n            \n    } else if (metric == \"jaccard\") {\n        # Add tile layers - Jaccard\n        p <- p + geom_tile(aes(.data$i, .data$j, fill = .data$jaccard))\n    }\n\n    # Prettify the plot :)\n    p +\n        scale_fill_viridis_c(\"proportion\", limits = c(0, NA)) +\n        scale_y_discrete(limits = function(.) rev(.)) +\n        coord_fixed(expand = FALSE) +\n        labs(x = \"From\", y = \"To\", fill = \"Proportion\") +\n        theme_linedraw() +\n        theme(\n            panel.grid = element_blank(),\n            axis.text.x = element_text(angle = 45, hjust = 1))\n}\n\n.plot_network <- function(x, df, metric, ...) {\n    # Check necessary packages are installed and if not STOP\n    .test_installed(\"igraph\")\n    \n    w <- switch(metric,\n        prop = scale(df[, \"n\"], 1),\n        jaccard = df[, \"jaccard\"])\n    \n    g <- igraph::graph_from_data_frame(df,\n        vertices = colnames(x),\n        directed = FALSE)\n    \n    igraph::plot.igraph(g, edge.width = w, ...)\n}\n"
  },
  {
    "path": "R/plotSpatialScatterpie.R",
    "content": "#' @rdname plotSpatialScatterpie\n#' @name plotSpatialScatterpie\n#' @title Spatial scatterpie\n#'\n#' @description This function takes in the coordinates of the spots and the\n#'   proportions of the cell types within each spot. It returns a plot where\n#'   each spot is a piechart showing proportions of the cell type composition.\n#'\n#' @param x Object containing the spots coordinates, it can be an object of class\n#'   SpatialExperiment, dataframe or matrix. For the latter two\n#'   rownames should have the spot barcodes to match x. If a matrix it has to\n#'   of dimensions nrow(y) x 2 where the columns are the x and y coordinates\n#'   in that order.\n#' @param y Matrix or dataframe containing the deconvoluted spots. rownames\n#'   need to be the spot barcodes to match to x.\n#' @param img Logical TRUE or FALSE indicating whether to plot the image or not.\n#'   Objects of classes accepted by \\code{plotImage} can also be passed and\n#'   that image will be used. By default FALSE.\n#' @param slice Character string indicating which slice to plot if img is TRUE.\n#'   By default uses the first image.\n#' @param cell_types Vector of cell type names to plot. By default uses the\n#'   column names of y.\n#' @param scatterpie_alpha Numeric scalar to set the alpha of the pie charts.\n#'   By default 1.\n#' @param pie_scale Numeric scalar to set the size of the pie charts.\n#'   By default 0.4.\n#' @param degrees From SpatialExperiment rotateImg. For clockwise (degrees > 0)\n#'  and counter-clockwise (degrees < 0) rotation. By default NULL.\n#' @param axis From SpatialExperiment mirrorImg. When a SpatialExperiment object\n#'   is passed as the image return the mirror image. For horizontal (axis = \"h\")\n#'    and vertical (axis = \"v\") mirroring. By default NULL.\n#' @param ... additional parameters to geom_scatterpie\n#' @return \\code{ggplot} object\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' set.seed(321)\n#'\n#' # Coordinates\n#' x <- replicate(2, rnorm(100))\n#' rownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\n#' colnames(x) <- c(\"imagecol\", \"imagerow\")\n#'\n#' # Proportions\n#' y <- replicate(m <- 5, runif(nrow(x), 0, 1))\n#' y <- prop.table(y, 1)\n#'\n#' rownames(y) <- paste0(\"spot\", seq_len(nrow(y)))\n#' colnames(y) <- paste0(\"type\", seq_len(ncol(y)))\n#'\n#' (plt <- plotSpatialScatterpie(x = x, y = y))\nNULL\n\n#' @rdname plotSpatialScatterpie\n#' @import ggplot2\n#' @export\nplotSpatialScatterpie <- function(\n    x,\n    y,\n    cell_types = colnames(y),\n    img = FALSE,\n    slice = NULL,\n    scatterpie_alpha = 1,\n    pie_scale = 0.4,\n    degrees = NULL,\n    axis = NULL,\n    ...) {\n    # Check necessary packages are installed and if not STOP\n    .test_installed(\"scatterpie\")\n\n    # Class checks\n    stopifnot(\n        # Check x inputs\n        is.matrix(x) | is.data.frame(x) |\n            is(x, \"SpatialExperiment\"),\n        # Check y inputs\n        is.matrix(y) | is.data.frame(y),\n        # cell_types needs to be a character with max length = ncol(y)\n        is.character(cell_types) & length(cell_types) <= ncol(y),\n        # Check img\n        # img not checked since its checked in plotImage()\n        # Check slice name\n        is.character(slice) | is.null(slice),\n        # Check plotting parameters are numeric\n        is.numeric(scatterpie_alpha),\n        is.numeric(pie_scale),\n        is.numeric(degrees) | is.null(degrees),\n        axis %in% c(\"h\", \"v\") | is.null(axis)\n    )\n\n    # If image is passed add it as the base layer, if not, no image\n    # Need to use isFALSE bc img can have many different inputs\n    # Set ymax to overlap image and piecharts\n    if (isFALSE(img)) {\n        p <- ggplot() +\n            coord_fixed()\n        ymax <- 0\n    } else {\n        # Extract image from SE objects when img is TRUE\n        # If image is not TRUE and not FALSE an acceptable class for plotImage\n        # has been passed\n        if (is(x, \"SpatialExperiment\") & isTRUE(img)) {\n            img <- .extract_image(x, slice)\n\n            # Rotate or mirror image if dots don't overlay properly\n            if (is(x, \"SpatialExperiment\")) {\n                .test_installed(\"SpatialExperiment\")\n\n                ## Rotate image if needed\n                if (!is.null(degrees)) {\n                    .test_installed(\"grDevices\")\n                    img <- SpatialExperiment::SpatialImage(\n                        grDevices::as.raster(img))\n                    img <- as(img, \"LoadedSpatialImage\")\n                    img <- SpatialExperiment::rotateImg(img, degrees = degrees)\n                    img <- grDevices::as.raster(img)\n                }\n\n                ## Make mirror image if necessary\n                if (!is.null(axis)) {\n                    .test_installed(\"grDevices\")\n                    img <- SpatialExperiment::SpatialImage(\n                        grDevices::as.raster(img))\n                    img <- as(img, \"LoadedSpatialImage\")\n                    img <- SpatialExperiment::mirrorImg(img, axis = axis)\n                    img <- grDevices::as.raster(img)\n                }\n            }\n        }\n\n        p <- plotImage(x = img)\n        ymax <- max(p$coordinates$limits$y)\n    }\n\n    # Extract coordinate matrix from x\n    if (!is.matrix(x))\n        x <- .extract_coord(x = x, slice = slice, img = img)\n\n    # Check colnames\n    x <- .x_cnames(x)\n\n    # Convert y to matrix format\n    if (!is.matrix(x)) {\n        y <- as.matrix(x)\n    }\n\n    # Stop if x and y don't have the same number of columns or if the\n    # rownames are not common between them\n    stopifnot(\n        nrow(x) == nrow(y),\n        all(rownames(x) %in% rownames(y)))\n\n    # merge by row names (by=0 or by=\"row.names\")\n    df <- merge(x, y, by = 0, all = TRUE)\n    # make y negative\n    df$coord_y_i <- abs(df$coord_y - ymax)\n\n    # Plot\n    p + scatterpie::geom_scatterpie(\n        data = df,\n        aes(\n            x = .data[[\"coord_x\"]],\n            y = .data[[\"coord_y_i\"]]\n        ),\n        cols = cell_types,\n        color = NA,\n        alpha = scatterpie_alpha,\n        pie_scale = pie_scale,\n        ...) +\n        # Below not needed bc comes from plotImage\n        # coord_fixed() +\n        theme_void() +\n        theme(legend.key.size = unit(0.5, \"lines\"))\n    }\n\n.x_cnames <- function(x) {\n    # If the column names of x aren't right fix them\n    cnames <- c(\"coord_y\", \"coord_x\")\n    if (!all(colnames(x) %in% cnames)) {\n        colnames(x) <- cnames\n    }\n    x\n}\n\n# Coordinates and return a matrix object where each row is a spot and the\n# columns are the x and y coordinates\n.extract_coord <- function(x, slice, img) {\n    # Iterate over all the accepted classes and return spot coordinates\n    if (is.data.frame(x)) {\n        # Convert to matrix\n        x <- as.matrix(x)\n    } else if (is(x, \"SpatialExperiment\")) {\n\n        .test_installed(c(\"SpatialExperiment\"))\n\n        # Stop if there are no images or the name selected doesn't exist\n        stopifnot(\n            # Stop if there are no images\n            !is.null(SpatialExperiment::getImg(x)),\n            # Stop if the image doesn't exist\n            slice %in% SpatialExperiment::imgData(x)[1, \"sample_id\"],\n            # Return error if there are no colnames in the object\n            !is.null(colnames(x))\n        )\n\n        # If slice is null use the first slice\n        img_df <- SpatialExperiment::imgData(x)\n        if (is.null(slice))\n            slice <- img_df[1, \"sample_id\"]\n\n        # Scale factor to scale the coordinates\n        sf <- img_df[img_df$sample_id == slice, \"scaleFactor\"]\n\n        ## Extract spot barcodes\n        barcodes <- colnames(x)\n\n        ## Extract spatial coordinates\n        # coord_df <- SpatialExperiment::spatialCoords(x)\n        x <- as.matrix(SpatialExperiment::spatialCoords(x)[, c(1, 2)])\n\n        ## Scale coordinates\n        x <- x * sf\n\n        ## Add barcodes to coord matrix & change colnames\n        rownames(x) <- barcodes\n        \n    } else {\n        stop(\"Couldn't extract image coordinates.\n            Please check class(x) is SpatialExperiment,\n            dataframe or matrix\")\n    }\n    return(x)\n\n}\n"
  },
  {
    "path": "R/plotTopicProfiles.R",
    "content": "#' @rdname plotTopicProfiles\n#' @name plotTopicProfiles\n#' @title Plot NMF topic profiles\n#'\n#' @description This function takes in the fitted NMF model and returns the\n#'   topic profiles learned for each cell \\code{facet = FALSE} or cell type\n#'   \\code{facet = TRUE}. Ideal training will return all the cell from the same\n#'   cell type to share a unique topic profile.\n#'\n#' @param x \\code{list} object obtained from \\code{SPOTlight}.\n#' @param y vector of group labels. Should be of length\n#'   \\code{ncol(res_lvl1$NMF$h)}.\n#' @param facet logical indicating whether to stratify by group.\n#'   If \\code{FALSE} (default), weights will be the median across cells\n#'   for each group (point = topic weight for a given cell type).\n#'   If \\code{TRUE}, cell-specific weights will be shown\n#'   (point = topic weight of a given cell).\n#' @param min_prop scalar in [0,1]. When \\code{facet = TRUE},\n#'   only cells with a weight > \\code{min_prop} will be included.\n#' @param ncol integer scalar specifying the number of facet columns.\n#' \n#' @return \\code{ggplot} object\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' library(ggplot2)\n#' x <- mockSC()\n#' y <- mockSP(x)\n#' z <- getMGS(x)\n#' \n#' res <- SPOTlight(x, y,\n#'     groups = x$type,\n#'     mgs = z,\n#'     group_id = \"type\",\n#'     verbose = FALSE)\n#'\n#' plotTopicProfiles(res[[3]], x$type, facet = TRUE)\n#' plotTopicProfiles(res[[3]], x$type, facet = FALSE)\nNULL\n\n#' @rdname plotTopicProfiles\n#' @importFrom stats aggregate median\n#' @import ggplot2\n#' @export\nplotTopicProfiles <- function(\n    x,\n    y,\n    facet = FALSE,\n    min_prop = 0.01,\n    ncol = NULL) {\n    # Convert y to character\n    y <- as.character(y)\n    \n    # check validity of input arguments\n    stopifnot(\n        is(x, \"list\"),\n        all(sort(names(x)) == sort(c(\"w\", \"d\", \"h\"))),\n        is.character(y),\n        length(y) == ncol(x$h),\n        setequal(\n            colnames(x$w), paste0(\"topic_\", seq_len(length(unique(y))))\n            ),\n        is.logical(facet), length(facet) == 1,\n        is.numeric(min_prop), length(min_prop) == 1,\n        is.null(ncol) | (is.numeric(ncol) & length(ncol) == 1))\n    \n    # get proportion of topic contribution by cell\n    mat <- prop.table(t(x$h), 1)\n    df <- data.frame(\n        id = seq_len(nrow(mat)),\n        weight = c(mat),\n        group = rep(y, ncol(mat)),\n        topic = rep(seq_len(ncol(mat)), each = nrow(mat)))\n    if (facet) {\n        # drop cells with 'weight < min_prop'\n        df <- df[df$weight >= min_prop, ]\n        \n        # set aesthetics\n        x <- \"id\"\n        f <- facet_wrap(~group, ncol = ncol, scales = \"free_x\")\n    } else {\n        # get topic medians\n        df <- aggregate(weight ~ group + topic, data = df, FUN = median)\n        \n        # set aesthetics\n        x <- \"group\"\n        f <- NULL\n    }\n    # fix topic order\n    df$topic <- factor(df$topic, seq_along(unique(y)))\n\n    # render plot\n    ggplot(df, aes(\n        .data[[x]], .data$topic, col = .data$weight, size = .data$weight)) +\n        f + geom_point() +\n        guides(col = guide_legend(override.aes = list(size = 2))) +\n        scale_size_continuous(range = c(0, 3)) +\n        scale_color_continuous(low = \"lightgrey\", high = \"#3d2bff\") +\n        xlab(if (facet) x) +\n        theme_bw() +\n        theme(\n            panel.grid = element_blank(),\n            legend.key.size = unit(0.5, \"lines\"),\n            plot.title = element_text(hjust = 0.5),\n            axis.text.x = element_text(angle = 45, hjust = 1))\n}\n\n"
  },
  {
    "path": "R/runDeconvolution.R",
    "content": "#' @name runDeconvolution\n#' @rdname runDeconvolution\n#' @title Run Deconvolution using NNLS model\n#'\n#' @aliases runDeconvolution\n#'\n#' @description This function takes in the mixture data, the trained model & the\n#'   topic profiles and returns the proportion of each cell type within each\n#'    mixture\n#'\n#' @param x mixture dataset. Can be a numeric matrix,\n#'   \\code{SingleCellExperiment} or \\code{SpatialExperiment}\n#' @param mod object as obtained from trainNMF.\n#' @param ref object of class matrix containing the topic profiles for each cell\n#'  type as obtained from trainNMF.\n#' @param slot If the object is of class \\code{SpatialExperiment} indicates \n#'   matrix to use. By default \"counts\".\n#' @inheritParams SPOTlight\n#'\n#' @return base a list where the first element is a list giving the NMF model and\n#'   the second is a matrix containing the topic profiles learnt.\n#'\n#' @author Marc Elosua Bayes, Zach DeBruine, and Helena L Crowell\n#'\n#' @examples\n#' set.seed(321)\n#' # mock up some single-cell, mixture & marker data\n#' sce <- mockSC(ng = 200, nc = 10, nt = 3)\n#' spe <- mockSP(sce)\n#' mgs <- getMGS(sce)\n#'\n#' res <- trainNMF(\n#'     x = sce,\n#'     y = rownames(spe),\n#'     groups = sce$type,\n#'     mgs = mgs,\n#'     weight_id = \"weight\",\n#'     group_id = \"type\",\n#'     gene_id = \"gene\")\n#' # Run deconvolution\n#' decon <- runDeconvolution(\n#'     x = spe,\n#'     mod = res[[\"mod\"]],\n#'     ref = res[[\"topic\"]])\nNULL\n\n#' @rdname runDeconvolution\n#' @importFrom Matrix colSums\n#' @export\nrunDeconvolution <- function(\n    x,\n    mod,\n    ref,\n    scale = TRUE,\n    min_prop = 0.01,\n    verbose = TRUE,\n    slot = \"counts\",\n    L1_nnls_topics = 0,\n    L2_nnls_topics = 0,\n    L1_nnls_prop = 0,\n    L2_nnls_prop = 0,\n    threads = 0,\n    ...) {\n\n    # Class checks\n    stopifnot(\n        # Check x inputs\n        is.matrix(x) | is(x, \"DelayedMatrix\") | is(x, \"dgCMatrix\") |\n            is(x, \"SingleCellExperiment\") |\n            is(x, \"SpatialExperiment\"),\n        # Check mod inputs\n        is.list(mod),\n        # check ref\n        is.matrix(ref),\n        # Check slot name\n        is.character(slot), length(slot) == 1,\n        # Check scale and verbose\n        is.logical(scale), length(scale) == 1,\n        is.logical(verbose), length(verbose) == 1,\n        # Check min_prop numeric\n        is.numeric(min_prop), length(min_prop) == 1,\n        min_prop >= 0, min_prop <= 1\n    )\n\n    # Extract expression matrix\n    if (!is.matrix(x))\n        x <- .extract_counts(x, slot)\n\n    # Get topic profiles for mixtures\n    mat <- .pred_hp(\n        x = x, mod = mod, scale = scale, verbose = verbose,\n        L1_nnls = L1_nnls_topics, L2_nnls = L2_nnls_topics, threads = threads)\n    \n    if (verbose) message(\"Deconvoluting mixture data...\")\n    # Need to scale because the matrix is also scaled to 1 with the RCPP\n    # approach to speed it up\n    ref_scale <- t(t(ref) / colSums(ref))\n    # Check if there is a column with all NAs after scaling -\n    # happens when whole column is 0s\n    ref_na <- is.na(ref_scale)\n    if (sum(ref_na) > 1)\n        # Set topics with NAs as all 0s\n        ref_scale[, which(colSums(ref_na) == nrow(ref_na))] <- 0\n    \n    # The below predict_nmf function does the equivalent to\n    # pred <- t(mat) %*% t(ref_scale)\n    pred <- predict_nmf(\n        A_ = as(mat, \"dgCMatrix\"),\n        w = ref_scale,\n        L1 = L1_nnls_prop,\n        L2 = L2_nnls_prop,\n        threads = threads)\n    rownames(pred) <- rownames(ref_scale)\n    colnames(pred) <- colnames(mat)\n\n    # Proportions within each spot\n    res <- prop.table(pred, 2)\n\n    # 1- t(ref_scale) %*% pred map pred to mat using ref_scale\n    # 2- Check the differences between the original and re-mapped matrix\n    # 3- sum the errors for each spot (column)\n    # t(ref_scale) is a topic x celltype matrix\n    # pred is a celltype x spot matrix\n    # mat is a topic x spot matrix\n    err_mat <- (mat - ref_scale %*% pred)^2\n    err <- colSums(err_mat) / colSums(mat)^2\n    # names(err) <- colnames(res)\n\n    return(list(\"mat\" = t(res), \"res_ss\" = err))\n}\n\n"
  },
  {
    "path": "R/trainNMF.R",
    "content": "#' @name trainNMF\n#' @rdname trainNMF\n#' @title train NMF model\n#'\n#' @aliases trainNMF\n#'\n#' @description This is the training function used by SPOTLight. This function\n#'   takes in single cell expression data, trains the model and learns topic\n#'    profiles for each cell type\n#' \n#' @param x single-cell dataset. Can be a numeric matrix, Can be a\n#'   numeric matrix or \\code{SingleCellExperiment}.\n#' @param y Null if you want to train the model with all the genes in the SC\n#'    data or a character vector with the rownames of the mixture dataset to \n#'    subset the gene set used to the intersection between them.\n#' @param slot_sc If the object is of class \\code{SingleCellExperiment} \n#'   indicates matrix to use. By default \"counts\".\n\n#' @inheritParams SPOTlight\n#'\n#' @return a list where the first element is a list with the NMF model\n#'   information and the second is a matrix containing the topic profiles\n#'   learnt per cell type.\n#'\n#' @author Marc Elosua Bayes & Helena L Crowell\n#'\n#' @examples\n#' set.seed(321)\n#' # mock up some single-cell, mixture & marker data\n#' sce <- mockSC(ng = 200, nc = 10, nt = 3)\n#' spe <- mockSP(sce)\n#' mgs <- getMGS(sce)\n#'\n#' res <- trainNMF(\n#'     x = sce,\n#'     y = rownames(spe),\n#'     groups = sce$type,\n#'     mgs = mgs,\n#'     weight_id = \"weight\",\n#'     group_id = \"type\",\n#'     gene_id = \"gene\")\n#' # Get NMF model\n#' res[[\"mod\"]]\n#' # Get topic profiles\n#' res[[\"topic\"]]\nNULL\n\n#' @rdname trainNMF\n\n# Key here to load t & Matrix so sparse matrices can be transposed\n#' @importFrom Matrix Matrix t\n#' @export\ntrainNMF <- function(\n    x,\n    y = NULL,\n    groups = NULL,\n    mgs,\n    n_top = NULL,\n    gene_id = \"gene\",\n    group_id = \"cluster\",\n    weight_id = \"weight\",\n    hvg = NULL,\n    scale = TRUE,\n    verbose = TRUE,\n    L1_nmf = 0,\n    L2_nmf = 0,\n    tol = 1e-05,\n    maxit = 100,\n    threads = 0,\n    slot_sc = \"counts\",\n    ...) {\n    \n    if (is.null(n_top))\n        n_top <- max(table(mgs[[group_id]]))\n    ids <- c(gene_id, group_id, weight_id)\n    \n    # convert mgs to dataframe if it is not already\n    if (!is.data.frame(mgs)) {\n      # check.names=FALSE to ensure the ids specified by the user are unchanged\n      mgs <- data.frame(mgs, check.names = FALSE)\n    }\n    \n    stopifnot(\n        is.numeric(x) | is(x, \"dgCMatrix\") |\n            is(x, \"SingleCellExperiment\") |\n            is(x, \"DelayedMatrix\"), \n        (is.vector(y) & is.character(y)) | is.null(y),\n        is.character(ids), length(ids) == 3, ids %in% names(mgs),\n        is.null(groups) | length(groups) == ncol(x),\n        is.logical(scale), length(scale) == 1,\n        is.logical(verbose), length(verbose) == 1,\n        is.numeric(L1_nmf), length(L1_nmf) == 1,\n        is.numeric(L2_nmf), length(L2_nmf) == 1,\n        is.numeric(tol), length(tol) == 1)\n    \n    # Set groups if x is SCE or SE and groups is NULL \n    if (is.null(groups))\n        groups <- .set_groups_if_null(x)\n\n    groups <- as.character(groups)\n\n    # Check mgs is a dataframe or conver it to a df\n    if (!is.data.frame(mgs)) {\n        if (is(mgs, \"tibble\") || is(mgs, \"list\")) {\n            mgs <- as.data.frame(mgs)\n        } else stop(\"'mgs' should be a 'data.frame'\")\n    }\n    \n    # Stop if at least one of the groups doesn't have marker genes\n    stopifnot(groups %in% mgs[[group_id]])\n\n    # Extract expression matrices for x and y\n    if (!is.matrix(x) & !is(x, \"dgCMatrix\"))\n        x <- .extract_counts(x, slot_sc)\n    \n    # Make sure matrix is sparse\n    # convert matrix to dgCMatrix, \n    # if it is already then nothing is done\n    x <- as(x, \"dgCMatrix\")\n    \n    # Set y no rownames X if NULL\n    if (is.null(y))\n        y <- rownames(x)\n    \n    # select genes in mgs or hvg\n    if (!is.null(hvg)) {\n        # Select union of genes between markers and HVG\n        mod_genes <- union(unique(mgs[[gene_id]]), hvg)\n    } else {\n        # Select genes from the marker genes only\n        mod_genes <- unique(mgs[[gene_id]])\n    }\n\n    # Select intersection between interest and present in x (sce) & y (spe)\n    mod_genes <- intersect(mod_genes, intersect(rownames(x), y))\n    \n    # drop features that are undetected in single-cell and/or mixture data\n    x <- .filter(x[mod_genes, ], y)\n    \n    mgs <- mgs[mgs[[gene_id]] %in% rownames(x), ]\n\n    # scale to unit variance (optional)\n    if (scale) {\n        if (verbose) message(\"Scaling count matrix\")\n        x <- .scale_uv(x)\n    }\n\n    # capture start time\n    t0 <- Sys.time()\n\n    # set model rank to number of groups\n    rank <- length(unique(groups))\n\n    # Get seeding matrices\n    if (verbose) message(\"Seeding NMF model...\")\n    hw <- .init_nmf(x, groups, mgs, n_top, gene_id, group_id, weight_id)\n    # w_init <- .init_nmf(x, groups, mgs, n_top, gene_id, group_id, weight_id)\n    \n    if (verbose) message(\"Training NMF model...\") \n    \n    # call to C++ routine\n    mod <- run_nmf(x, t(x), tol, maxit, verbose, L1_nmf, L2_nmf, threads, t(hw$W))\n    \n    # Change nmfX to topic_X\n    colnames(mod$w) <- paste0(\"topic_\", seq_len(ncol(mod$w)))\n    rownames(mod$h) <- paste0(\"topic_\", seq_len(nrow(mod$h)))\n    rownames(mod$w) <- rownames(x)\n    colnames(mod$h) <- colnames(x)\n\n    \n    # capture stop time\n    t1 <- Sys.time()\n\n    # print runtimes\n    if (verbose) {\n        dt <- round(difftime(t1, t0, units = \"mins\"), 2)\n        message(\"Time for training: \", dt, \"min\")\n    }\n\n    # Extract NMFfit to list for consistency with RcppML\n    # mod <- .extract_nmf(mod, hw$W)\n    \n    # get topic profiles per cell type\n    topic <- .topic_profiles(mod, groups)\n\n    return(list(\"mod\" = mod, \"topic\" = topic))\n}\n"
  },
  {
    "path": "R/utils.R",
    "content": "#' @importFrom sparseMatrixStats rowSds\n.scale_uv <- function(x) {\n    sds <- rowSds(x, na.rm = TRUE)\n    # TODO find a more efficient way of scaling the matrix\n    # t1 <- t(scale(t(x), center = FALSE, scale = sds))\n    # Scale by gene (each row by its sd) for unit variance\n    t1 <- x / sds\n    t1\n}\n\n#' @importFrom Matrix Matrix\n.init_nmf <- function(x,\n    groups,\n    mgs,\n    n_top = NULL,\n    gene_id = \"gene\",\n    group_id = \"cluster\",\n    weight_id = \"weight\") {\n    # check validity of input arguments\n    if (is.null(n_top)) {\n        n_top <- max(table(mgs[[group_id]]))\n    }\n    stopifnot(\n        is.character(gene_id), length(gene_id) == 1,\n        is.character(group_id), length(group_id) == 1,\n        is.character(weight_id), length(weight_id) == 1,\n        c(gene_id, group_id, weight_id) %in% names(mgs),\n        is.numeric(n_top), length(n_top) == 1, round(n_top) == n_top)\n\n    ng <- nrow(x)\n    nc <- ncol(x)\n    names(ks) <- ks <- unique(groups)\n\n    # subset 'n_top' features\n    mgs <- split(mgs, mgs[[group_id]])\n    mgs <- lapply(mgs, function(df) {\n        o <- order(df[[weight_id]], decreasing = TRUE)\n        n <- ifelse(nrow(df) < n_top, nrow(df), n_top)\n        df[o, ][seq_len(n), ]\n    })\n\n    # subset unique features\n    # mgs <- lapply(ks, function(k) {\n    #     g1 <- mgs[[k]][[gene_id]]\n    #     g2 <- unlist(lapply(mgs[ks != k], `[[`, gene_id))\n    #     mgs[[k]][!g1 %in% g2, , drop = FALSE]\n    # })\n\n    # W is of dimension (#groups)x(#features) with W(i,j)\n    # equal to weight if j is marker for i, and ~0 otherwise\n    W <- vapply(ks, function(k) {\n        w <- numeric(ng) + 1e-12\n        names(w) <- rownames(x)\n        ws <- mgs[[k]][[weight_id]]\n        w[mgs[[k]][[gene_id]]] <- ws\n        return(w)\n    }, numeric(ng))\n    \n    # H is of dimension (#groups)x(#samples) with H(i,j)\n    # equal to 1 if j is in i, and ~0 otherwise\n    cs <- split(seq_len(nc), groups)\n    H <- t(vapply(ks, function(k) {\n        h <- numeric(nc) + 1e-12\n        h[cs[[k]]] <- 1\n        return(h)\n    }, numeric(nc)))\n    \n    tp <- paste0(\"topic_\", seq_len(length(ks)))\n    dimnames(W) <- list(rownames(x), tp)\n    dimnames(H) <- list(tp, colnames(x))\n    return(list(\"W\" = W, \"H\" = H))\n}\n\n#' .init_nmf <- function(x,\n#'     groups,\n#'     mgs,\n#'     n_top = NULL,\n#'     gene_id = \"gene\",\n#'     group_id = \"cluster\",\n#'     weight_id = \"weight\") {\n#'     # check validity of input arguments\n#'     if (is.null(n_top)) {\n#'         n_top <- max(table(mgs[[group_id]]))\n#'     }\n#'     stopifnot(\n#'         is.character(gene_id), length(gene_id) == 1,\n#'         is.character(group_id), length(group_id) == 1,\n#'         is.character(weight_id), length(weight_id) == 1,\n#'         c(gene_id, group_id, weight_id) %in% names(mgs),\n#'         is.numeric(n_top), length(n_top) == 1, round(n_top) == n_top)\n#'     \n#'     ng <- nrow(x)\n#'     nc <- ncol(x)\n#'     names(ks) <- ks <- unique(groups)\n#'     \n#'     # subset 'n_top' features\n#'     mgs <- split(mgs, mgs[[group_id]])\n#'     mgs <- lapply(mgs, function(df) {\n#'         o <- order(df[[weight_id]], decreasing = TRUE)\n#'         n <- ifelse(nrow(df) < n_top, nrow(df), n_top)\n#'         df[o, ][seq_len(n), ]\n#'     })\n#'     \n#'     # subset unique features\n#'     mgs <- lapply(ks, function(k) {\n#'         g1 <- mgs[[k]][[gene_id]]\n#'         g2 <- unlist(lapply(mgs[ks != k], `[[`, gene_id))\n#'         mgs[[k]][!g1 %in% g2, , drop = FALSE]\n#'     })\n#'     \n#'     # W is of dimension (#groups)x(#features) with W(i,j)\n#'     # equal to weight if j is marker for i, and ~0 otherwise\n#'     W <- vapply(ks, function(k) {\n#'         w <- numeric(ng) + 1e-12\n#'         names(w) <- rownames(x)\n#'         ws <- mgs[[k]][[weight_id]]\n#'         w[mgs[[k]][[gene_id]]] <- ws\n#'         return(w)\n#'     }, numeric(ng))\n#'     \n#'     # there is no need to initialize H\n#'     tp <- paste0(\"topic_\", seq_len(length(ks)))\n#'     dimnames(W) <- list(rownames(x), tp)\n#'     return(W)\n#' }\n\n#' Filter features from expression matrix\n#'\n#' Remove undetected features and optionally keep only shared features\n#' between the expression matrix and a reference set of features.\n#'\n#' @param x Expression matrix to filter\n#' @param y Vector of feature names to keep (optional)\n#'\n#' @return Filtered expression matrix\n#'\n#' @details This function:\n#' \\itemize{\n#' \\item Removes features with zero expression across all samples\n#' \\item Optionally filters to keep only features present in both datasets\n#' \\item Ensures a minimum of 10 features remain after filtering\n#' }\n#'\n#' @importFrom Matrix Matrix rowSums\n.filter <- function(x, y) {\n    # remove undetected features\n    .fil <- function(.) {\n        i <- rowSums(.) > 0\n        .[i, , drop = FALSE]\n    }\n    x <- .fil(x)\n    \n    # keep only shared features\n    if (!is.null(y))\n        x <- x[intersect(rownames(x), y), ]\n    \n    if (nrow(x) < 10) {\n        stop(\n            \"Insufficient number of features shared\",\n            \" between single-cell and mixture dataset.\")\n    }\n    return(x)\n}\n\n\n#' @importFrom sparseMatrixStats colMedians\n.topic_profiles <- function(mod, groups) {\n    # Treat mod differently if it comes from NMF or RcppML\n    df <- data.frame(t(mod$h))\n    dfs <- split(df, groups)\n    res <- vapply(\n        dfs, function(df)\n            colMedians(as.matrix(df)),\n        numeric(ncol(df))\n    )\n    rownames(res) <- paste0(\"topic_\", seq_len(nrow(res)))\n    return(t(res))\n}\n\n\n#' @importFrom sparseMatrixStats rowSums2\n.pred_hp <- function(\n        x, mod, scale = TRUE, verbose = TRUE,\n        L1_nnls = 0, L2_nnls = 0, threads = 0\n    ) {\n    W <- mod$w\n    # remove all genes that are all 0s\n    g0 <- rowSums2(x) > 0\n    # Return a warning about genes being removed\n    if (!all(g0) & verbose)\n        message(\"Removing genes in mixture matrix that are all 0s\")\n    x <- x[g0, ]\n    \n    # Subset to shared genes between SP and SC\n    if (verbose)\n        message(\"Keep intersection of genes between W and mixture matrix\")\n    gi <- intersect(rownames(W), rownames(x))\n    x <- x[gi, ]\n    W <- W[gi, ]\n    \n    # Check there are enough shared features\n    if (nrow(x) < 10) {\n        stop(\n            \"Insufficient number of features, <10, shared\",\n            \" between trained model and mixture dataset.\")\n    }\n    if (scale) {\n        x <- .scale_uv(x)\n    }\n    \n    # TODO sometimes this can predict all to 0 if not scaled\n    # If I do this we get the same since colSums(W) = 1 for all coummns\n    # Use a very very mild regularization at this step\n    # TODO revert back to native RCPP code works\n    y <- predict_nmf(as(x, \"dgCMatrix\"), t(W), L1_nnls, L2_nnls, threads)\n    # y <- RcppML::project(\n    #   A = as(x, \"dgCMatrix\"),\n    #   w = W,\n    #   L1 = L1_nnls,\n    #   nonneg = TRUE)\n    \n    # TODO set up a test to deal when a column in y is all 0s, meaning all the topics are 0 for that cell type\n    \n    # Assign names\n    rownames(y) <- rownames(mod$h)\n    colnames(y) <- colnames(x)\n    return(y)\n}\n\n# Test if a package is installed\n# x is a stringr or vector of strings of packages names\n# to test if they are installed\n.test_installed <- function(x) {\n    # Check which packages aren't installed\n    t <- vapply(x, function(i)\n        isFALSE(requireNamespace(i, quietly = TRUE)), numeric(1))\n    x <- x[t == 1]\n\n    if (length(x) > 0) {\n        x <- paste(x, collapse = \", \")\n        stop(\"Please install package/s: \", x)\n    }\n}\n\n# Helper function to substitute the S4 method.\n# This function takes in an object of class accepted in SPOTlight, it\n# extracts the count/expression matrix specified and returns a matrix\n.extract_counts <- function(x, slot) {\n    # Iterate over all the accepted classes and return expression matrix\n\n    # Extract count matrix from object\n    if (is(x, \"SpatialExperiment\") | is(x, \"SingleCellExperiment\")) {\n        .test_installed(c(\"SummarizedExperiment\"))\n        \n        # Stop if there are no images or the name selected doesn't exist\n        stopifnot(\n            # Stop if there are no images\n            !is.null(SummarizedExperiment::assayNames(x)),\n            # Stop if the image doesn't exist\n            slot %in% SummarizedExperiment::assayNames(x),\n            # Return error if there are no colnames in the object\n            !is.null(colnames(x))\n        )\n        ## Extract SCE-SE coordinates\n        x <- SummarizedExperiment::assay(x, slot)\n    }\n    \n    # Process expression matrix\n    if (is(x, \"DelayedMatrix\")) {\n        # Convert to matrix\n        rn <- rownames(x)\n        cn <- colnames(x)\n        x <- Matrix(x, sparse = TRUE, nrow = nrow(x), ncol = ncol(x))\n        rownames(x) <- rn\n        colnames(x) <- cn\n    } else if (is(x, \"dgCMatrix\") | is.matrix(x)) {\n        x\n    } else {\n        stop(\"Couldn't extract counts. Please check class(x) is a\n        SingleCellExpriment, SpatialExperiment, matrix, DelayedMatrix\n        or dgCMatrix.\")\n    }\n    return(x)\n    \n}\n\n# Take an array representing an image and plot it with ggplot2\n#' @import ggplot2\n#' @importFrom grid rasterGrob unit\n.plot_image <- function(x) {\n    # Check necessary packages are installed and if not STOP\n    .test_installed(c(\"grid\", \"ggplot2\"))\n    \n    x <- grid::rasterGrob(x,\n        interpolate = FALSE,\n        width = grid::unit(1, \"npc\"),\n        height = grid::unit(1, \"npc\"))\n    \n    ggplot() +\n        annotation_custom(\n            grob = x,\n            xmin = 0,\n            xmax = ncol(x$raster),\n            ymin = 0,\n            ymax = nrow(x$raster)) + \n        coord_fixed(\n            xlim = c(0, ncol(x$raster)),\n            ylim = c(0, nrow(x$raster))) + \n        theme_void()\n        # theme_classic()\n}\n\n# Extract image and convert it to array from allowed classes\n.extract_image <- function(x, slice = NULL) {\n    # Iterate over all the accepted classes and convert the image to array\n    if (is.character(x)) {\n        .test_installed(c(\"jpeg\", \"png\"))\n        \n        # Check if the file exists\n        stopifnot(file.exists(x))\n        \n        # Check the file is in the right format\n        typ <- c(\"jpg\", \"jpeg\", \"png\")\n        pat <- paste0(\".\", typ, \"$\")\n        idx <- vapply(pat, grepl, x = x, logical(1), ignore.case = TRUE)\n        if (!any(idx)) {\n            stop(\"'x' should be of file type JPG, JPEG or PNG\")\n        }\n        \n        # Read file\n        x <- switch(typ[idx],\n            png = png::readPNG(x),\n            jpeg::readJPEG(x))\n        \n    } else if (is(x, \"SpatialExperiment\")) {\n\n        .test_installed(c(\"SpatialExperiment\"))\n        \n        # Stop if there are no images or the name selected doesn't exist\n        stopifnot(\n            !is.null(SpatialExperiment::getImg(x)),\n            slice %in% SpatialExperiment::imgData(x)[1, \"sample_id\"]\n        )\n        \n        # If image is null use the first slice\n        if (is.null(slice)) \n            slice <- SpatialExperiment::imgData(x)[1, \"sample_id\"]\n        \n        # Convert to raster\n        x <- SpatialExperiment::imgRaster(x, sample_id = slice)\n        x <- as.matrix(x)\n    } else {\n        stop(\"Couldn't extract image, See ?plotImage for valid image inputs.\")\n    }\n    return(x)\n}\n\n# When assigning cells to groups in trainNMF and SPOTlight if groups is set to\n# NULL use the cell identities/labels. If it is not a Seurat or SCE return error\n#' @importFrom SingleCellExperiment colLabels\n.set_groups_if_null <- function(x) {\n\n    ## SCE ##\n    if (is(x, \"SingleCellExperiment\")) {\n        # Extract idents\n        idents <- SingleCellExperiment::colLabels(x)\n        if (is.null(idents)) {\n            stop(\"SingleCellExperiment::colLabels(x) is NULL\")\n        } else {\n            warning(\"Grouping cells into celltypes\n                    by SingleCellExperiment::colLabels(x)\")\n            groups <- as.character(idents)\n        }\n    ## other ##\n    } else {\n        stop(\"Parameter groups needs to be defined.\")\n    }\n    groups\n}\n\n# Helper function to extract elements of interest from objects NMFfit\n# (NMF package) and nmf (RcppML) and returns a list with relevant information\n# consistent between both of them\n# .extract_nmf <- function(mod, smtx) {\n#     if (is(mod, \"NMFfit\")) {\n#         mod <- list(\n#             \"w\" = NMF::basis(mod),\n#             \"d\" = NULL,\n#             \"h\" = NMF::coef(mod),\n#             \"misc\" = list(\n#                 \"tol\" = NULL,\n#                 \"iter\" = mod@extra$iteration,\n#                 \"runtime\" = mod@runtime,\n#                 \"mse\" = NULL,\n#                 \"w_init\" = smtx)\n#         )\n#     } else if (is.list(mod)) {\n#         mod <- list(\n#             \"w\" = mod$w,\n#             \"d\" = mod$d,\n#             \"h\" = mod$h,\n#             \"misc\" = list(\n#                 \"tol\" = NULL,\n#                 \"iter\" = NULL,\n#                 \"runtime\" = NULL,\n#                 \"mse\" = NULL,\n#                 \"w_init\" = NULL)\n#         )\n#     } else {\n#         stop(\"mod is neither an 'NMFfit' or 'nmf' object \")\n#     }\n#     \n#     return(mod)\n# }\n "
  },
  {
    "path": "README.md",
    "content": "# Welcome to `SPOTlight` <img src=\"inst/extdata/SPOTlight.png\" width=\"200\" align=\"right\"/>\n\n### We are currently on the process of submitting SPOTlight to bioconductor and there have been some styling changes on this branch compared to previous releases. If you want to use the version we are currently submitting feel free to look at the updated vignette [here](https://github.com/MarcElosua/SPOTlight/blob/main/vignettes/SPOTlight_kidney.Rmd). If you want to keep using the previous versions, you can still find it in the [spotlight-0.1.7 branch](https://github.com/MarcElosua/SPOTlight/tree/spotlight-0.1.7) and follow the previous [vignette](https://marcelosua.github.io/SPOTlight/).\n\n`SPOTlight` provides a tool that enables the deconvolution of mixtures of cells from a single-cell reference. Originally developed for 10X's Visium - spatial transcriptomics- technology, it can be used for all technologies that output mixtures of cells. It is compatible with Bioconductor's `SingleCellExperiment` and `SpatialExperiment` classes. Furthermore, the package also provides visualization tools to assess the results of the deconvolution. Briefly, `SPOTlight` is based on finding topic profile signatures, by means of an NMFreg model, for each cell type and then optimizing the cell types proportions to fit the mixture we want to deconvolute.\n\n<img src=\"vignettes/schematic.png\" width=\"600\"/>\n\n## Installation\n\n``` r\ninstall.packages(\"BiocManager\")\nBiocManager::install(\"SPOTlight\")\n# Or the devel version\nBiocManager::install(\"SPOTlight\", version = \"devel\")\n```\n\nAlternatively, you can install it from GitHub using the [devtools](https://github.com/hadley/devtools) package.\n\n``` r\ninstall.packages(\"devtools\")\nlibrary(devtools)\ninstall_github(\"https://github.com/MarcElosua/SPOTlight\")\n```\n\n### References\n\n-   Elosua-Bayes M, Nieto P, Mereu E, Gut I, Heyn H (2021): *SPOTlight: seeded NMF regression to deconvolute spatial transcriptomics spots with single-cell transcriptomes*. **Nucleic Acids Res** 49(9):e50. <doi:10.1093/nar/gkab043>.\n\n------------------------------------------------------------------------\n\n### Contributors\n\nSPOTlight was originally developed by [Marc Elosua Bayes](https://github.com/MarcElosua/) and has received substantial additional contributions from [Helena L. Crowell](https://github.com/HelenaLC) and [Zach DeBruine](https://github.com/zdebruine).\n\n### Issues - Ideas?\n\n`SPOTlight` is still under active development. We greatly welcome (and highly encourage!) all feedback, bug reports and suggestions for improvement [here](https://github.com/MarcElosua/SPOTlight/issues). **Please make sure to raise issues with a [reproducible example](https://www.tidyverse.org/help/) and the output of your `sessionInfo()`.**\n"
  },
  {
    "path": "man/SPOTlight.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/SPOTlight.R\n\\name{SPOTlight}\n\\alias{SPOTlight}\n\\title{Deconvolution of mixture using single-cell data}\n\\usage{\nSPOTlight(\n  x,\n  y,\n  groups = NULL,\n  mgs,\n  n_top = NULL,\n  gene_id = \"gene\",\n  group_id = \"cluster\",\n  weight_id = \"weight\",\n  hvg = NULL,\n  scale = TRUE,\n  min_prop = 0.01,\n  verbose = TRUE,\n  slot_sc = \"counts\",\n  slot_sp = \"counts\",\n  L1_nmf = 0,\n  L2_nmf = 0,\n  maxit = 100,\n  threads = 0,\n  tol = 1e-05,\n  L1_nnls_topics = 0,\n  L2_nnls_topics = 0,\n  L1_nnls_prop = 0,\n  L2_nnls_prop = 0,\n  ...\n)\n}\n\\arguments{\n\\item{x, y}{single-cell and mixture dataset, respectively. Can be a\nnumeric matrix or \\code{SingleCellExperiment}..}\n\n\\item{groups}{character vector of group labels for cells in \\code{x}.\nWhen \\code{x} is a \\code{SingleCellExperiment}.,\ndefaults to \\code{colLabels(x)} and \\code{Idents(x)}, respectively.\nMake sure groups is not a Factor.}\n\n\\item{mgs}{\\code{data.frame} or \\code{DataFrame} of marker genes.\nMust contain columns holding gene identifiers, group labels and\nthe weight (e.g., logFC, -log(p-value) a feature has in a given group.}\n\n\\item{n_top}{integer scalar specifying the number of markers to select per\ngroup. By default NULL uses all the marker genes to initialize the model.}\n\n\\item{gene_id, group_id, weight_id}{character specifying the column\nin \\code{mgs} containing gene identifiers, group labels and weights,\nrespectively.}\n\n\\item{hvg}{character vector containing hvg to include in the model.\nBy default NULL.}\n\n\\item{scale}{logical specifying whether to scale single-cell counts to unit\nvariance. This gives the user the option to normalize the data beforehand\nas you see fit (CPM, FPKM, ...) when passing a matrix or specifying the\nslot from where to extract the count data.}\n\n\\item{min_prop}{scalar in [0,1] setting the minimum contribution\nexpected from a cell type in \\code{x} to observations in \\code{y}.\nBy default 0.}\n\n\\item{verbose}{logical. Should information on progress be reported?}\n\n\\item{slot_sc, slot_sp}{If the object is of class \\code{SingleCellExperiment}\nindicates matrix to use. By default \"counts\".}\n\n\\item{L1_nmf}{LASSO penalty in the range (0, 1] for NMF,\nlarger values increase sparsity of each factor}\n\n\\item{L2_nmf}{RUDGE penalty >0 for NMF,\nlarger values increase angle between factors and thus sparsity.}\n\n\\item{maxit}{maximum number of NMF iterations for fitting}\n\n\\item{threads}{number of threads to use, default 0 (all threads)}\n\n\\item{tol}{tolerance of the NMF model at convergence, the Pearson correlation \ndistance between models across consecutive iterations (1e-5 is publication quality)}\n\n\\item{L1_nnls_topics, L1_nnls_prop}{LASSO penalty in the range (0, 1] for NNLS\nwhen computing cell type topic profiles and cell type proportions\nrespectively. Larger values remove \"noisy\" contributions more aggressively.}\n\n\\item{L2_nnls_topics, L2_nnls_prop}{RIDGE penalty >0 for NNLS when computing\ncell type topic profiles and cell type proportions respectively.\nLarger values remove \"noisy\" contributions more aggressively.}\n\n\\item{...}{additional parameters.}\n}\n\\value{\na numeric matrix with rows corresponding to samples\n  and columns to groups\n}\n\\description{\nThis is the backbone function which takes in single cell\n  expression data to deconvolute spatial transcriptomics spots.\n}\n\\details{\nSPOTlight uses a Non-Negative Matrix Factorization approach to learn\n  which genes are important for each cell type. In order to drive the\n  factorization and give more importance to cell type marker genes we\n  previously compute them and use them to initialize the basis matrix. This\n  initialized matrices will then be used to carry out the factorization with\n  the single cell expression data. Once the model has learn the topic\n  profiles for each cell type we use non-negative least squares (NNLS) to\n  obtain the topic contributions to each spot. Lastly, NNLS is again used to\n  obtain the proportion of each cell type for each spot by finding the\n  fitting the single-cell topic profiles to the spots topic contributions.\n}\n\\examples{\nlibrary(scater)\nlibrary(scran)\n\n# Use Mock data\n# Refer to the vignette for a full workflow\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\nres <- SPOTlight(\n    x = counts(sce),\n    y = counts(spe),\n    groups = as.character(sce$type),\n    mgs = mgs,\n    hvg = NULL,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\")\n}\n\\author{\nMarc Elosua Bayes, Zach DeBruine, and Helena L Crowell\n}\n"
  },
  {
    "path": "man/data.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/data.R\n\\name{data}\n\\alias{data}\n\\alias{mockSC}\n\\alias{mockSP}\n\\alias{getMGS}\n\\title{Synthetic single-cell, mixture and marker data}\n\\usage{\nmockSC(ng = 200, nc = 50, nt = 3)\n\nmockSP(x, ns = 100)\n\ngetMGS(x, n_top = 10)\n}\n\\arguments{\n\\item{ng, nc, nt, ns}{integer scalar specifying the number\nof genes, cells, types (groups) and spots to simulate.}\n\n\\item{x}{Single cell experiment object}\n\n\\item{n_top}{integer specifying the number of\nmarker genes to extract for each cluster.}\n}\n\\value{\n\\itemize{\n\\item{\\code{mockSC} returns a \\code{SingleCellExperiment}\n  with rows = genes, columns = single cells, and cell metadata\n  (\\code{colData}) column \\code{type} containing group identifiers.}\n\\item{\\code{mockSP} returns a \\code{SingleCellExperiment}\n  with rows = genes, columns = single cells, and cell metadata\n  (\\code{colData}) column \\code{type} containing group identifiers.}\n\\item{\\code{getMGS} returns a \\code{data.frame} with \\code{nt*n_top}\n  rows and 3 columns: gene and type (group) identifier, as well as the\n  gene's weight = the proportion of counts accounted for by that type.}\n}\n}\n\\description{\n\\code{mockSC/mockSP()} are designed to generate synthetic single-cell and\nspatial mixture data. These data are not meant to represent biologically\nmeaningful use-cases, but are solely intended for use in examples, for\nunit-testing, and to demonstrate \\code{SPOTlight}'s general functionality.\nFinally, \\code{.get_mgs()} implements a statistically naive way to select\nmarkers from single-cell data; again, please don't use it in real life.\n}\n\\examples{\nsce <- mockSC()\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n}\n"
  },
  {
    "path": "man/dot-filter.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/utils.R\n\\name{.filter}\n\\alias{.filter}\n\\title{.init_nmf <- function(x,\n    groups,\n    mgs,\n    n_top = NULL,\n    gene_id = \"gene\",\n    group_id = \"cluster\",\n    weight_id = \"weight\") {\n    # check validity of input arguments\n    if (is.null(n_top)) {\n        n_top <- max(table(mgs[[group_id]]))\n    }\n    stopifnot(\n        is.character(gene_id), length(gene_id) == 1,\n        is.character(group_id), length(group_id) == 1,\n        is.character(weight_id), length(weight_id) == 1,\n        c(gene_id, group_id, weight_id) %in% names(mgs),\n        is.numeric(n_top), length(n_top) == 1, round(n_top) == n_top)\n    \n    ng <- nrow(x)\n    nc <- ncol(x)\n    names(ks) <- ks <- unique(groups)\n    \n    # subset 'n_top' features\n    mgs <- split(mgs, mgs[[group_id]])\n    mgs <- lapply(mgs, function(df) {\n        o <- order(df[[weight_id]], decreasing = TRUE)\n        n <- ifelse(nrow(df) < n_top, nrow(df), n_top)\n        df[o, ][seq_len(n), ]\n    })\n    \n    # subset unique features\n    mgs <- lapply(ks, function(k) {\n        g1 <- mgs[[k]][[gene_id]]\n        g2 <- unlist(lapply(mgs[ks != k], `[[`, gene_id))\n        mgs[[k]][!g1 %in% g2, , drop = FALSE]\n    })\n    \n    # W is of dimension (#groups)x(#features) with W(i,j)\n    # equal to weight if j is marker for i, and ~0 otherwise\n    W <- vapply(ks, function(k) {\n        w <- numeric(ng) + 1e-12\n        names(w) <- rownames(x)\n        ws <- mgs[[k]][[weight_id]]\n        w[mgs[[k]][[gene_id]]] <- ws\n        return(w)\n    }, numeric(ng))\n    \n    # there is no need to initialize H\n    tp <- paste0(\"topic_\", seq_len(length(ks)))\n    dimnames(W) <- list(rownames(x), tp)\n    return(W)\n}\nFilter features from expression matrix}\n\\usage{\n.filter(x, y)\n}\n\\arguments{\n\\item{x}{Expression matrix to filter}\n\n\\item{y}{Vector of feature names to keep (optional)}\n}\n\\value{\nFiltered expression matrix\n}\n\\description{\nRemove undetected features and optionally keep only shared features\nbetween the expression matrix and a reference set of features.\n}\n\\details{\nThis function:\n\\itemize{\n\\item Removes features with zero expression across all samples\n\\item Optionally filters to keep only features present in both datasets\n\\item Ensures a minimum of 10 features remain after filtering\n}\n}\n"
  },
  {
    "path": "man/plotCorrelationMatrix.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plotCorrelationMatrix.R\n\\name{plotCorrelationMatrix}\n\\alias{plotCorrelationMatrix}\n\\title{Plot Correlation Matrix}\n\\usage{\nplotCorrelationMatrix(\n  x,\n  cor.method = c(\"pearson\", \"kendall\", \"spearman\"),\n  insig = c(\"blank\", \"pch\"),\n  colors = c(\"#6D9EC1\", \"white\", \"#E46726\"),\n  hc.order = TRUE,\n  p.mat = TRUE,\n  ...\n)\n}\n\\arguments{\n\\item{x}{numeric matrix with rows = samples and columns = cell types\nMust have at least two rows and two columns.}\n\n\\item{cor.method}{Method to use for correlation:\nc(\"pearson\", \"kendall\", \"spearman\"). By default pearson.}\n\n\\item{insig}{character, specialized insignificant correlation coefficients,\n\"pch\", \"blank\" (default). If \"blank\", wipe away the corresponding glyphs;\nif \"pch\", add characters (see pch for details) on corresponding glyphs.}\n\n\\item{colors}{character vector with three colors indicating the lower, mid,\nand high color. By default c(\"#6D9EC1\", \"white\", \"#E46726\").}\n\n\\item{hc.order}{logical value. If TRUE, correlation matrix will be\nhc.ordered using hclust function.}\n\n\\item{p.mat}{logical value. If TRUE (default), correlation significance\nwill be used. If FALSE arguments sig.level, insig, pch, pch.col,\npch.cex are invalid.}\n\n\\item{...}{additional graphical parameters passed to \\code{ggcorrplot}.}\n}\n\\value{\n\\code{ggplot} object\n}\n\\description{\nThis function takes in a matrix with the predicted proportions\n  for each spot and returns a correlation matrix between cell types.\n}\n\\examples{\nset.seed(321)\nx <- replicate(m <- 25, runif(10, 0, 1))\nrownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\ncolnames(x) <- paste0(\"type\", seq_len(ncol(x)))\n\n# The most basic example\nplotCorrelationMatrix(x = x)\n\n# Showing the non-significant correlatinos\nplotCorrelationMatrix(x = x, insig = \"pch\")\n\n# A more elaborated\nplotCorrelationMatrix(\n    x = x,\n    hc.order = FALSE,\n    type = \"lower\",\n    outline.col = \"lightgrey\",\n    method = \"circle\",\n    colors = c(\"#64ccc9\", \"#b860bd\", \"#e3345d\"))\n\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "man/plotImage.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plotImage.R\n\\name{plotImage}\n\\alias{plotImage}\n\\title{Plot JP(E)G/PNG/Raster/RGB images}\n\\arguments{\n\\item{x}{A variety of objects can be passed: character string corresponding\nto an image file path, valid file types are JPG, JPEG and PNG. It can also\ntake as input objects of class raster and RGB arrays. It can also take\na SpatialExperiment from which the image will be extracted.}\n\n\\item{slice}{Character string indicating which image slice to use when\nSpatialExperiment objects are passed. By default uses the first\nslice available.}\n}\n\\value{\n\\code{ggplot} object\n}\n\\description{\nThis function takes in an image-related object - path to\n  JP(E)G/PNG file, raster object, RGBarray. It returns a ggplot object with\n  the selected image.\n}\n\\examples{\n# Filename\npath <- file.path(\n  system.file(package = \"SPOTlight\"), \n  \"extdata/SPOTlight.png\")\nplotImage(x = path)\n# array\npng_img <- png::readPNG(path)\nplotImage(png_img)\n# SpatialExperiment\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "man/plotInteractions.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plotInteractions.R\n\\name{plotInteractions}\n\\alias{plotInteractions}\n\\alias{plotHeatmap}\n\\alias{plotNetwork}\n\\title{Plot group interactions}\n\\usage{\nplotInteractions(\n  x,\n  which = c(\"heatmap\", \"network\"),\n  metric = c(\"prop\", \"jaccard\"),\n  min_prop = 0,\n  ...\n)\n}\n\\arguments{\n\\item{x}{numeric matrix with rows = samples and columns = groups.\nMust have at least one row and column, and at least two columns.}\n\n\\item{which}{character string specifying the type of\nvisualization: one of \"heatmap\" or \"network\".}\n\n\\item{metric}{character string specifying which metric to show:\none of \"prop\" or \"jaccard\".}\n\n\\item{min_prop}{scalar specifying the value above which\na group is considered to be contributing to a given sample.\nAn interaction between groups i and j is counted for sample s\nonly when both x[s, i] and x[s, j] fall above \\code{min_prop}.}\n\n\\item{...}{additional graphical parameters passed\nto \\code{plot.igraph} when \\code{which = \"network\"}\n(see \\code{?igraph.plotting}).}\n}\n\\value{\nbase R plot\n}\n\\description{\nThis function takes in a matrix with the predicted proportions\n  for each spot and returns a heatmap \\code{which = plotHeatmap} or a network\n   graph \\code{which = plotNetwork} to show which cells are interacting\n   spatially.\n}\n\\examples{\nlibrary(ggplot2)\nmat <- replicate(8, rnorm(100, runif(1, -1, 1)))\n# Basic example\nplotInteractions(mat)\n\n### heatmap ###\n# This returns a ggplot object that can be modified as such\nplotInteractions(mat, which = \"heatmap\") +\n    scale_fill_gradient(low = \"#f2e552\", high = \"#850000\") +\n    labs(title = \"Interaction heatmap\", fill = \"proportion\")\n        \n### Network ###\n# specify node names\nnms <- letters[seq_len(ncol(mat))]\nplotInteractions(mat, which = \"network\", vertex.label = nms)\n\n# or set column names instead\ncolnames(mat) <- nms\nplotInteractions(mat, which = \"network\")\n\n# pass additional graphical parameters for aesthetics\nplotInteractions(mat,\n    which = \"network\",\n    edge.color = \"cyan\",\n    vertex.color = \"pink\",\n    vertex.label.font = 2,\n    vertex.label.color = \"maroon\")\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "man/plotSpatialScatterpie.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plotSpatialScatterpie.R\n\\name{plotSpatialScatterpie}\n\\alias{plotSpatialScatterpie}\n\\title{Spatial scatterpie}\n\\usage{\nplotSpatialScatterpie(\n  x,\n  y,\n  cell_types = colnames(y),\n  img = FALSE,\n  slice = NULL,\n  scatterpie_alpha = 1,\n  pie_scale = 0.4,\n  degrees = NULL,\n  axis = NULL,\n  ...\n)\n}\n\\arguments{\n\\item{x}{Object containing the spots coordinates, it can be an object of class\nSpatialExperiment, dataframe or matrix. For the latter two\nrownames should have the spot barcodes to match x. If a matrix it has to\nof dimensions nrow(y) x 2 where the columns are the x and y coordinates\nin that order.}\n\n\\item{y}{Matrix or dataframe containing the deconvoluted spots. rownames\nneed to be the spot barcodes to match to x.}\n\n\\item{cell_types}{Vector of cell type names to plot. By default uses the\ncolumn names of y.}\n\n\\item{img}{Logical TRUE or FALSE indicating whether to plot the image or not.\nObjects of classes accepted by \\code{plotImage} can also be passed and\nthat image will be used. By default FALSE.}\n\n\\item{slice}{Character string indicating which slice to plot if img is TRUE.\nBy default uses the first image.}\n\n\\item{scatterpie_alpha}{Numeric scalar to set the alpha of the pie charts.\nBy default 1.}\n\n\\item{pie_scale}{Numeric scalar to set the size of the pie charts.\nBy default 0.4.}\n\n\\item{degrees}{From SpatialExperiment rotateImg. For clockwise (degrees > 0)\nand counter-clockwise (degrees < 0) rotation. By default NULL.}\n\n\\item{axis}{From SpatialExperiment mirrorImg. When a SpatialExperiment object\nis passed as the image return the mirror image. For horizontal (axis = \"h\")\n and vertical (axis = \"v\") mirroring. By default NULL.}\n\n\\item{...}{additional parameters to geom_scatterpie}\n}\n\\value{\n\\code{ggplot} object\n}\n\\description{\nThis function takes in the coordinates of the spots and the\n  proportions of the cell types within each spot. It returns a plot where\n  each spot is a piechart showing proportions of the cell type composition.\n}\n\\examples{\nset.seed(321)\n\n# Coordinates\nx <- replicate(2, rnorm(100))\nrownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\ncolnames(x) <- c(\"imagecol\", \"imagerow\")\n\n# Proportions\ny <- replicate(m <- 5, runif(nrow(x), 0, 1))\ny <- prop.table(y, 1)\n\nrownames(y) <- paste0(\"spot\", seq_len(nrow(y)))\ncolnames(y) <- paste0(\"type\", seq_len(ncol(y)))\n\n(plt <- plotSpatialScatterpie(x = x, y = y))\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "man/plotTopicProfiles.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plotTopicProfiles.R\n\\name{plotTopicProfiles}\n\\alias{plotTopicProfiles}\n\\title{Plot NMF topic profiles}\n\\usage{\nplotTopicProfiles(x, y, facet = FALSE, min_prop = 0.01, ncol = NULL)\n}\n\\arguments{\n\\item{x}{\\code{list} object obtained from \\code{SPOTlight}.}\n\n\\item{y}{vector of group labels. Should be of length\n\\code{ncol(res_lvl1$NMF$h)}.}\n\n\\item{facet}{logical indicating whether to stratify by group.\nIf \\code{FALSE} (default), weights will be the median across cells\nfor each group (point = topic weight for a given cell type).\nIf \\code{TRUE}, cell-specific weights will be shown\n(point = topic weight of a given cell).}\n\n\\item{min_prop}{scalar in [0,1]. When \\code{facet = TRUE},\nonly cells with a weight > \\code{min_prop} will be included.}\n\n\\item{ncol}{integer scalar specifying the number of facet columns.}\n}\n\\value{\n\\code{ggplot} object\n}\n\\description{\nThis function takes in the fitted NMF model and returns the\n  topic profiles learned for each cell \\code{facet = FALSE} or cell type\n  \\code{facet = TRUE}. Ideal training will return all the cell from the same\n  cell type to share a unique topic profile.\n}\n\\examples{\nlibrary(ggplot2)\nx <- mockSC()\ny <- mockSP(x)\nz <- getMGS(x)\n\nres <- SPOTlight(x, y,\n    groups = x$type,\n    mgs = z,\n    group_id = \"type\",\n    verbose = FALSE)\n\nplotTopicProfiles(res[[3]], x$type, facet = TRUE)\nplotTopicProfiles(res[[3]], x$type, facet = FALSE)\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "man/runDeconvolution.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/runDeconvolution.R\n\\name{runDeconvolution}\n\\alias{runDeconvolution}\n\\title{Run Deconvolution using NNLS model}\n\\usage{\nrunDeconvolution(\n  x,\n  mod,\n  ref,\n  scale = TRUE,\n  min_prop = 0.01,\n  verbose = TRUE,\n  slot = \"counts\",\n  L1_nnls_topics = 0,\n  L2_nnls_topics = 0,\n  L1_nnls_prop = 0,\n  L2_nnls_prop = 0,\n  threads = 0,\n  ...\n)\n}\n\\arguments{\n\\item{x}{mixture dataset. Can be a numeric matrix,\n\\code{SingleCellExperiment} or \\code{SpatialExperiment}}\n\n\\item{mod}{object as obtained from trainNMF.}\n\n\\item{ref}{object of class matrix containing the topic profiles for each cell\ntype as obtained from trainNMF.}\n\n\\item{scale}{logical specifying whether to scale single-cell counts to unit\nvariance. This gives the user the option to normalize the data beforehand\nas you see fit (CPM, FPKM, ...) when passing a matrix or specifying the\nslot from where to extract the count data.}\n\n\\item{min_prop}{scalar in [0,1] setting the minimum contribution\nexpected from a cell type in \\code{x} to observations in \\code{y}.\nBy default 0.}\n\n\\item{verbose}{logical. Should information on progress be reported?}\n\n\\item{slot}{If the object is of class \\code{SpatialExperiment} indicates \nmatrix to use. By default \"counts\".}\n\n\\item{L1_nnls_topics, L1_nnls_prop}{LASSO penalty in the range (0, 1] for NNLS\nwhen computing cell type topic profiles and cell type proportions\nrespectively. Larger values remove \"noisy\" contributions more aggressively.}\n\n\\item{L2_nnls_topics, L2_nnls_prop}{RIDGE penalty >0 for NNLS when computing\ncell type topic profiles and cell type proportions respectively.\nLarger values remove \"noisy\" contributions more aggressively.}\n\n\\item{threads}{number of threads to use, default 0 (all threads)}\n\n\\item{...}{additional parameters.}\n}\n\\value{\nbase a list where the first element is a list giving the NMF model and\n  the second is a matrix containing the topic profiles learnt.\n}\n\\description{\nThis function takes in the mixture data, the trained model & the\n  topic profiles and returns the proportion of each cell type within each\n   mixture\n}\n\\examples{\nset.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\nres <- trainNMF(\n    x = sce,\n    y = rownames(spe),\n    groups = sce$type,\n    mgs = mgs,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\")\n# Run deconvolution\ndecon <- runDeconvolution(\n    x = spe,\n    mod = res[[\"mod\"]],\n    ref = res[[\"topic\"]])\n}\n\\author{\nMarc Elosua Bayes, Zach DeBruine, and Helena L Crowell\n}\n"
  },
  {
    "path": "man/trainNMF.Rd",
    "content": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/trainNMF.R\n\\name{trainNMF}\n\\alias{trainNMF}\n\\title{train NMF model}\n\\usage{\ntrainNMF(\n  x,\n  y = NULL,\n  groups = NULL,\n  mgs,\n  n_top = NULL,\n  gene_id = \"gene\",\n  group_id = \"cluster\",\n  weight_id = \"weight\",\n  hvg = NULL,\n  scale = TRUE,\n  verbose = TRUE,\n  L1_nmf = 0,\n  L2_nmf = 0,\n  tol = 1e-05,\n  maxit = 100,\n  threads = 0,\n  slot_sc = \"counts\",\n  ...\n)\n}\n\\arguments{\n\\item{x}{single-cell dataset. Can be a numeric matrix, Can be a\nnumeric matrix or \\code{SingleCellExperiment}.}\n\n\\item{y}{Null if you want to train the model with all the genes in the SC\ndata or a character vector with the rownames of the mixture dataset to \nsubset the gene set used to the intersection between them.}\n\n\\item{groups}{character vector of group labels for cells in \\code{x}.\nWhen \\code{x} is a \\code{SingleCellExperiment}.,\ndefaults to \\code{colLabels(x)} and \\code{Idents(x)}, respectively.\nMake sure groups is not a Factor.}\n\n\\item{mgs}{\\code{data.frame} or \\code{DataFrame} of marker genes.\nMust contain columns holding gene identifiers, group labels and\nthe weight (e.g., logFC, -log(p-value) a feature has in a given group.}\n\n\\item{n_top}{integer scalar specifying the number of markers to select per\ngroup. By default NULL uses all the marker genes to initialize the model.}\n\n\\item{gene_id, group_id, weight_id}{character specifying the column\nin \\code{mgs} containing gene identifiers, group labels and weights,\nrespectively.}\n\n\\item{hvg}{character vector containing hvg to include in the model.\nBy default NULL.}\n\n\\item{scale}{logical specifying whether to scale single-cell counts to unit\nvariance. This gives the user the option to normalize the data beforehand\nas you see fit (CPM, FPKM, ...) when passing a matrix or specifying the\nslot from where to extract the count data.}\n\n\\item{verbose}{logical. Should information on progress be reported?}\n\n\\item{L1_nmf}{LASSO penalty in the range (0, 1] for NMF,\nlarger values increase sparsity of each factor}\n\n\\item{L2_nmf}{RUDGE penalty >0 for NMF,\nlarger values increase angle between factors and thus sparsity.}\n\n\\item{tol}{tolerance of the NMF model at convergence, the Pearson correlation \ndistance between models across consecutive iterations (1e-5 is publication quality)}\n\n\\item{maxit}{maximum number of NMF iterations for fitting}\n\n\\item{threads}{number of threads to use, default 0 (all threads)}\n\n\\item{slot_sc}{If the object is of class \\code{SingleCellExperiment} \nindicates matrix to use. By default \"counts\".}\n\n\\item{...}{additional parameters.}\n}\n\\value{\na list where the first element is a list with the NMF model\n  information and the second is a matrix containing the topic profiles\n  learnt per cell type.\n}\n\\description{\nThis is the training function used by SPOTLight. This function\n  takes in single cell expression data, trains the model and learns topic\n   profiles for each cell type\n}\n\\examples{\nset.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\nres <- trainNMF(\n    x = sce,\n    y = rownames(spe),\n    groups = sce$type,\n    mgs = mgs,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\")\n# Get NMF model\nres[[\"mod\"]]\n# Get topic profiles\nres[[\"topic\"]]\n}\n\\author{\nMarc Elosua Bayes & Helena L Crowell\n}\n"
  },
  {
    "path": "src/Makevars",
    "content": "# Standard portable configuration - let R handle LAPACK/BLAS\nPKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)\n# PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS)\nPKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -DEIGEN_INITIALIZE_MATRICES_BY_ZERO -DEIGEN_NO_DEBUG\nCXX_STD = CXX11"
  },
  {
    "path": "src/Makevars.win",
    "content": "PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)\r\nPKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) -DEIGEN_INITIALIZE_MATRICES_BY_ZERO -DEIGEN_NO_DEBUG\r\nCXX_STD = CXX11"
  },
  {
    "path": "src/RcppExports.cpp",
    "content": "// Generated by using Rcpp::compileAttributes() -> do not edit by hand\n// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393\n\n#include <RcppEigen.h>\n#include <Rcpp.h>\n\nusing namespace Rcpp;\n\n#ifdef RCPP_USE_GLOBAL_ROSTREAM\nRcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();\nRcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();\n#endif\n\n// predict_nmf\nEigen::MatrixXd predict_nmf(Rcpp::S4& A_, Eigen::MatrixXd& w, const double L1, const double L2, const int threads);\nRcppExport SEXP _SPOTlight_predict_nmf(SEXP A_SEXP, SEXP wSEXP, SEXP L1SEXP, SEXP L2SEXP, SEXP threadsSEXP) {\nBEGIN_RCPP\n    Rcpp::RObject rcpp_result_gen;\n    Rcpp::traits::input_parameter< Rcpp::S4& >::type A_(A_SEXP);\n    Rcpp::traits::input_parameter< Eigen::MatrixXd& >::type w(wSEXP);\n    Rcpp::traits::input_parameter< const double >::type L1(L1SEXP);\n    Rcpp::traits::input_parameter< const double >::type L2(L2SEXP);\n    Rcpp::traits::input_parameter< const int >::type threads(threadsSEXP);\n    rcpp_result_gen = Rcpp::wrap(predict_nmf(A_, w, L1, L2, threads));\n    return rcpp_result_gen;\nEND_RCPP\n}\n// run_nmf\nRcpp::List run_nmf(const Rcpp::S4& A_, const Rcpp::S4& At_, const double tol, const uint16_t maxit, const bool verbose, const double L1, const double L2, const uint16_t threads, Eigen::MatrixXd w);\nRcppExport SEXP _SPOTlight_run_nmf(SEXP A_SEXP, SEXP At_SEXP, SEXP tolSEXP, SEXP maxitSEXP, SEXP verboseSEXP, SEXP L1SEXP, SEXP L2SEXP, SEXP threadsSEXP, SEXP wSEXP) {\nBEGIN_RCPP\n    Rcpp::RObject rcpp_result_gen;\n    Rcpp::traits::input_parameter< const Rcpp::S4& >::type A_(A_SEXP);\n    Rcpp::traits::input_parameter< const Rcpp::S4& >::type At_(At_SEXP);\n    Rcpp::traits::input_parameter< const double >::type tol(tolSEXP);\n    Rcpp::traits::input_parameter< const uint16_t >::type maxit(maxitSEXP);\n    Rcpp::traits::input_parameter< const bool >::type verbose(verboseSEXP);\n    Rcpp::traits::input_parameter< const double >::type L1(L1SEXP);\n    Rcpp::traits::input_parameter< const double >::type L2(L2SEXP);\n    Rcpp::traits::input_parameter< const uint16_t >::type threads(threadsSEXP);\n    Rcpp::traits::input_parameter< Eigen::MatrixXd >::type w(wSEXP);\n    rcpp_result_gen = Rcpp::wrap(run_nmf(A_, At_, tol, maxit, verbose, L1, L2, threads, w));\n    return rcpp_result_gen;\nEND_RCPP\n}\n\nstatic const R_CallMethodDef CallEntries[] = {\n    {\"_SPOTlight_predict_nmf\", (DL_FUNC) &_SPOTlight_predict_nmf, 5},\n    {\"_SPOTlight_run_nmf\", (DL_FUNC) &_SPOTlight_run_nmf, 9},\n    {NULL, NULL, 0}\n};\n\nRcppExport void R_init_SPOTlight(DllInfo *dll) {\n    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);\n    R_useDynamicSymbols(dll, FALSE);\n}\n"
  },
  {
    "path": "src/nmf.cpp",
    "content": "// This C++ file contains a very fast NMF and NNLS implementation\n//\n// Author:  Zach DeBruine (zacharydebruine@gmail.com)\n// Source code largely derived from RcppML (github.com/zdebruine/RcppML)\n// \n// Subject to terms of GPL >=2 license\n\n#ifndef EIGEN_NO_DEBUG\n#define EIGEN_NO_DEBUG\n#endif\n\n#ifndef EIGEN_INITIALIZE_MATRICES_BY_ZERO\n#define EIGEN_INITIALIZE_MATRICES_BY_ZERO\n#endif\n\n//[[Rcpp::depends(RcppEigen)]]\n#include <RcppEigen.h>\n\n//[[Rcpp::plugins(openmp)]]\n#ifdef _OPENMP\n#include <omp.h>\n#endif\n\n// SPARSE MATRIX CLASS\nclass spmat {\n   public:\n    // public member objects\n    Rcpp::NumericVector x;\n    Rcpp::IntegerVector i, p, Dim;\n\n    // constructors\n    spmat(Rcpp::NumericVector x, Rcpp::IntegerVector i, Rcpp::IntegerVector p, Rcpp::IntegerVector Dim) : x(x), i(i), p(p), Dim(Dim) {}\n    spmat(const Rcpp::S4& s) {\n        if (!s.hasSlot(\"x\") || !s.hasSlot(\"i\") || !s.hasSlot(\"p\") || !s.hasSlot(\"Dim\"))\n            Rcpp::stop(\"provided object could not be converted to a sparse matrix in C++. Sparse matrices must generally be a Matrix::dgCMatrix\");\n\n        x = s.slot(\"x\");\n        i = s.slot(\"i\");\n        p = s.slot(\"p\");\n        Dim = s.slot(\"Dim\");\n    }\n    spmat() {}\n\n    size_t rows() { return Dim[0]; }\n    size_t cols() { return Dim[1]; }\n\n    // const column iterator\n    class InnerIterator {\n       public:\n        InnerIterator(spmat& ptr, int col) : ptr(ptr), col_(col), index(ptr.p[col]), max_index(ptr.p[col + 1]) {}\n        operator bool() const { return (index < max_index); }\n        InnerIterator& operator++() {\n            ++index;\n            return *this;\n        }\n        double& value() { return ptr.x[index]; }\n        int row() const { return ptr.i[index]; }\n\n       private:\n        spmat& ptr;\n        int col_, index, max_index;\n    };\n};\n\n// NMF HELPER FUNCTIONS\n// Pearson correlation between two matrices\ninline double cor(Eigen::MatrixXd& x, Eigen::MatrixXd& y) {\n    double x_i, y_i, sum_x = 0, sum_y = 0, sum_xy = 0, sum_x2 = 0, sum_y2 = 0;\n    const size_t n = x.size();\n    for (size_t i = 0; i < n; ++i) {\n        x_i = (*(x.data() + i));\n        y_i = (*(y.data() + i));\n        sum_x += x_i;\n        sum_y += y_i;\n        sum_xy += x_i * y_i;\n        sum_x2 += x_i * x_i;\n        sum_y2 += y_i * y_i;\n    }\n    return std::abs(1 - (n * sum_xy - sum_x * sum_y) / std::sqrt((n * sum_x2 - sum_x * sum_x) * (n * sum_y2 - sum_y * sum_y)));\n}\n\n// fast symmetric matrix multiplication, A * A.transpose() - double\nEigen::MatrixXd AAt(const Eigen::MatrixXd& A) {\n    Eigen::MatrixXd AAt = Eigen::MatrixXd::Zero(A.rows(), A.rows());\n    AAt.selfadjointView<Eigen::Lower>().rankUpdate(A);\n    AAt.triangularView<Eigen::Upper>() = AAt.transpose();\n    AAt.diagonal().array() += 1e-15;\n    return AAt;\n}\n\n// scale rows in w (or h) to sum to 1 and put previous rowsums in d\nvoid scale(Eigen::MatrixXd& w, Eigen::VectorXd& d) {\n    d = w.rowwise().sum();\n    d.array() += 1e-15;\n    for (size_t i = 0; i < w.rows(); ++i)\n        for (size_t j = 0; j < w.cols(); ++j)\n            w(i, j) /= d(i);\n};\n\n// calculate sort index of vector \"d\" in decreasing order\ninline std::vector<int> sort_index(const Eigen::VectorXd& d) {\n    std::vector<int> idx(d.size());\n    std::iota(idx.begin(), idx.end(), 0);\n    sort(idx.begin(), idx.end(), [&d](size_t i1, size_t i2) { return d[i1] > d[i2]; });\n    return idx;\n}\n\n// reorder rows in dynamic matrix \"x\" by integer vector \"ind\"\ninline Eigen::MatrixXd reorder_rows(const Eigen::MatrixXd& x, const std::vector<int>& ind) {\n    Eigen::MatrixXd x_reordered(x.rows(), x.cols());\n    for (unsigned int i = 0; i < ind.size(); ++i)\n        x_reordered.row(i) = x.row(ind[i]);\n    return x_reordered;\n}\n\n// reorder elements in vector \"x\" by integer vector \"ind\"\ninline Eigen::VectorXd reorder(const Eigen::VectorXd& x, const std::vector<int>& ind) {\n    Eigen::VectorXd x_reordered(x.size());\n    for (unsigned int i = 0; i < ind.size(); ++i)\n        x_reordered(i) = x(ind[i]);\n    return x_reordered;\n}\n\n// NNLS SOLVER\n// optimized and modified from github.com/linxihui/NNLM \"c_nnls\" function\ninline void nnls(Eigen::MatrixXd& a, Eigen::VectorXd& b, Eigen::MatrixXd& h, const size_t sample) {\n    double tol = 1;\n    for (uint8_t it = 0; it < 100 && (tol / b.size()) > 1e-8; ++it) {\n        tol = 0;\n        for (size_t i = 0; i < h.rows(); ++i) {\n            double diff = b(i) / a(i, i);\n            if (-diff > h(i, sample)) {\n                if (h(i, sample) != 0) {\n                    b -= a.col(i) * -h(i, sample);\n                    tol = 1;\n                    h(i, sample) = 0;\n                }\n            } else if (diff != 0) {\n                h(i, sample) += diff;\n                b -= a.col(i) * diff;\n                tol += std::abs(diff / (h(i, sample) + 1e-15));\n            }\n        }\n    }\n}\n\n// NMF PROJECTION\nvoid c_predict(spmat A, const Eigen::MatrixXd& w, Eigen::MatrixXd& h, const double L1, const double L2, const int threads) {\n    Eigen::MatrixXd a = AAt(w);\n    a.diagonal().array() *= (1 - L2);\n#ifdef _OPENMP\n#pragma omp parallel for num_threads(threads)\n#endif\n    for (size_t i = 0; i < h.cols(); ++i) {\n        if (A.p[i] == A.p[i + 1]) continue;\n        Eigen::VectorXd b = Eigen::VectorXd::Zero(h.rows());\n        for (spmat::InnerIterator it(A, i); it; ++it)\n            b += it.value() * w.col(it.row());\n        b.array() -= L1;\n        nnls(a, b, h, i);\n    }\n}\n\n//[[Rcpp::export(rng = FALSE)]]\nEigen::MatrixXd predict_nmf(Rcpp::S4& A_, Eigen::MatrixXd& w, const double L1, const double L2, const int threads) {\n    spmat A(A_);\n    Eigen::MatrixXd h(w.rows(), A.cols());\n    if (w.rows() == A.rows() && w.cols() != A.rows())\n        w = w.transpose();\n\n    c_predict(A, w, h, L1, L2, threads);\n    return h;\n}\n\n// NMF FUNCTION\n//[[Rcpp::export(rng = FALSE)]]\nRcpp::List run_nmf(const Rcpp::S4& A_, const Rcpp::S4& At_, const double tol, const uint16_t maxit, const bool verbose,\n                   const double L1, const double L2, const uint16_t threads, Eigen::MatrixXd w) {\n    spmat A(A_), At(At_);\n\n    // check validity of parameters\n    if (L1 >= 1 || L2 >= 1 || L1 < 0 || L2 < 0)\n        Rcpp::stop(\"L1 and L2 must be strictly in the range (0,1]\");\n\n    if (A.rows() != At.cols() || A.cols() != At.rows())\n        Rcpp::stop(\"A and At are not transpose-identical\");\n\n    if (w.rows() == A.rows())\n        w = w.transpose();\n    else if (w.cols() != A.rows())\n        Rcpp::stop(\"dimensions of A and w are incompatible!\");\n\n    if (verbose) Rprintf(\"\\n%4s | %8s \\n---------------\\n\", \"iter\", \"tol\");\n    Eigen::MatrixXd h(w.rows(), A.cols());\n    Eigen::VectorXd d(w.rows());\n\n    double tol_ = 1;\n\n    // alternating least squares updates of h and then w\n    for (uint16_t iter_ = 0; iter_ < maxit && tol_ > tol; ++iter_) {\n        Eigen::MatrixXd w_it = w;\n        c_predict(A, w, h, L1, L2, threads);  // update h\n        scale(h, d);\n        Rcpp::checkUserInterrupt();\n        c_predict(At, h, w, L1, L2, threads);  // update w\n        scale(w, d);\n        // calculate tolerance of the model fit to detect convergence\n        tol_ = cor(w, w_it);  // absolute correlation between \"w\" across consecutive iterations\n        if (verbose) Rprintf(\"%4d | %8.2e\\n\", iter_ + 1, tol_);\n        Rcpp::checkUserInterrupt();\n    }\n\n    // sort factors in the model by diagonal weight\n    std::vector<int> indx = sort_index(d);\n    w = reorder_rows(w, indx);\n    d = reorder(d, indx);\n    h = reorder_rows(h, indx);\n\n    return Rcpp::List::create(\n        Rcpp::Named(\"w\") = w.transpose(),\n        Rcpp::Named(\"d\") = d,\n        Rcpp::Named(\"h\") = h);\n}"
  },
  {
    "path": "tests/testthat/test-SPOTlight-steps.R",
    "content": "library(SPOTlight)\nlibrary(SingleCellExperiment)\n# library(RcppML)\nset.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\n# Function to run the checks\n.checks <- function(decon, sce) {\n    mtr <- decon[[1]]\n    rss <- decon[[2]]\n    expect_is(decon, \"list\")\n    expect_is(mtr, \"matrix\")\n    expect_is(rss, \"numeric\")\n    expect_identical(ncol(mtr), length(unique(sce$type)))\n    expect_identical(nrow(mtr), length(rss))\n}\n\n###############################\n#### Run SPOTlight wrapper ####\n###############################\nset.seed(687)\nres1 <- SPOTlight(\n    x = counts(sce),\n    y = counts(spe),\n    groups = sce$type,\n    mgs = mgs,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\",\n    pnmf = \"NMF\"\n)\n\n################################\n#### Run SPOTlight by steps ####\n################################\nset.seed(687)\n# Train NMF\nmod_ls <- trainNMF(\n    x = counts(sce),\n    y = rownames(spe),\n    groups = sce$type,\n    mgs = mgs,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\"\n)\n\nres2 <- runDeconvolution(\n    x = spe,\n    mod = mod_ls[[\"mod\"]],\n    ref = mod_ls[[\"topic\"]]\n)\n\n# NMF ----\ntest_that(\"SPOTlight vs SPOTlight-steps\", {\n\n    # basis and coef should be the same between SPOTlight and SPOTlight-steps\n    expect_true(all(res1[[\"NMF\"]]$w == mod_ls[[\"mod\"]]$w))\n    expect_true(all(res1[[\"NMF\"]]$h == res2[[\"NMF\"]]$h))\n\n    # Deconvolution results are the same\n    # expect_true(all(res1[[\"mat\"]] == res2[[\"mat\"]]))\n    expect_true(mean(abs(res1[[\"mat\"]] - res2[[\"mat\"]])) < 0.01)\n\n    # actually check the estimates are legit\n    # (MSE < 0.1 compared to simulated truth)\n    sim <- S4Vectors::metadata(spe)[[1]]\n    mse <- mean((res2[[\"mat\"]] - sim)^2)\n    expect_true(mse < 0.01)\n\n})\n\n"
  },
  {
    "path": "tests/testthat/test-SPOTlight.R",
    "content": "set.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n# Create SpatialExperiment\nspe1 <- SpatialExperiment::SpatialExperiment(\n    assay = list(counts = SingleCellExperiment::counts(spe)),\n    colData = SummarizedExperiment::colData(spe))\n\n# Function to run the checks\n.checks <- function(res, sce) {\n    mtr <- res[[1]]\n    rss <- res[[2]]\n    mod <- res[[3]]\n    expect_is(res, \"list\")\n    expect_is(mtr, \"matrix\")\n    expect_is(rss, \"numeric\")\n    expect_is(mod, \"list\")\n    expect_identical(ncol(mtr), length(unique(sce$type)))\n    expect_identical(sort(colnames(mtr)), sort(unique(as.character(sce$type))))\n    expect_identical(nrow(mtr), length(rss))\n    expect_identical(sort(rownames(mtr)), sort(names(rss)))\n}\n\n# .checks <- function(res, sce) {\n#     mod <- res[[1]]\n#     mtr <- res[[2]]\n#     expect_is(res, \"list\")\n#     expect_is(mtr, \"matrix\")\n#     expect_is(mod, \"list\")\n#     expect_identical(ncol(mtr), length(unique(sce$type)))\n#     expect_identical(nrow(mtr), ncol(mod$w))\n#     expect_identical(nrow(mtr), nrow(mod$h))\n# }\n\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# ----  Check SPOTlight x, y inputs  -------------------------------------------\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# .SPOTlight with SCE ----\ntest_that(\"SPOTlight x SCE rcpp\", {\n    res <- SPOTlight(\n        x = sce,\n        y = as.matrix(counts(spe)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    \n    .checks(res, sce)\n})\n\n# .SPOTlight with SPE ----\ntest_that(\"SPOTlight x SCE spatial rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = spe,\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n\n    .checks(res, sce)\n})\n\n# .SPOTlight with SPE ----\ntest_that(\"SPOTlight x SCE spatial rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = spe1,\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    \n    .checks(res, sce)\n})\n\n# .SPOTlight with sparse matrix sc ----\ntest_that(\"SPOTlight x dgCMatrix SC rcpp\", {\n    res <- SPOTlight(\n        x = Matrix::Matrix(counts(sce), sparse = TRUE),\n        y = as.matrix(counts(spe)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    .checks(res, sce)\n})\n\n# .SPOTlight with sparse matrix sp ----\ntest_that(\"SPOTlight x dgCMatrix SP rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = Matrix::Matrix(counts(spe), sparse = TRUE),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n\n    .checks(res, sce)\n})\n\n# .SPOTlight with sparse matrix sc ----\ntest_that(\"SPOTlight x DelayedMatrix SC rcpp\", {\n    res <- SPOTlight(\n        x = DelayedArray::DelayedArray(counts(sce)),\n        y = as.matrix(counts(spe)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    .checks(res, sce)\n})\n\n# .SPOTlight with sparse matrix sp ----\ntest_that(\"SPOTlight x DelayedMatrix SP rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = DelayedArray::DelayedArray(counts(sce)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n\n    .checks(res, sce)\n})\n\n# .SPOTlight with matrices in both ----\ntest_that(\"SPOTlight x matrices rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = as.matrix(counts(spe)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n\n    .checks(res, sce)\n})\n\n# .SPOTlight with matrices in both and HVG----\ntest_that(\"SPOTlight x hvg rcpp\", {\n    res <- SPOTlight(\n        x = as.matrix(counts(sce)),\n        y = as.matrix(counts(spe)),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\",\n        hvg = row.names(sce)[seq_len(50)]\n    )\n\n    .checks(res, sce)\n})\n\n\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# ----  Check SPOTlight x, y inputs with NMF  ----------------------------------\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# .SPOTlight with SCE ----\n# test_that(\"SPOTlight x SCE NMF\", {\n#     res <- SPOTlight(\n#         x = sce,\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with SPE ----\n# test_that(\"SPOTlight x SCE spatial NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = spe,\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with SPE ----\n# test_that(\"SPOTlight x SCE spatial NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = spe1,\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with Seurat SC ----\n# test_that(\"SPOTlight x SEC NMF\", {\n#     res <- SPOTlight(\n#         x = sec,\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with Seurat SP ----\n# test_that(\"SPOTlight x SEP NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = spe,\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with sparse matrix sc ----\n# test_that(\"SPOTlight x dgCMatrix SC NMF\", {\n#     res <- SPOTlight(\n#         x = Matrix::Matrix(counts(sce), sparse = TRUE),\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with sparse matrix sp ----\n# test_that(\"SPOTlight x dgCMatrix SP NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = Matrix::Matrix(counts(spe), sparse = TRUE),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with sparse matrix sc ----\n# test_that(\"SPOTlight x DelayedMatrix SC NMF\", {\n#     res <- SPOTlight(\n#         x = DelayedArray::DelayedArray(counts(sce)),\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with sparse matrix sp ----\n# test_that(\"SPOTlight x DelayedMatrix SP NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = DelayedArray::DelayedArray(counts(sce)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with matrices in both ----\n# test_that(\"SPOTlight x matrices NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # .SPOTlight with matrices in both and HVG----\n# test_that(\"SPOTlight x hvg NMF\", {\n#     res <- SPOTlight(\n#         x = as.matrix(counts(sce)),\n#         y = as.matrix(counts(spe)),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\",\n#         hvg = row.names(sce)[seq_len(50)]\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n"
  },
  {
    "path": "tests/testthat/test-plotCorrelationMatrix.R",
    "content": "set.seed(321)\nx <- replicate(m <- 25, runif(10, 0, 1))\n# Add an anticorrelated column\nx[, 24] <- seq(0, 1, length.out = 10)\nx[, 25] <- seq(1, 0, length.out = 10)\nrownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\ncolnames(x) <- paste0(\"type\", seq_len(ncol(x)))\n\n.checks <- function(p) {\n    expect_is(p, \"ggplot\")\n    expect_true(all(p$data$p >= 0))\n    expect_true(all(p$data$p <= 1))\n    expect_true(is.numeric(p$data$value))\n    expect_true(max(p$data$value) == 1)\n    expect_true(nrow(p$data) == m * m)\n}\n\n# plotCorrelationMatrix basic ----\ntest_that(\"plotCorrelationMatrix basic\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(x = x)\n    .checks(p)\n})\n\n# plotCorrelationMatrix() spearman correlation ----\ntest_that(\"plotCorrelationMatrix() spearman\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(\n        x = x,\n        cor.method = \"kendall\"\n    )\n    .checks(p)\n})\n\n# plotCorrelationMatrix() ----\ntest_that(\"plotCorrelationMatrix() insig\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(\n        x = x,\n        insig = \"pch\"\n    )\n\n    .checks(p)\n    # This adds an extra layer with the X on top of the insig\n    expect_true(length(p$layers) == 2)\n})\n\n# plotCorrelationMatrix() colors ----\ntest_that(\"plotCorrelationMatrix() colors\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(\n        x = x,\n        colors = c(\"#FF00FF\", \"#FFFFFF\", \"#000000\")\n    )\n\n    .checks(p)\n    g <- ggplot_build(p)\n\n    # max color\n    i <- which(p$data$value == max(p$data$value))[[1]]\n    expect_identical(g$data[[1]][i, ][, \"fill\"], \"#000000\")\n    # 0 color\n    j <- which(p$data$value == 0)[[1]]\n    expect_identical(g$data[[1]][j, ][, \"fill\"], \"#FFFFFF\")\n\n    # min color\n    k <- which(p$data$value == min(p$data$value))[[1]]\n    expect_identical(g$data[[1]][k, ][, \"fill\"], \"#FF00FF\")\n})\n\n# plotCorrelationMatrix() hc.order ----\ntest_that(\"plotCorrelationMatrix() hc.order\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(\n        x = x,\n        hc.order = FALSE\n    )\n\n    .checks(p)\n    # Make sure the order is no changed\n    expect_equal(as.character(p$data$Var1[seq_len(ncol(x))]), colnames(x))\n})\n\n# plotCorrelationMatrix() p.mat ----\ntest_that(\"plotCorrelationMatrix() p.mat\", {\n    # The most basic example\n    p <- plotCorrelationMatrix(\n        x = x,\n        p.mat = FALSE\n    )\n\n    # Make sure the p value is not computed\n    expect_is(p, \"ggplot\")\n    expect_true(is.numeric(p$data$value))\n    expect_true(max(p$data$value) == 1)\n    expect_true(nrow(p$data) == m * m)\n    expect_true(all(is.na(p$data$pvalue)))\n    expect_true(all(is.na(p$data$signif)))\n})\n"
  },
  {
    "path": "tests/testthat/test-plotImage.R",
    "content": "set.seed(321)\n# x_path <- paste0(system.file(package = \"SPOTlight\"), \"/extdata/image.png\")\n# x_path <- \"../../inst/extdata/SPOTlight.png\"\nx_path <- paste0(system.file(package = \"SPOTlight\"), \"/extdata/SPOTlight.png\")\n\n# plotImage() ----\ntest_that(\"plotImage path\", {\n    # image\n    x <- x_path\n    plt <- plotImage(x = x)\n    expect_true(is_ggplot(plt))\n})\n\n\n# plotImage() ----\ntest_that(\"plotImage array\", {\n    # image\n    x <- png::readPNG(x_path)\n    plt <- plotImage(x = x)\n    expect_true(is_ggplot(plt))\n})\n# Can't run this on Bioconductor since it doesn't accept github packages\n# test_that(\"plotImage Seurat\", {\n#     # if (!\"SeuratData\" %in% installed.packages()) {\n#     #       devtools::install_github(\"satijalab/seurat-data\")\n#       # }\n#     # image\n#     if (!\"stxBrain.SeuratData\" %in% suppressWarnings(SeuratData::InstalledData()$Dataset))\n#         suppressWarnings(SeuratData::InstallData(ds = \"stxBrain.SeuratData\"))\n# \n#     x <- suppressWarnings(SeuratData::LoadData(\n#         ds = \"stxBrain\",\n#         type = \"anterior1\"))\n# \n#     plt <- plotImage(x = x)\n#     expect_equal(class(plt)[1], \"gg\")\n# })\n\ntest_that(\"plotImage SPE\", {\n    # image\n    library(ExperimentHub)\n    eh <- ExperimentHub() # initialize hub instance\n    q <- query(eh, \"TENxVisium\") # retrieve 'TENxVisiumData' records\n    id <- q$ah_id[1] # specify dataset ID to load\n    x <- eh[[id]]\n\n    plt <- plotImage(x = x)\n\n    expect_true(is_ggplot(plt))\n})\n\n"
  },
  {
    "path": "tests/testthat/test-plotInteractions.R",
    "content": "# helper to record base R plot\n# plotNetwork() ----\n# record base R plot\n. <- \\(.) {\n    pdf(NULL)\n    dev.control(displaylist = \"enable\")\n    set.seed(1)\n    .\n    . <- recordPlot()\n    invisible(dev.off())\n    return(.)\n}\n\n# mock up some data\nset.seed(321)\nx <- replicate(m <- 10, rnorm(n <- 100, runif(1, -1, 1)))\n# Add columns to check characteristics of interest\nx[, 8] <- 1\nx[, 9] <- 1\nx[, 10] <- -1\n\ntest_that(\"plotInteractions(), which = 'heatmap', metric = default\", {\n    p <- plotInteractions(x, \"heatmap\")\n    expect_is(p, \"ggplot\")\n    expect_true(all(p$data$p >= 0))\n    expect_true(all(p$data$p <= 1))\n    expect_true(is.integer(p$data$n))\n    expect_true(nrow(p$data) == m * (m - 1) / 2)\n})\n\ntest_that(\"plotInteractions(), which = 'heatmap', metric = 'jaccard'\", {\n    p <- plotInteractions(x, \"heatmap\", \"jaccard\")\n    expect_is(p, \"ggplot\")\n    expect_true(all(p$data$p >= 0))\n    expect_true(all(p$data$p <= 1))\n    expect_true(is.integer(p$data$n))\n    expect_true(nrow(p$data) == m * (m - 1) / 2)\n})\n\ntest_that(\"plotInteractions(), which = 'heatmap', tunning\", {\n    p <- plotInteractions(x, \"heatmap\") +\n        scale_fill_gradient(low = \"#FFFF00\", high = \"#FF0000\")\n\n    # Same base checks\n    expect_is(p, \"ggplot\")\n    expect_true(all(p$data$p >= 0))\n    expect_true(all(p$data$p <= 1))\n    expect_true(is.integer(p$data$n))\n    expect_true(nrow(p$data) == m * (m - 1) / 2)\n\n    # Color checks\n    g <- ggplot_build(p)\n    d1 <- g$data[[1]]\n    d2 <- g$data[[2]]\n    # Access through tiles coordinates\n    # min <- d1[d1$x == max(d1$x) & d1$y == max(d1$y), \"fill\"]\n    # expect_equal(min, \"#FFFF00\")\n    expect_true(\"#FFFF00\" %in% d1$fill)\n    # max <- d1[d1$x == 7 & d1$y == 1, \"fill\"]\n    # expect_equal(max, \"#FF0000\")\n    expect_true(\"#FF0000\" %in% d1$fill)\n    # na <- d2[d2$x == 2 & d2$y == 1, \"fill\"]\n    # expect_equal(na, \"grey50\")\n    expect_true(\"grey50\" %in% d2$fill)\n})\n\n\ntest_that(\"plotInteractions(), which = 'network', metric = 'default'\", {\n    p <- .(plotInteractions(x, \"network\"))\n    expect_is(p, \"recordedplot\")\n    p[[1]][[6]][[2]]$col\n})\n\ntest_that(\"plotInteractions(), which = 'network', metric = 'jaccard'\", {\n    p <- .(plotInteractions(x, \"network\", \"jaccard\"))\n    expect_is(p, \"recordedplot\")\n    p[[1]][[6]][[2]]$col\n})\n\ntest_that(\"plotInteractions(), which = 'network', tunning\", {\n    p <- .(plotInteractions(\n        x,\n        which = \"network\",\n        edge.color = \"cyan\",\n        vertex.color = \"pink\",\n        vertex.label.font = 2,\n        vertex.label.color = \"maroon\"\n    ))\n    expect_is(p, \"recordedplot\")\n    # Test edge color\n    expect_equal(p[[1]][[6]][[2]]$col, \"cyan\")\n    # Vertex label color and font\n    # expect_equal(p[[1]][[10]][[2]][[9]], \"maroon\")\n    # expect_equal(p[[1]][[10]][[2]][[10]], 2)\n    # Vertex color\n    # expect_equal(p[[1]][[8]][[2]][[7]], \"pink\")\n})\n"
  },
  {
    "path": "tests/testthat/test-plotSpatialScatterpie.R",
    "content": "set.seed(321)\n# Coordinates\nx <- matrix(nrow = 10, data = c(seq_len(10), 10:1))\nrownames(x) <- paste0(\"spot\", seq_len(nrow(x)))\ncolnames(x) <- c(\"coord_x\", \"coord_y\")\n# Proportions\ny <- replicate(m <- 5, runif(10, 0, 1))\ny <- y / rowSums(y)\nrownames(y) <- paste0(\"spot\", seq_len(nrow(y)))\ncolnames(y) <- paste0(\"type\", seq_len(ncol(y)))\n# image\nimg <- paste0(system.file(package = \"SPOTlight\"), \"/extdata/SPOTlight.png\")\n\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie with matrix and bad colnames\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y\n    )\n    expect_true(is_ggplot(plt))\n})\n\ncolnames(x) <- c(\"imagecol\", \"imagerow\")\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie with matrix and bad colnames\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y\n    )\n    expect_true(is_ggplot(plt))\n})\n\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie - image\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y,\n        img = img\n    )\n    expect_true(is_ggplot(plt))\n})\n\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie - type subset\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y,\n        cell_types = colnames(y)[seq_len(3)]\n    )\n    expect_true(is_ggplot(plt))\n})\n\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie - alpha\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y,\n        scatterpie_alpha = 0.5\n    )\n\n    expect_true(is_ggplot(plt))\n    expect_lt(plt$layers[[1]]$aes_params$alpha, 1)\n})\n\n# plotSpatialScatterpie() ----\ntest_that(\"plotSpatialScatterpie - pie_scale\", {\n    plt <- plotSpatialScatterpie(\n        x = x,\n        y = y,\n        pie_scale = 0.1\n    )\n    expect_true(is_ggplot(plt))\n})\n\nlibrary(SpatialExperiment)\nexample(read10xVisium, echo = FALSE)\n# Proportions\nspe_y <- replicate(m <- 5, runif(ncol(spe), 0, 1))\nspe_y <- spe_y / rowSums(spe_y)\nrownames(spe_y) <- colnames(spe)\ncolnames(spe_y) <- paste0(\"type\", seq_len(ncol(spe_y)))\n\n# plotSpatialScatterpie() img TRUE----\ntest_that(\"plotSpatialScatterpie - image\", {\n    plt <- plotSpatialScatterpie(\n        x = spe,\n        y = spe_y,\n        img = TRUE\n    )\n    expect_true(is_ggplot(plt))\n    # Make sure there is an image\n    expect_true(is(plt$layers[[1]]$geom, \"GeomCustomAnn\"))\n})\n\n# plotSpatialScatterpie() img TRUE----\ntest_that(\"plotSpatialScatterpie - spots on image\", {\n    plt <- plotSpatialScatterpie(\n        x = spe,\n        y = spe_y,\n        img = TRUE\n    )\n    expect_true(is_ggplot(plt))\n    # Make sure there is an image\n    expect_true(is(plt$layers[[1]]$geom, \"GeomCustomAnn\"))\n    \n    # Check the spots are on within the image coordinates\n    x_y_min_max <- plt$layers[[1]]$geom_params\n    point_df <- plt$layers[[2]]$data\n    expect_true(max(point_df$coord_x) <= x_y_min_max$xmax)\n    expect_true(min(point_df$coord_x) >= x_y_min_max$xmin)\n    expect_true(max(point_df$coord_y) <= x_y_min_max$ymax)\n    expect_true(min(point_df$coord_y) >= x_y_min_max$ymin)\n})\n\n"
  },
  {
    "path": "tests/testthat/test-plotTopicProfiles.R",
    "content": "set.seed(123)\nx <- mockSC(nc = 50, nt = 3)\ny <- mockSP(x)\nz <- getMGS(x)\nres <- SPOTlight(\n    x,\n    y,\n    groups = x$type,\n    mgs = z,\n    group_id = \"type\",\n    verbose = FALSE)\n\ntest_that(\"plotTopicProfiles common\", {\n    p <- plotTopicProfiles(x = res[[3]], y = x$type, facet = FALSE, min_prop = 0.1)\n    expect_is(p, \"ggplot\")\n    expect_equal(nrow(p$data), 9)\n    expect_equal(sort(unique(p$data$group)), as.character(sort(unique(x$type))))\n    expect_equal(ncol(p$data), 3)\n    expect_equal(\n        as.character(sort(unique(p$data$topic))),\n        as.character(seq_len(length(unique(x$type)))))\n    g <- ggplot_build(p)\n    expect_true(all(c(\"#3D2BFF\", \"#D3D3D3\") %in% unique(g$data[[1]]$colour)))\n})\n\ntest_that(\"plotTopicProfiles facet\", {\n    p <- plotTopicProfiles(res[[3]], x$type, facet = TRUE, min_prop = 0.1)\n    expect_is(p, \"ggplot\")\n    expect_equal(nrow(p$data), 160)\n    expect_equal(ncol(p$data), 4)\n    g <- ggplot_build(p)\n    expect_true(all(c(\"#3D2BFF\", \"#4931FE\", \"#D3D3D3\") %in% unique(g$data[[1]]$colour)))\n})\n\n"
  },
  {
    "path": "tests/testthat/test-runDeconvolution.R",
    "content": "set.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n# Create SpatialExperiment\nspe1 <- SpatialExperiment::SpatialExperiment(\n    assay = list(counts = SingleCellExperiment::counts(spe)),\n    colData = SummarizedExperiment::colData(spe))\n\n# Function to run the checks\n.checks <- function(decon, sce, spe) {\n    mtr <- decon[[1]]\n    rss <- decon[[2]]\n    expect_is(decon, \"list\")\n    expect_is(mtr, \"matrix\")\n    expect_is(rss, \"numeric\")\n    expect_identical(ncol(mtr), length(unique(sce$type)))\n    expect_identical(sort(colnames(mtr)), sort(unique(as.character(sce$type))))\n    expect_identical(nrow(mtr), length(rss))\n    expect_identical(sort(rownames(mtr)), sort(names(rss)))\n    \n    dif <- rowSums((mtr - metadata(spe)$props)^2)\n    median_ss <- median(dif)\n    mean_ss <- mean(dif)\n    expect_true(mean_ss < 0.1 & median_ss < 0.1)\n}\n\n# Train NMF\nres <- trainNMF(\n    x = as.matrix(counts(sce)),\n    y = rownames(spe),\n    groups = sce$type,\n    mgs = mgs,\n    weight_id = \"weight\",\n    group_id = \"type\",\n    gene_id = \"gene\"\n)\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# ----  Check runDeconvolution x, y inputs  ------------------------------------\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# runDeconvolution with SCE ----\ntest_that(\"runDeconvolution x SCE\", {\n    decon <- runDeconvolution(\n        x = spe,\n        mod = res[[\"mod\"]],\n        ref = res[[\"topic\"]]\n    )\n    \n    .checks(decon, sce, spe)\n})\n\ntest_that(\"runDeconvolution x SPE\", {\n    decon <- runDeconvolution(\n        x = spe1,\n        mod = res[[\"mod\"]],\n        ref = res[[\"topic\"]]\n    )\n    \n    .checks(decon, sce, spe)\n})\n\n\n# runDeconvolution with sparse matrix sp ----\ntest_that(\"runDeconvolution x dgCMatrix SP\", {\n    decon <- runDeconvolution(\n        x = Matrix::Matrix(counts(spe), sparse = TRUE),\n        mod = res[[\"mod\"]],\n        ref = res[[\"topic\"]]\n    )\n    \n    .checks(decon, sce, spe)\n})\n\n# runDeconvolution with sparse matrix sp ----\ntest_that(\"runDeconvolution x DelayedMatrix SP\", {\n    decon <- runDeconvolution(\n        x = DelayedArray::DelayedArray(counts(spe)),\n        mod = res[[\"mod\"]],\n        ref = res[[\"topic\"]]\n    )\n    \n    .checks(decon, sce, spe)\n})\n\n# runDeconvolution with matrices in both ----\ntest_that(\"runDeconvolution x matrices\", {\n    decon <- runDeconvolution(\n        x = as.matrix(counts(spe)),\n        mod = res[[\"mod\"]],\n        ref = res[[\"topic\"]]\n    )\n    \n    .checks(decon, sce, spe)\n})\n\n"
  },
  {
    "path": "tests/testthat/test-trainNMF.R",
    "content": "set.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC(ng = 200, nc = 10, nt = 3)\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\n.checks <- function(res, sce) {\n    mod <- res[[1]]\n    mtr <- res[[2]]\n    expect_is(res, \"list\")\n    expect_is(mtr, \"matrix\")\n    expect_is(mod, \"list\")\n    expect_identical(ncol(mtr), length(unique(sce$type)))\n    expect_identical(nrow(mtr), ncol(mod$w))\n    expect_identical(nrow(mtr), nrow(mod$h))\n    }\n\n# Unit test to verify that the topic with max weight in each cell aligns with type\n.check_topic_alignment <- function(mod_h, topic) {\n    cell_pos <- c(1, 11, 21)\n    type_names <- rownames(topic)[1:3]   # types 1 to 3\n    \n    for (i in seq_along(cell_pos)) {\n        cell <- cell_pos[i]\n        type <- type_names[i]\n        expect_equal(which.max(mod_h[, cell]), which.max(topic[type, ]))\n    }\n}\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# ----  Check RCPP trainNMF x, y inputs  -------------------------------------------\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# trainNMF with SCE ----\ntest_that(\"rcpp trainNMF x SCE\", {\n    set.seed(321)\n    res <- trainNMF(\n        x = sce,\n        y = rownames(spe),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    \n    .checks(res, sce)\n    .check_topic_alignment(res$mod$h, res$topic)\n})\n\n\n# trainNMF with sparse matrix sc ----\ntest_that(\"rcpp trainNMF x dgCMatrix SC\", {\n    set.seed(321)\n    res <- trainNMF(\n        x = Matrix::Matrix(counts(sce), sparse = TRUE),\n        y = rownames(spe),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    .checks(res, sce)\n    .check_topic_alignment(res$mod$h, res$topic)\n})\n\n# trainNMF with sparse matrix sc ----\ntest_that(\"rcpp trainNMF x DelayedMatrix SC\", {\n    set.seed(321)\n    res <- trainNMF(\n        x = DelayedArray::DelayedArray(counts(sce)),\n        y = rownames(spe),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    .checks(res, sce)\n    .check_topic_alignment(res$mod$h, res$topic)\n})\n\n# trainNMF with matrices in both ----\ntest_that(\"rcpp trainNMF x matrices\", {\n    set.seed(321)\n    res <- trainNMF(\n        x = as.matrix(counts(sce)),\n        y = rownames(spe),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\"\n    )\n    \n    .checks(res, sce)\n    .check_topic_alignment(res$mod$h, res$topic)\n})\n\n# trainNMF with matrices in both and HVG----\ntest_that(\"rcpp trainNMF x hvg\", {\n    set.seed(321)\n    res <- trainNMF(\n        x = as.matrix(counts(sce)),\n        y = rownames(spe),\n        groups = sce$type,\n        mgs = mgs,\n        weight_id = \"weight\",\n        group_id = \"type\",\n        gene_id = \"gene\",\n        hvg = row.names(sce)[seq_len(50)]\n    )\n    \n    .checks(res, sce)\n    .check_topic_alignment(res$mod$h, res$topic)\n})\n\n\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# ----  Check NMF::nmf trainNMF x, y inputs  -------------------------------------------\n# ------------------------------------------------------------------------------\n# ------------------------------------------------------------------------------\n# trainNMF with SCE ----\n# test_that(\"NMF trainNMF x SCE\", {\n#     res <- trainNMF(\n#         x = sce,\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # trainNMF with SPE ----\n# test_that(\"NMF trainNMF x SEC\", {\n#     res <- trainNMF(\n#         x = sec,\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # trainNMF with sparse matrix sc ----\n# test_that(\"NMF trainNMF x dgCMatrix SC\", {\n#     res <- trainNMF(\n#         x = Matrix::Matrix(counts(sce), sparse = TRUE),\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     .checks(res, sce)\n# })\n# \n# # trainNMF with sparse matrix sc ----\n# test_that(\"NMF trainNMF x DelayedMatrix SC\", {\n#     res <- trainNMF(\n#         x = DelayedArray::DelayedArray(counts(sce)),\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     .checks(res, sce)\n# })\n# \n# # trainNMF with matrices in both ----\n# test_that(\"NMF trainNMF x matrices\", {\n#     res <- trainNMF(\n#         x = as.matrix(counts(sce)),\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\"\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n# # trainNMF with matrices in both and HVG----\n# test_that(\"NMF trainNMF x hvg\", {\n#     res <- trainNMF(\n#         x = as.matrix(counts(sce)),\n#         y = rownames(spe),\n#         groups = sce$type,\n#         pnmf = \"NMF\",\n#         mgs = mgs,\n#         weight_id = \"weight\",\n#         group_id = \"type\",\n#         gene_id = \"gene\",\n#         hvg = row.names(sce)[seq_len(50)]\n#     )\n#     \n#     .checks(res, sce)\n# })\n# \n"
  },
  {
    "path": "tests/testthat/test-utils.R",
    "content": "set.seed(321)\n# mock up some single-cell, mixture & marker data\nsce <- mockSC()\nspe <- mockSP(sce)\nmgs <- getMGS(sce)\n\n# .scale_uv ----\ntest_that(\".scale_uv()\", {\n    x <- counts(sce)\n    y <- .scale_uv(x)\n    expect_is(y, \"matrix\")\n    expect_identical(dim(y), dim(x))\n    expect_identical(dimnames(y), dimnames(x))\n    expect_true(all(abs(1 - sparseMatrixStats::rowVars(y)) < 1e-12))\n})\n\n# default parameters\ndefs <- list(\n    gene_id = \"gene\",\n    group_id = \"type\",\n    weight_id = \"weight\",\n    verbose = FALSE\n)\n\n# NMF ----\ntest_that(\"NMF\", {\n    x <- counts(sce)\n    y <- counts(spe)\n    groups <- sce$type\n    group_ids <- sort(unique(as.character(sce$type)))\n    n_groups <- length(group_ids)\n    \n    # + trainNMF ----\n    # undetected genes should be filtered out\n    # and pass silently (i.e., without error)\n    i <- sample(rownames(x), 5)\n    j <- sample(rownames(y), 5)\n    x. <- x\n    x.[i, ] <- 0\n    y. <- y\n    y.[j, ] <- 0\n    args <- c(defs, list(x., rownames(y.), groups, mgs))\n    fit <- expect_silent(do.call(trainNMF, args))\n    mod <- fit[[\"mod\"]]\n    expect_is(mod, \"list\")\n    expect_true(!all(c(i, j) %in% rownames(mod)))\n    # Only marker genes should be present - we don't use hvg here\n    expect_true(all(rownames(mod) %in% mgs$gene))\n    # valid call should give an object of class 'NMF'\n    # and dimension (#genes) x (#cells) x (#groups)\n    args <- c(defs, list(x, rownames(y), groups, mgs))\n    fit <- expect_silent(do.call(trainNMF, args))\n    mod <- fit[[\"mod\"]]\n    expect_is(mod, \"list\")\n    # Remove genes since these can change depending on \n    # filtering, mgs, hvg, all 0...\n    expect_identical(\n        dimnames(mod$h)[1:2],\n        c(list(paste0(\"topic_\", 1:nrow(mod$h))), dimnames(x)[2]))\n    \n    expect_identical(\n        dimnames(mod$w)[1:2],\n        c(list(mgs$gene), list(paste0(\"topic_\", 1:nrow(mod$h)))))\n    \n    # + .topic_profiles ----\n    # should give a square numeric matrix\n    # of dimension (#groups) x (#groups)\n    ref <- .topic_profiles(mod, groups)\n    expect_is(ref, \"matrix\")\n    expect_equal(dim(ref), rep(n_groups, 2))\n    expect_identical(rownames(ref), group_ids)\n    expect_identical(colnames(ref), paste0(\"topic_\", 1:nrow(ref)))\n    \n    # + .pred_hp ----\n    fqs <- .pred_hp(x, mod)\n    expect_is(fqs, \"matrix\")\n    expect_true(is.numeric(x))\n    expect_true(all(fqs >= 0))\n    expect_equal(dim(fqs), c(n_groups, ncol(x)))\n    expect_identical(\n        dimnames(fqs),\n        list(paste0(\"topic_\", 1:nrow(ref)), colnames(x)))\n    \n    # + runDeconvolution ----\n    # should give a numeric matrix\n    # of dimension (#groups) x (#spots)\n    # with proportions (i.e., values in [0, 1])\n    res <- runDeconvolution(x = y, mod = mod, ref = ref)\n    mat <- res[[1]]\n    err <- res[[2]]\n    expect_is(mat, \"matrix\")\n    expect_true(is.numeric(err))\n    expect_true(is.numeric(x))\n    expect_true(all(mat >= 0 & mat <= 1))\n    expect_true(all(rowSums(mat) - 1 < 1e-12))\n    expect_identical(dimnames(mat), list(colnames(y), group_ids))\n    expect_identical(rownames(mat), names(err))\n    # actually check the estimates are legit\n    # (MSE < 0.1 compared to simulated truth)\n    sim <- S4Vectors::metadata(spe)[[1]]\n    mse <- mean((mat - sim)^2)\n    expect_true(mse < 0.2)\n})\n\n\n# image\nlibrary(ExperimentHub)\neh <- ExperimentHub() # initialize hub instance\nq <- query(eh, \"TENxVisium\") # retrieve 'TENxVisiumData' records\nid <- q$ah_id[1] # specify dataset ID to load\nspe <- eh[[id]]\ncolLabels(spe) <- spe$sample_id\n\n# .extract_counts\ntest_that(\".extract_counts()\", {\n    x <- suppressWarnings(.extract_counts(spe, slot = \"counts\"))\n    expect_identical(dim(counts(spe)), dim(x))\n    expect_identical(dimnames(spe), dimnames(x))\n})\n\n# .scale_uv\ntest_that(\"scale_uv()\", {\n    x <- counts(sce)\n    y <- .scale_uv(x)\n    expect_is(y, \"matrix\")\n    expect_identical(dim(y), dim(x))\n    expect_identical(dimnames(y), dimnames(x))\n    expect_true(all(abs(1 - rowVars(y)) < 1e-12))\n})\n\n# .plot_image\nx_path <- paste0(system.file(package = \"SPOTlight\"), \"/extdata/SPOTlight.png\")\ntest_that(\".plot_image() SPE\", {\n    img <- .extract_image(x_path)\n    plt <- .plot_image(img)\n    expect_true(is.array(img))\n    expect_true(is_ggplot(plt))\n})\n\ntest_that(\".plot_image() SPE\", {\n    img <- .extract_image(spe)\n    plt <- .plot_image(img)\n    expect_true(is_ggplot(plt))\n    expect_true(is.matrix(img))\n})\n\n"
  },
  {
    "path": "tests/testthat.R",
    "content": "set.seed(321)\nlibrary(testthat)\nlibrary(SPOTlight)\n# plotImage() ----\ntest_check(\"SPOTlight\")\n"
  },
  {
    "path": "vignettes/SPOTlight_kidney.Rmd",
    "content": "---\ntitle: \"Spatial Transcriptomics Deconvolution with `SPOTlight`\"\ndate: \"`r BiocStyle::doc_date()`\"\nauthor:\n- name: Marc Elosua-Bayes\n  affiliation: \n  - &CNAG-CRG National Center for Genomic Analysis - Center for Genomic Regulation\n  - &UPF University Pompeu Fabra\n  email: marc.elosua@cnag.crg.eu\n- name: Helena L. Crowell\n  affiliation:\n  - &IMLS Institute for Molecular Life Sciences, University of Zurich, Switzerland\n  - &SIB SIB Swiss Institute of Bioinformatics, University of Zurich, Switzerland\n  email: helena.crowell@uzh.ch\n- name: Zach DeBruine\n  affiliation:\n  - &VAI Van Andel Institue\n  email: Zach.DeBruine@vai.edu\n\nabstract: > \n  <p> Spatially resolved gene expression profiles are key to understand tissue organization and function. However, novel spatial transcriptomics (ST) profiling techniques lack single-cell resolution and require a combination with single-cell RNA sequencing (scRNA-seq) information to deconvolute the spatially indexed datasets. Leveraging the strengths of both data types, we developed SPOTlight, a computational tool that enables the integration of ST with scRNA-seq data to infer the location of cell types and states within a complex tissue. SPOTlight is centered around a seeded non-negative matrix factorization (NMF) regression, initialized using cell-type marker genes and non-negative least squares (NNLS) to subsequently deconvolute ST capture locations (spots).\npackage: \"`r BiocStyle::pkg_ver('SPOTlight')`\"\nvignette: >\n  %\\VignetteIndexEntry{\"SPOTlight\"}\n  %\\VignettePackage{SPOTlight}\n  %\\VignetteEncoding{UTF-8}\n  %\\VignetteEngine{knitr::rmarkdown}\noutput: \n  BiocStyle::html_document\neditor_options: \n  markdown: \n    wrap: 80\n---\n\n```{=html}\n<style type=\"text/css\">\n.smaller {\n  font-size: 10px\n}\n</style>\n```\n\nFor a more detailed explanation of `SPOTlight` consider looking at our\nmanuscript:\n> Elosua-Bayes M, Nieto P, Mereu E, Gut I, Heyn H.  \nSPOTlight: seeded NMF regression to deconvolute  \nspatial transcriptomics spots with single-cell transcriptomes.  \n*Nucleic Acids Res.* **2021;49(9):e50**. doi: [10.1093](10.1093/nar/gkab043)\n\n# Load packages {.unnumbered}\n\n```{r load-libs, message = FALSE,  warning = FALSE}\nlibrary(ggplot2)\nlibrary(SPOTlight)\nlibrary(SingleCellExperiment)\nlibrary(SpatialExperiment)\nlibrary(scater)\nlibrary(scran)\n```\n\n# Introduction\n\n## What is `SPOTlight`?\n\n`SPOTlight` is a tool that enables the deconvolution of cell types and cell type\nproportions present within each capture location comprising mixtures of cells.\nOriginally developed for 10X's Visium - spatial transcriptomics - technology, it\ncan be used for all technologies returning mixtures of cells.\n\n`SPOTlight` is based on learning topic profile signatures, by means of an NMFreg\nmodel, for each cell type and finding which combination of cell types fits best\nthe spot we want to deconvolute. Find below a graphical abstract visually\nsummarizing the key steps.\n\n![](schematic.png)\n\n## Starting point\n\nThe minimal unit of data required to run `SPOTlight` are:\n\n- ST (sparse) matrix with the expression, raw or normalized, where rows = genes\nand columns = capture locations.\n- Single cell (sparse) matrix with the expression, raw or normalized,  \nwhere rows = genes and columns = cells.\n- Vector indicating the cell identity for each column in the single cell\nexpression matrix.\n\nData inputs can also be objects of class `r Biocpkg(\"SpatialExperiment\")` (SE),\n`r Biocpkg(\"SingleCellExperiment\")` (SCE) objects from\nwhich the minimal data will be extracted.\n\n# Getting started\n\n## Data description\n\nFor this vignette, we will use a SE put out by *10X Genomics* containing a\nVisium kidney slide. The raw data can be accessed\n[here](https://support.10xgenomics.com/spatial-gene-expression/datasets/1.1.0/V1_Mouse_Kidney).\n\nSCE data comes from the [*The Tabula Muris\nConsortium*](https://www.nature.com/articles/s41586-020-2496-1) which contains\n\\>350,000 cells from from male and female mice belonging to six age groups,\nranging from 1 to 30 months. From this dataset we will only load the kidney\nsubset to map it to the Visium slide.\n\n## Loading the data\n\nBoth datasets are available through Biocondcutor packages and can be loaded into R as follows. \n`\nLoad the spatial data:\n\n```{r load-sp, message=FALSE}\nlibrary(TENxVisiumData)\nspe <- MouseKidneyCoronal()\n# Use symbols instead of Ensembl IDs as feature names\nrownames(spe) <- rowData(spe)$symbol\n```\n\nLoad the single cell data. Since our data comes from the \n[Tabula Muris Sensis](https://www.nature.com/articles/s41586-020-2496-1) \ndataset, we can directly load the SCE object as follows:\n\n```{r load-sc, message=FALSE}\nlibrary(TabulaMurisSenisData)\nsce <- TabulaMurisSenisDroplet(tissues = \"Kidney\")$Kidney\n```\n\nQuick data exploration:\n\n```{r explo}\ntable(sce$free_annotation, sce$age)\n```\n\nWe see how there is a good representation of all the cell types across ages\nexcept at 24m. In order to reduce the potential noise introduced by age and\nbatch effects we are going to select cells all coming from the same age.\n\n```{r sub-18m}\n# Keep cells from 18m mice\nsce <- sce[, sce$age == \"18m\"]\n# Keep cells with clear cell type annotations\nsce <- sce[, !sce$free_annotation %in% c(\"nan\", \"CD45\")]\n```\n\n# Workflow\n\n## Preprocessing\n\nIf the dataset is very large we want to downsample it to train the model, both\nin of number of cells and number of genes. To do this, we want to keep a\nrepresentative amount of cells per cluster and the most biologically relevant\ngenes.\n\nIn the paper we show how downsampling the number of cells per cell identity to\n\\~100 doesn't affect the performance of the model. Including \\>100 cells per\ncell identity provides marginal improvement while greatly increasing\ncomputational time and resources. Furthermore, restricting the gene set to the\nmarker genes for each cell type along with up to 3.000 highly variable genes\nfurther optimizes performance and computational resources. You can find a more\ndetailed explanation in the original\n[paper](https://academic.oup.com/nar/article/49/9/e50/6129341).\n\n### Feature selection\n\nOur first step is to get the marker genes for each cell type. We follow the\nNormalization procedure as described in\n[OSCA](http://bioconductor.org/books/3.14/OSCA.basic/normalization.html). We\nfirst carry out library size normalization to correct for cell-specific biases:\n\n```{r lognorm}\nsce <- logNormCounts(sce)\n```\n\n### Variance modelling\n\nWe aim to identify highly variable genes that drive biological heterogeneity. \nBy feeding these genes to the model we improve the resolution of the biological structure and reduce the technical noise.\n\n```{r variance}\n# Get vector indicating which genes are neither ribosomal or mitochondrial\ngenes <- !grepl(pattern = \"^Rp[l|s]|Mt\", x = rownames(sce))\n\ndec <- modelGeneVar(sce, subset.row = genes)\nplot(dec$mean, dec$total, xlab = \"Mean log-expression\", ylab = \"Variance\")\ncurve(metadata(dec)$trend(x), col = \"blue\", add = TRUE)\n\n# Get the top 3000 genes.\nhvg <- getTopHVGs(dec, n = 3000)\n```\n\nNext we obtain the marker genes for each cell identity. You can use whichever\nmethod you want as long as it returns a weight indicating the importance of that\ngene for that cell type. Examples include `avgLogFC`, `AUC`, `pct.expressed`,\n`p-value`...\n\n```{r mgs}\ncolLabels(sce) <- colData(sce)$free_annotation\n\n# Compute marker genes\nmgs <- scoreMarkers(sce, subset.row = genes)\n```\n\nThen we want to keep only those genes that are relevant for each cell identity:\n\n```{r mgs-df}\nmgs_fil <- lapply(names(mgs), function(i) {\n    x <- mgs[[i]]\n    # Filter and keep relevant marker genes, those with AUC > 0.8\n    x <- x[x$mean.AUC > 0.8, ]\n    # Sort the genes from highest to lowest weight\n    x <- x[order(x$mean.AUC, decreasing = TRUE), ]\n    # Add gene and cluster id to the dataframe\n    x$gene <- rownames(x)\n    x$cluster <- i\n    data.frame(x)\n})\nmgs_df <- do.call(rbind, mgs_fil)\n```\n\n### Cell Downsampling\n\nNext, we randomly select at most 100 cells per cell identity. If a cell type is\ncomprised of \\<100 cells, all the cells will be used. If we have very\nbiologically different cell identities (B cells vs. T cells vs. Macrophages vs.\nEpithelial) we can use fewer cells since their transcriptional profiles will be\nvery different. In cases when we have more transcriptionally similar cell\nidentities we need to increase our N to capture the biological heterogeneity\nbetween them.\n\nIn our experience we have found that for this step it is better to select the\ncells from each cell type from the same batch if you have a joint dataset from\nmultiple runs. This will ensure that the model removes as much signal from the\nbatch as possible and actually learns the biological signal.\n\nFor the purpose of this vignette and to speed up the analysis, we are going to\nuse 20 cells per cell identity:\n\n```{r downsample}\n# split cell indices by identity\nidx <- split(seq(ncol(sce)), sce$free_annotation)\n# downsample to at most 20 per identity & subset\n# We are using 5 here to speed up the process but set to 75-100 for your real\n# life analysis\nn_cells <- 50\ncs_keep <- lapply(idx, function(i) {\n    n <- length(i)\n    if (n < n_cells)\n        n_cells <- n\n    sample(i, n_cells)\n})\nsce <- sce[, unlist(cs_keep)]\n```\n\n## Deconvolution\n\nYou are now set to run `SPOTlight` to deconvolute the spots!\n\nBriefly, here is how it works:\n\n1. NMF is used to factorize a matrix into two lower dimensionality matrices\nwithout negative elements. We first have an initial matrix V (SCE count matrix),\nwhich is factored into W and H. Unit variance normalization by gene is performed\nin V and in order to standardize discretized gene expression levels,\n‘counts-umi’. Factorization is then carried out using the non-smooth NMF method,\nimplemented in the R package NMF `r CRANpkg(\"NMF\")` (14). This method is\nintended to return sparser results during the factorization in W and H, thus \npromoting cell-type-specific topic profile and reducing overfitting during \ntraining. Before running factorization, we initialize each topic, column, \nof W with the unique marker genes for each cell type with weights. In turn, each\ntopic of H in `SPOTlight` is initialized with the corresponding membership of each\ncell for each topic, 1 or 0. This way, we seed the model with prior information,\nthus guiding it towards a biologically relevant result. This initialization also\naims at reducing variability and improving the consistency between runs. \\\n\n2. NNLS regression is used to map each capture location's transcriptome in V’\n(SE count matrix) to H’ using W as the basis. We obtain a topic profile\ndistribution over each capture location which we can use to determine its\ncomposition. \\\n\n3. we obtain Q, cell-type specific topic profiles, from H. We select all cells \nfrom the same cell type and compute the median of each topic for a consensus \ncell-type-specific topic signature. We then use NNLS to find the weights of each\ncell type that best fit H’ minimizing the residuals.\n\nYou can visualize the above explanation in the following workflow scheme:\n\n![](workflow.png)\n\n```{r SPOTlight}\nres <- SPOTlight(\n    x = sce,\n    y = spe,\n    groups = as.character(sce$free_annotation),\n    mgs = mgs_df,\n    hvg = hvg,\n    weight_id = \"mean.AUC\",\n    group_id = \"cluster\",\n    gene_id = \"gene\")\n```\n\nAlternatively you can run `SPOTlight` in two steps so that you can have the trained model. Having the trained model allows you to reuse with other datasets you also want to deconvolute with the same reference. This allows you to skip the training step, the most time consuming and computationally expensive.\n\n```{r SPOTlight2, eval=FALSE}\nmod_ls <- trainNMF(\n    x = sce,\n    groups = sce$free_annotation,\n    mgs = mgs_df,\n    hvg = hvg,\n    weight_id = \"mean.AUC\",\n    group_id = \"cluster\",\n    gene_id = \"gene\")\n\n # Run deconvolution\nres <- runDeconvolution(\n    x = spe,\n    mod = mod_ls[[\"mod\"]],\n    ref = mod_ls[[\"topic\"]])\n```\n\nExtract data from `SPOTlight`:\n\n```{r}\n# Extract deconvolution matrix\nhead(mat <- res$mat)[, seq_len(3)]\n# Extract NMF model fit\nmod <- res$NMF\n```\n\n# Visualization\n\nIn the next section we show how to visualize the data and interpret\n`SPOTlight`'s results. \n\n## Topic profiles\n\nWe first take a look at the Topic profiles. By setting `facet = FALSE` we want to\nevaluate how specific each topic signature is for each cell identity.\nIdeally each cell identity will have a unique topic profile associated to it as \nseen below.\n\n```{r plotTopicProfiles1, fig.width=6, fig.height=7}\nplotTopicProfiles(\n    x = mod,\n    y = sce$free_annotation,\n    facet = FALSE,\n    min_prop = 0.01,\n    ncol = 1) +\n    theme(aspect.ratio = 1)\n```\n\nNext we also want to ensure that all the cells from the same cell identity share \na similar topic profile since this will mean that `SPOTlight` has learned a\nconsistent signature for all the cells from the same cell identity.\n\n```{r plotTopicProfiles2, fig.width=9, fig.height=6}\nplotTopicProfiles(\n    x = mod,\n    y = sce$free_annotation,\n    facet = TRUE,\n    min_prop = 0.01,\n    ncol = 6)\n```\n\nLastly we can take a look at which genes the model learned for each topic.\nHigher values indicate that the gene is more relevant for that topic. \nIn the below table we can see how the top genes for `Topic1` are characteristic\nfor B cells (i.e. *Cd79a*, *Cd79b*, *Ms4a1*...).\n\n```{r basis-dt, message=FALSE, warning=FALSE}\n# library(NMF)\nsign <- mod$w\n# colnames(sign) <- paste0(\"Topic\", seq_len(ncol(sign)))\nhead(sign)\n# This can be dynamically visualized with DT as shown below\n# DT::datatable(sign, fillContainer = TRUE, filter = \"top\")\n```\n\n## Spatial Correlation Matrix\n\nSee [here](http://www.sthda.com/english/wiki/ggcorrplot-visualization-of-a-correlation-matrix-using-ggplot2) \nfor additional graphical parameters.\n\n```{r plotCorrelationMatrix, fig.width=9, fig.height=9}\nplotCorrelationMatrix(mat)\n```\n\n## Co-localization\n\nNow that we know which cell types are found within each spot we can make a graph\nrepresenting spatial interactions where cell types will have stronger edges\nbetween them the more often we find them within the same spot.\n\nSee [here](https://www.r-graph-gallery.com/network.html) for additional\ngraphical parameters.\n\n```{r plotInteractions, fig.width=9, fig.height=9}\nplotInteractions(mat, which = \"heatmap\", metric = \"prop\")\nplotInteractions(mat, which = \"heatmap\", metric = \"jaccard\")\nplotInteractions(mat, which = \"network\")\n```\n\n## Scatterpie\n\nWe can also visualize the cell type proportions as sections of a pie chart for \neach spot. You can modify the colors as you would a standard `r CRANpkg(\"ggplot2\")`.\n\n```{r Scatterpie, fig.width=9, fig.height=6}\nct <- colnames(mat)\nmat[mat < 0.1] <- 0\n\n# Define color palette\n# (here we use 'paletteMartin' from the 'colorBlindness' package)\npaletteMartin <- c(\n    \"#000000\", \"#004949\", \"#009292\", \"#ff6db6\", \"#ffb6db\", \n    \"#490092\", \"#006ddb\", \"#b66dff\", \"#6db6ff\", \"#b6dbff\", \n    \"#920000\", \"#924900\", \"#db6d00\", \"#24ff24\", \"#ffff6d\")\n\npal <- colorRampPalette(paletteMartin)(length(ct))\nnames(pal) <- ct\n\nplotSpatialScatterpie(\n    x = spe,\n    y = mat,\n    cell_types = colnames(mat),\n    img = FALSE,\n    scatterpie_alpha = 1,\n    pie_scale = 0.4) +\n    scale_fill_manual(\n        values = pal,\n        breaks = names(pal))\n```\n\nWith the image underneath - we are rotating it 90 degrees counterclockwise and mirroring across the horizontal axis to show how to align if the spots don't overlay the image.\n```{r}\nplotSpatialScatterpie(\n    x = spe,\n    y = mat,\n    cell_types = colnames(mat),\n    img = FALSE,\n    scatterpie_alpha = 1,\n    pie_scale = 0.4, \n    # Rotate the image 90 degrees counterclockwise\n    degrees = -90,\n    # Pivot the image on its x axis\n    axis = \"h\") +\n    scale_fill_manual(\n        values = pal,\n        breaks = names(pal))\n\n```\n\n## Residuals\n\nLastly we can also take a look at how well the model predicted the proportions\nfor each spot. We do this by looking at the residuals of the sum of squares for\neach spot which indicates the amount of biological signal not explained by the model.\n\n```{r message=FALSE}\nspe$res_ss <- res[[2]][colnames(spe)]\nxy <- spatialCoords(spe)\nspe$x <- xy[, 1]\nspe$y <- xy[, 2]\nggcells(spe, aes(x, y, color = res_ss)) +\n    geom_point() +\n    scale_color_viridis_c() +\n    coord_fixed() +\n    theme_bw()\n```\n\n# Session information\n\n```{r session-info}\nsessionInfo()\n```\n"
  }
]