From b2e30c14fc154bbd77153836ebb7440a7453de05 Mon Sep 17 00:00:00 2001
From: Mark Keller <7525285+keller-mark@users.noreply.github.com>
Date: Tue, 19 Sep 2023 16:55:35 -0400
Subject: [PATCH] Initial commit
---
.BBSoptions | 1 +
.Rbuildignore | 21 ++
.github/ISSUE_TEMPLATE/bug_report.md | 26 ++
.github/ISSUE_TEMPLATE/feature_request.md | 14 +
.github/workflows/deploy.yml | 95 +++++
.gitignore | 13 +
DESCRIPTION | 62 ++++
LICENSE | 2 +
LICENSE.md | 21 ++
NAMESPACE | 44 +++
NEWS.md | 6 +
R/basilisk.R | 28 ++
R/data_to_zarr.R | 269 ++++++++++++++
R/helpers.R | 88 +++++
R/mock_objects.R | 105 ++++++
R/namespace.R | 4 +
R/wrappers_giotto.R | 248 +++++++++++++
R/wrappers_images.R | 232 ++++++++++++
R/wrappers_sce.R | 244 +++++++++++++
R/wrappers_seurat.R | 262 +++++++++++++
R/wrappers_spe.R | 319 ++++++++++++++++
README.md | 74 ++++
configure | 3 +
configure.win | 3 +
index.md | 25 ++
pkgdown/_pkgdown.yml | 84 +++++
pkgdown/extra.css | 6 +
tests/testthat.R | 4 +
tests/testthat/setup-wrappers-seurat.R | 10 +
tests/testthat/test-config.R | 427 ++++++++++++++++++++++
tests/testthat/test-wrappers-seurat.R | 64 ++++
tests/testthat/test-wrappers.R | 30 ++
tools/check.env | 47 +++
vignettes/debugging.Rmd | 61 ++++
vignettes/dev_wrapper_class.Rmd | 208 +++++++++++
vignettes/dev_wrapper_subclass.Rmd | 144 ++++++++
vignettes/export_files.Rmd | 120 ++++++
vignettes/giotto.Rmd | 162 ++++++++
vignettes/json_local.Rmd | 102 ++++++
vignettes/local_data_overview.Rmd | 27 ++
vignettes/ome_tiff_local.Rmd | 41 +++
vignettes/pkgdown.Rmd | 39 ++
vignettes/session_info.Rmd | 16 +
vignettes/seurat_azimuth.Rmd | 242 ++++++++++++
vignettes/seurat_basic.Rmd | 82 +++++
vignettes/seuratdata.Rmd | 68 ++++
vignettes/shiny.Rmd | 172 +++++++++
vignettes/single_cell_experiment.Rmd | 64 ++++
vignettes/spatial_experiment.Rmd | 51 +++
vignettes/web_only/json_remote.Rmd | 87 +++++
vignettes/web_only/ome_tiff_remote.Rmd | 70 ++++
51 files changed, 4637 insertions(+)
create mode 100644 .BBSoptions
create mode 100644 .Rbuildignore
create mode 100644 .github/ISSUE_TEMPLATE/bug_report.md
create mode 100644 .github/ISSUE_TEMPLATE/feature_request.md
create mode 100644 .github/workflows/deploy.yml
create mode 100644 .gitignore
create mode 100644 DESCRIPTION
create mode 100644 LICENSE
create mode 100644 LICENSE.md
create mode 100644 NAMESPACE
create mode 100644 NEWS.md
create mode 100644 R/basilisk.R
create mode 100644 R/data_to_zarr.R
create mode 100644 R/helpers.R
create mode 100644 R/mock_objects.R
create mode 100644 R/namespace.R
create mode 100644 R/wrappers_giotto.R
create mode 100644 R/wrappers_images.R
create mode 100644 R/wrappers_sce.R
create mode 100644 R/wrappers_seurat.R
create mode 100644 R/wrappers_spe.R
create mode 100755 configure
create mode 100755 configure.win
create mode 100644 index.md
create mode 100644 pkgdown/_pkgdown.yml
create mode 100644 pkgdown/extra.css
create mode 100644 tests/testthat.R
create mode 100644 tests/testthat/setup-wrappers-seurat.R
create mode 100644 tests/testthat/test-config.R
create mode 100644 tests/testthat/test-wrappers-seurat.R
create mode 100644 tests/testthat/test-wrappers.R
create mode 100644 tools/check.env
create mode 100644 vignettes/debugging.Rmd
create mode 100644 vignettes/dev_wrapper_class.Rmd
create mode 100644 vignettes/dev_wrapper_subclass.Rmd
create mode 100644 vignettes/export_files.Rmd
create mode 100644 vignettes/giotto.Rmd
create mode 100644 vignettes/json_local.Rmd
create mode 100644 vignettes/local_data_overview.Rmd
create mode 100644 vignettes/ome_tiff_local.Rmd
create mode 100644 vignettes/pkgdown.Rmd
create mode 100644 vignettes/session_info.Rmd
create mode 100644 vignettes/seurat_azimuth.Rmd
create mode 100644 vignettes/seurat_basic.Rmd
create mode 100644 vignettes/seuratdata.Rmd
create mode 100644 vignettes/shiny.Rmd
create mode 100644 vignettes/single_cell_experiment.Rmd
create mode 100644 vignettes/spatial_experiment.Rmd
create mode 100644 vignettes/web_only/json_remote.Rmd
create mode 100644 vignettes/web_only/ome_tiff_remote.Rmd
diff --git a/.BBSoptions b/.BBSoptions
new file mode 100644
index 0000000..7a13ab8
--- /dev/null
+++ b/.BBSoptions
@@ -0,0 +1 @@
+UnsupportedPlatforms: win32
diff --git a/.Rbuildignore b/.Rbuildignore
new file mode 100644
index 0000000..f95bf67
--- /dev/null
+++ b/.Rbuildignore
@@ -0,0 +1,21 @@
+^vitessceAnalysisR\.Rproj$
+^\.Rproj\.user$
+^\.travis\.yml$
+^\.BBSoptions$
+^.github$
+^package\.json$
+^package-lock\.json$
+^node_modules$
+^img$
+^webpack\.config\.js$
+^inst/htmlwidgets/lib/.*$
+^inst/htmlwidgets/dist/.*\.map$
+^inst/testdata
+^index\.md$
+^LICENSE\.md$
+^pkgdown$
+^vignettes$
+^docs$
+^pkgdown$
+^data$
+^check$
diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md
new file mode 100644
index 0000000..6e9e562
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/bug_report.md
@@ -0,0 +1,26 @@
+---
+name: Bug report
+about: An existing feature does not work
+title: ''
+labels: bug
+assignees: ''
+
+---
+
+**Describe the bug**
+A clear and concise description of what the bug is.
+
+**To Reproduce**
+Steps to reproduce the behavior:
+
+**Expected behavior**
+A clear and concise description of what you expected to happen.
+
+**Screenshots**
+If applicable, add screenshots to help explain your problem.
+
+**Environment:**
+ - Release or git hash:
+ - Operating system:
+ - R version:
+ - RStudio version:
diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md
new file mode 100644
index 0000000..7c108b3
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/feature_request.md
@@ -0,0 +1,14 @@
+---
+name: Feature request
+about: Suggest an idea for this project
+title: ''
+labels: feature
+assignees: ''
+
+---
+
+**User story**
+
+**Preferred solution**
+
+**Possible alternatives**
diff --git a/.github/workflows/deploy.yml b/.github/workflows/deploy.yml
new file mode 100644
index 0000000..3d00e2e
--- /dev/null
+++ b/.github/workflows/deploy.yml
@@ -0,0 +1,95 @@
+name: R
+
+on: [push, pull_request]
+
+permissions:
+ contents: read
+ pages: write
+ id-token: write
+
+jobs:
+ build:
+ runs-on: ubuntu-22.04
+ env:
+ cache-version: 8
+ steps:
+ - uses: actions/checkout@v3
+ - name: Set up libraries for Ubuntu
+ run: |
+ sudo apt-get update
+ sudo apt-get install -y libsodium-dev libharfbuzz-dev libfribidi-dev libcurl4-openssl-dev texlive-latex-base texlive-fonts-extra pandoc libmagick++-dev libhdf5-dev
+
+ - name: Set up R 4.0
+ uses: r-lib/actions/setup-r@v2
+ with:
+ r-version: 4.0
+ - name: Get R and OS version
+ id: get-version
+ run: |
+ cat("::set-output name=os-version::", sessionInfo()$running, "\n", sep = "")
+ cat("::set-output name=r-version::", R.Version()$version.string, "\n", sep = "")
+ cat("::endgroup::\n")
+ shell: Rscript {0}
+ - name: Cache dependencies
+ id: cache-deps
+ uses: actions/cache@v2
+ with:
+ path: ${{ env.R_LIBS_USER }}/*
+ key: ${{ steps.get-version.outputs.os-version }}-${{ steps.get-version.outputs.r-version }}-${{ env.cache-version }}-deps
+ - name: Install dependencies
+ if: steps.cache-deps.outputs.cache-hit != 'true'
+ run: |
+ install.packages(c("remotes", "rcmdcheck", "BiocManager", "Seurat", "covr"))
+ BiocManager::install("BiocCheck")
+ remotes::install_github(c("RubD/Giotto", "mojaveazure/seurat-disk"))
+ remotes::install_deps(dependencies = TRUE)
+ shell: Rscript {0}
+ env:
+ GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+ - name: rcmdcheck
+ run: |
+ rcmdcheck::rcmdcheck(
+ error_on = "warning",
+ check_dir = "check"
+ )
+ shell: Rscript {0}
+ env:
+ _R_CHECK_FORCE_SUGGESTS_: false
+ - name: BiocCheck
+ run: |
+ BiocCheck::BiocCheck(
+ dir('check', 'tar.gz$', full.names = TRUE),
+ `no-check-R-ver` = TRUE,
+ `no-check-pkg-size` = TRUE,
+ `no-check-vignettes` = TRUE
+ )
+ shell: Rscript {0}
+ env:
+ _R_CHECK_FORCE_SUGGESTS_: false
+ - name: Run covr
+ run: |
+ covr::package_coverage()
+ shell: Rscript {0}
+ - name: Downgrade pkgdown
+ run: |
+ remotes::install_version("pkgdown", "2.0.3")
+ shell: Rscript {0}
+ - name: Build docs
+ run: |
+ Rscript -e 'pkgdown::build_site(new_process = FALSE)'
+ touch docs/.nojekyll
+ - uses: actions/upload-pages-artifact@v1
+ if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }}
+ with:
+ path: ./docs
+ deploy:
+ runs-on: ubuntu-22.04
+ needs: build
+ environment:
+ name: github-pages
+ url: ${{ steps.deployment.outputs.page_url }}
+ steps:
+ - name: Deploy to GitHub Pages
+ if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }}
+ id: deployment
+ uses: actions/deploy-pages@v1
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1a0b733
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+.Rproj.user
+.DS_Store
+.Rhistory
+*.Rcheck/
+*.tar.gz
+node_modules/
+docs/
+tests/testthat/seurat/
+data/
+check/
+vignettes/data/
+*.Rproj
+.RData
\ No newline at end of file
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..f79523b
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,62 @@
+Package: vitessceAnalysisR
+Type: Package
+Title: Data preparation helper functions for usage with the vitessceR library.
+Version: 0.99.0
+Authors@R: c(
+ person(
+ given = "Mark",
+ family = "Keller",
+ email = "mark_keller@g.harvard.edu",
+ role = c("cre", "aut"),
+ comment = c(ORCID = "0000-0003-3003-874X")
+ )
+ )
+Description:
+ The R API contains
+ classes and functions for loading single-cell data stored as
+ SingleCellExperiment, SpatialExperiment, and Seurat objects.
+biocViews: SingleCell, Spatial
+License: MIT + file LICENSE
+BugReports: https://github.com/vitessce/vitessceAnalysisR/issues
+URL: https://github.com/vitessce/vitessceAnalysisR
+Encoding: UTF-8
+LazyData: false
+Language: en-US
+StagedInstall: no
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+VignetteBuilder: knitr
+Imports:
+ Matrix,
+ DelayedArray,
+ htmlwidgets,
+ jsonlite,
+ R6,
+ plumber,
+ future,
+ httpuv,
+ stringr,
+ reticulate,
+ varhandle,
+ tools,
+ stats,
+ methods,
+ S4Vectors,
+ grDevices,
+ basilisk,
+ zellkonverter,
+ SummarizedExperiment,
+ SingleCellExperiment,
+ SpatialExperiment
+Suggests:
+ testthat,
+ knitr,
+ covr,
+ bslib,
+ pkgdown,
+ rmarkdown,
+ purrr,
+ rjson,
+ Seurat,
+ SeuratDisk,
+ Giotto
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..fe7fcba
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2020
+COPYRIGHT HOLDER: Gehlenborg Lab
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
index 0000000..43627c9
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2020 Gehlenborg Lab
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..709fe20
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,44 @@
+# Generated by roxygen2: do not edit by hand
+
+export(AbstractWrapper)
+export(Component)
+export(CoordinationType)
+export(DataType)
+export(FileType)
+export(GiottoWrapper)
+export(MultiImageWrapper)
+export(OmeTiffWrapper)
+export(SCEWrapper)
+export(SPEWrapper)
+export(SeuratWrapper)
+export(VitessceConfig)
+export(get_giotto_obj)
+export(get_sce_obj)
+export(get_seurat_obj)
+export(get_spe_obj)
+export(giotto_to_anndata_zarr)
+export(hconcat)
+export(obj_list)
+export(render_vitessce)
+export(sce_to_anndata_zarr)
+export(seurat_to_anndata_zarr)
+export(spe_to_anndata_zarr)
+export(spe_to_ome_zarr)
+export(vconcat)
+export(vitessce_output)
+export(vitessce_widget)
+import(R6)
+import(plumber)
+importFrom(SingleCellExperiment,"reducedDims<-")
+importFrom(SingleCellExperiment,int_colData)
+importFrom(SingleCellExperiment,reducedDims)
+importFrom(SpatialExperiment,"colData<-")
+importFrom(SpatialExperiment,getImg)
+importFrom(SummarizedExperiment,colData)
+importFrom(grDevices,as.raster)
+importFrom(grDevices,col2rgb)
+importFrom(methods,new)
+importFrom(methods,slot)
+importFrom(stats,rnorm)
+importFrom(stats,rpois)
+importFrom(stats,runif)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..4a09c8c
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,6 @@
+# vitessceR 0.99.0 (2023-09-19)
+
+* Initial Bioconductor submission
+
+# vitessceR 0.0.0 (early development version)
+
diff --git a/R/basilisk.R b/R/basilisk.R
new file mode 100644
index 0000000..a704283
--- /dev/null
+++ b/R/basilisk.R
@@ -0,0 +1,28 @@
+#' The Python environment
+#'
+#' Defines a conda environment via Basilisk, which is used
+#' to convert R objects to Zarr stores.
+#' This environment has been adapted from zellkonverter::.AnnDataDependencies.
+#' Reference: https://bioconductor.org/packages/release/bioc/vignettes/basilisk/inst/doc/motivation.html
+#'
+#' @keywords internal
+py_env <- basilisk::BasiliskEnvironment(
+ envname="vitessce_basilisk_env",
+ pkgname="vitessceR",
+ packages=c(
+ "numpy==1.*",
+ "pandas==1.*",
+ "anndata==0.7.*",
+ "h5py==3.*",
+ "hdf5==1.*",
+ "natsort==7.*",
+ "packaging==20.*",
+ "scipy==1.*",
+ "sqlite==3.*",
+ "zarr==2.*",
+ "numcodecs==0.*"
+ ),
+ pip=c(
+ "ome-zarr==0.2.1"
+ )
+)
diff --git a/R/data_to_zarr.R b/R/data_to_zarr.R
new file mode 100644
index 0000000..8fa9a3c
--- /dev/null
+++ b/R/data_to_zarr.R
@@ -0,0 +1,269 @@
+
+#' Save a Seurat object to an AnnData-Zarr store.
+#'
+#' @param seurat_obj The object to save.
+#' @param out_path A path to the output Zarr store.
+#' @param assay The name of the assay to save.
+#' @return TRUE if the conversion succeeds.
+#'
+#' @export
+#' @examples
+#' obj <- get_seurat_obj()
+#' seurat_to_anndata_zarr(obj, out_path = "data/seurat.zarr", assay = "RNA")
+seurat_to_anndata_zarr <- function(seurat_obj, out_path, assay) {
+ if(!requireNamespace("SeuratDisk", quietly = TRUE)) {
+ stop("Install 'SeuratDisk' to enable conversion of Seurat objects to AnnData objects.")
+ }
+
+ h5seurat_path <- paste0(out_path, ".h5Seurat")
+ h5ad_path <- paste0(out_path, ".h5ad")
+
+ # Convert factor columns to string/numeric.
+ seurat_obj@meta.data <- varhandle::unfactor(seurat_obj@meta.data)
+
+ SeuratDisk::SaveH5Seurat(seurat_obj, filename = h5seurat_path, overwrite = TRUE)
+ SeuratDisk::Convert(h5seurat_path, dest = "h5ad", overwrite = TRUE, assay = assay)
+
+ # Use basilisk
+ proc <- basilisk::basiliskStart(py_env)
+ on.exit(basilisk::basiliskStop(proc))
+
+ success <- basilisk::basiliskRun(proc, function(h5ad_path, out_path) {
+ anndata <- reticulate::import("anndata")
+ zarr <- reticulate::import("zarr")
+
+ adata <- anndata$read_h5ad(h5ad_path)
+
+ cleanup_colnames <- function(df) {
+ # Reference: https://github.com/theislab/scvelo/issues/255#issuecomment-739995301
+ new_colnames <- colnames(df)
+ new_colnames[new_colnames == "_index"] <- "features"
+ return(new_colnames)
+ }
+
+ noop <- function(cond) { }
+
+ tryCatch({
+ colnames(adata$var) <- cleanup_colnames(adata$var)
+ }, error = noop)
+
+ # Reconstruct, omitting raw and uns.
+ adata <- anndata$AnnData(
+ X = adata$X,
+ obs = as.data.frame(adata$obs),
+ var = as.data.frame(adata$var),
+ obsm = adata$obsm,
+ varm = adata$varm
+ )
+
+ adata$write_zarr(out_path)
+
+ return(TRUE)
+ }, h5ad_path = h5ad_path, out_path = out_path)
+ return(success)
+}
+
+#' Save a SingleCellExperiment to an AnnData-Zarr store.
+#'
+#' @param sce_obj The object to save.
+#' @param out_path A path to the output Zarr store.
+#' @return TRUE if the conversion succeeds.
+#'
+#' @export
+#' @examples
+#' obj <- get_sce_obj()
+#' sce_to_anndata_zarr(obj, out_path = "data/sce.zarr")
+#' @importFrom SingleCellExperiment reducedDims reducedDims<-
+sce_to_anndata_zarr <- function(sce_obj, out_path) {
+ obsm_keys <- names(as.list(reducedDims(sce_obj)))
+ for(obsm_key in obsm_keys) {
+ # If there are column names, then the obsm element will be stored as a data.frame,
+ # but Vitessce can only handle array obsm, so we need to remove any column names.
+ # Reference: https://github.com/theislab/zellkonverter/blob/e1e95b1/R/SCE2AnnData.R#L159
+ colnames(reducedDims(sce_obj)[[obsm_key]]) <- NULL
+ }
+
+ # Use basilisk
+ proc <- basilisk::basiliskStart(py_env)
+ on.exit(basilisk::basiliskStop(proc))
+
+ success <- basilisk::basiliskRun(proc, function(sce_obj, out_path) {
+ anndata <- reticulate::import("anndata")
+ zarr <- reticulate::import("zarr")
+
+ adata <- zellkonverter::SCE2AnnData(sce_obj)
+ adata$write_zarr(out_path)
+ return(TRUE)
+ }, sce_obj = sce_obj, out_path = out_path)
+ return(success)
+}
+
+#' Save a SpatialExperiment to an AnnData-Zarr store.
+#'
+#' @param spe_obj The object to save.
+#' @param out_path A path to the output Zarr store.
+#' @return TRUE if the conversion succeeds.
+#'
+#' @export
+#' @importFrom SummarizedExperiment colData
+#' @importFrom SingleCellExperiment int_colData
+#' @importFrom SpatialExperiment colData<-
+spe_to_anndata_zarr <- function(spe_obj, out_path) {
+ internal_col_data <- int_colData(spe_obj)
+
+ colData(spe_obj) <- cbind(
+ colData(spe_obj),
+ internal_col_data$spatialCoords,
+ # spatialData deprecated in 1.5.2
+ # internal_col_data$spatialData,
+ internal_col_data$reducedDims
+ )
+
+ success <- sce_to_anndata_zarr(spe_obj, out_path)
+ return(success)
+}
+
+#' Save an image in a SpatialExperiment to an OME-Zarr store
+#'
+#' @param spe_obj The object containing the image.
+#' @param sample_id The sample_id in the imgData data frame.
+#' @param image_id The image_id in the imgData data frame.
+#' @param out_path A path to the output Zarr store.
+#' @return TRUE if the conversion succeeds.
+#'
+#' @export
+#' @examples
+#' obj <- get_spe_obj()
+#' spe_to_ome_zarr(obj, "sample1", "image1", "data/spe_image.zarr")
+#' @importFrom SpatialExperiment getImg
+#' @importFrom grDevices as.raster col2rgb
+spe_to_ome_zarr <- function(spe_obj, sample_id, image_id, out_path) {
+ img_arr <- apply(as.matrix(as.raster(getImg(spe_obj, image_id = image_id, sample_id = sample_id))), c(1, 2), col2rgb)
+
+ # Use basilisk
+ proc <- basilisk::basiliskStart(py_env)
+ on.exit(basilisk::basiliskStop(proc))
+
+ success <- basilisk::basiliskRun(proc, function(img_arr, sample_id, image_id, out_path) {
+ zarr <- reticulate::import("zarr")
+ ome_zarr <- reticulate::import("ome_zarr")
+
+ z_root <- zarr$open_group(out_path, mode = "w")
+
+ # Need to copy this here since can't refer to functions in the outside environment.
+ obj_list <- function(...) {
+ retval <- stats::setNames(list(), character(0))
+ param_list <- list(...)
+ for(key in names(param_list)) {
+ retval[[key]] = param_list[[key]]
+ }
+ retval
+ }
+
+ default_window <- obj_list(
+ start = 0,
+ min = 0,
+ max = 255,
+ end = 255
+ )
+
+ ome_zarr$writer$write_image(
+ image = img_arr,
+ group = z_root,
+ axes = "cyx",
+ omero = obj_list(
+ name = image_id,
+ version = "0.3",
+ rdefs = obj_list(
+
+ ),
+ channels = list(
+ obj_list(
+ label = "r",
+ color = "FF0000",
+ window = default_window
+ ),
+ obj_list(
+ label = "g",
+ color = "00FF00",
+ window = default_window
+ ),
+ obj_list(
+ label = "b",
+ color = "0000FF",
+ window = default_window
+ )
+ )
+ )
+ )
+ return(TRUE)
+ }, img_arr = img_arr, sample_id = sample_id, image_id = image_id, out_path = out_path)
+ return(success)
+}
+
+#' Save a Giotto object to an AnnData-Zarr store
+#'
+#' @param giotto_obj The object to save.
+#' @param out_path A path to the output Zarr store.
+#' @param X_slot The name of the slot in the Giotto object to use for adata.X
+#' @return TRUE if the conversion succeeds.
+#'
+#' @export
+#' @examples
+#' obj <- get_giotto_obj()
+#' giotto_to_anndata_zarr(obj, "data/giotto.zarr")
+#' @importFrom methods slot
+giotto_to_anndata_zarr <- function(giotto_obj, out_path, X_slot = "raw_exprs") {
+
+ # Use basilisk
+ proc <- basilisk::basiliskStart(py_env)
+ on.exit(basilisk::basiliskStop(proc))
+
+ success <- basilisk::basiliskRun(proc, function(giotto_obj, out_path, X_slot) {
+ anndata <- reticulate::import("anndata")
+ zarr <- reticulate::import("zarr")
+
+ # Reference: https://github.com/theislab/zellkonverter/blob/master/R/SCE2AnnData.R#L237
+ make_numpy_friendly <- function(x, transpose = TRUE) {
+ if (transpose) {
+ x <- Matrix::t(x)
+ }
+ if (DelayedArray::is_sparse(x)) {
+ methods::as(x, "dgCMatrix")
+ } else {
+ as.matrix(x)
+ }
+ }
+
+ X <- make_numpy_friendly(slot(giotto_obj, X_slot))
+ obs <- slot(giotto_obj, "cell_metadata")
+ var <- slot(giotto_obj, "gene_metadata")
+
+ adata <- anndata$AnnData(X = X, obs = obs, var = var)
+
+ obsm <- list()
+
+ if(!is.null(slot(giotto_obj, "spatial_locs"))) {
+ spatial_locs <- slot(giotto_obj, "spatial_locs")
+ obsm[['spatial']] <- t(as.matrix(spatial_locs[, c("sdimx", "sdimy")]))
+ }
+
+ if(!is.null(slot(giotto_obj, "dimension_reduction"))) {
+ dim_reducs <- slot(giotto_obj, "dimension_reduction")$cells
+ for(dim_reduc_name in names(dim_reducs)) {
+ dim_reduc_coords <- dim_reducs[[dim_reduc_name]][[dim_reduc_name]]$coordinates
+ obsm[[dim_reduc_name]] <- t(as.matrix(dim_reduc_coords))
+ }
+ }
+
+ if(length(obsm) > 0) {
+ # TODO make_numpy_friendly is outside scope
+ obsm <- lapply(obsm, make_numpy_friendly)
+ adata$obsm <- obsm
+ }
+
+ adata$write_zarr(out_path)
+ return(TRUE)
+ }, giotto_obj = giotto_obj, out_path = out_path, X_slot = X_slot)
+ return(success)
+}
diff --git a/R/helpers.R b/R/helpers.R
new file mode 100644
index 0000000..d5958a7
--- /dev/null
+++ b/R/helpers.R
@@ -0,0 +1,88 @@
+#' Horizontally concatenate views
+#'
+#' A helper function to construct a new `VitessceConfigViewHConcat` object based on multiple views.
+#'
+#' @param ... A variable number of `VitessceConfigView`, `VitessceConfigViewHConcat`, or `VitessceConfigViewVConcat` objects.
+#' @return A `VitessceConfigViewHConcat` object.
+#'
+#' @export
+#' @examples
+#' vc <- VitessceConfig$new("My config")
+#' ds <- vc$add_dataset("My dataset")
+#' spatial <- vc$add_view(ds, Component$SPATIAL)
+#' gene_list <- vc$add_view(ds, Component$GENES)
+#' vc$layout(hconcat(spatial, gene_list))
+#' vc$widget()
+hconcat <- function(...) {
+ vcvhc <- VitessceConfigViewHConcat$new(list(...))
+ vcvhc
+}
+
+#' Vertically concatenate views
+#'
+#' A helper function to construct a new `VitessceConfigViewVConcat` object based on multiple views.
+#'
+#' @param ... A variable number of `VitessceConfigView`, `VitessceConfigViewHConcat`, or `VitessceConfigViewVConcat` objects.
+#' @return A `VitessceConfigViewVConcat` object.
+#'
+#' @export
+#' @examples
+#' vc <- VitessceConfig$new("My config")
+#' ds <- vc$add_dataset("My dataset")
+#' spatial <- vc$add_view(ds, Component$SPATIAL)
+#' gene_list <- vc$add_view(ds, Component$GENES)
+#' vc$layout(vconcat(spatial, gene_list))
+#' vc$widget()
+vconcat <- function(...) {
+ vcvvc <- VitessceConfigViewVConcat$new(list(...))
+ vcvvc
+}
+
+#' Create an empty named list
+#'
+#' A helper function to construct an empty list which converts to a JSON object rather than a JSON array.
+#'
+#' @keywords internal
+#' @param ... A variable number of list entries.
+#' @return An empty named list.
+#'
+#' @export
+#' @examples
+#' default_window <- obj_list(
+#' min = 0,
+#' max = 255
+#' )
+obj_list <- function(...) {
+ retval <- stats::setNames(list(), character(0))
+ param_list <- list(...)
+ for(key in names(param_list)) {
+ retval[[key]] = param_list[[key]]
+ }
+ retval
+}
+
+#' Check if a value, potentially a vector, is NA
+#'
+#' @keywords internal
+#' @param val The value to check
+#' @return Whether the value is NA
+is_na <- function(val) {
+ if(length(val) > 1) {
+ return(FALSE)
+ } else {
+ return(is.na(val))
+ }
+}
+
+#' Try to stop a future
+#'
+#' @keywords internal
+#' @param f The future to stop
+#' @return Nothing
+stop_future <- function(f) {
+ # Reference: https://github.com/HenrikBengtsson/future/issues/93#issuecomment-349625087
+ if(!is.null(f$job) && Sys.getpid() != f$job$pid) {
+ tools::pskill(f$job$pid, signal = tools::SIGTERM)
+ tools::pskill(f$job$pid, signal = tools::SIGKILL)
+ }
+}
diff --git a/R/mock_objects.R b/R/mock_objects.R
new file mode 100644
index 0000000..866435c
--- /dev/null
+++ b/R/mock_objects.R
@@ -0,0 +1,105 @@
+#' Create a mock Seurat object for tests and examples.
+#' @return The object.
+#' @keywords internal
+#' @export
+#' @examples
+#' obj <- get_seurat_obj()
+#' @importFrom stats rpois
+get_seurat_obj <- function() {
+ if(!requireNamespace("Seurat", quietly = TRUE)) {
+ stop("Install 'Seurat' to enable creation of Seurat objects.")
+ }
+
+ ncells <- 100
+ u <- matrix(rpois(20000, 5), ncol=ncells)
+ cell_names <- paste0("Cell", seq_len(ncells))
+ rownames(u) <- paste0("Gene", seq_len(nrow(u)))
+ colnames(u) <- cell_names
+ metadata.test <- data.frame(
+ cluster_id = c(rep(1, 50), rep(2, 50))
+ )
+ rownames(metadata.test) <- cell_names
+
+ obj <- Seurat::CreateSeuratObject(
+ counts = u,
+ project = "TESTING",
+ assay = "RNA",
+ names.field = 2,
+ names.delim = "-",
+ meta.data = metadata.test
+ )
+
+ return(obj)
+}
+
+#' Create a mock SCE object for tests and examples.
+#' @return The object.
+#' @keywords internal
+#' @export
+#' @examples
+#' obj <- get_sce_obj()
+get_sce_obj <- function() {
+ ncells <- 100
+ u <- matrix(rpois(20000, 5), ncol=ncells)
+ v <- matrix(rnorm(20000), ncol=ncells)
+ obj <- SingleCellExperiment::SingleCellExperiment(assays=list(counts=u, logcounts=v))
+ rownames(obj) <- paste0("Gene", seq_len(nrow(v)))
+ colnames(obj) <- paste0("Cell", seq_len(ncells))
+ return(obj)
+}
+
+#' Create a mock SPE object for tests and examples.
+#' @return The object.
+#' @keywords internal
+#' @export
+#' @examples
+#' obj <- get_spe_obj()
+#' @importFrom methods new
+#' @importFrom stats rnorm rpois runif
+get_spe_obj <- function() {
+
+ # Reference: https://github.com/drighelli/SpatialExperiment/blob/cbf6515/tests/testthat/test_SpatialImage-methods.R#L26
+ n <- 10 # number of rows / height
+ m <- 20 # number of columns / width
+ N <- 3 # number of images in SpE
+ .mockRaster <- function(n, m) {
+ x <- runif(n*m)
+ y <- matrix(x, n, m)
+ as.raster(y)
+ }
+ .mockSPI <- function(n, m) {
+ r <- .mockRaster(n, m)
+ new("LoadedSpatialImage", image=r)
+ }
+ l <- replicate(N, .mockSPI(n, m))
+ sample_id <- paste0("sample", seq_len(N))
+ image_id <- paste0("image", seq_len(N))
+
+ u <- matrix(rpois(3*100, 5), ncol=N)
+ v <- matrix(rnorm(3*100), ncol=N)
+
+ cd <- S4Vectors::DataFrame(sample_id)
+ df <- S4Vectors::DataFrame(sample_id, image_id, data=I(l), scaleFactor=seq_len(N))
+ obj <- SpatialExperiment::SpatialExperiment(assays=list(counts=u, logcounts=v), colData=cd, imgData=df)
+ return(obj)
+}
+
+#' Create a mock Giotto object for tests and examples.
+#' @return The object.
+#' @keywords internal
+#' @export
+#' @examples
+#' obj <- get_giotto_obj()
+get_giotto_obj <- function() {
+
+ if(!requireNamespace("Giotto", quietly = TRUE)) {
+ stop("Install 'Giotto' to enable creation of Giotto objects.")
+ }
+
+ expr_path <- system.file("extdata", "giotto", "visium_DG_expr.txt", package = "vitessceR")
+ loc_path <- system.file("extdata", "giotto", "visium_DG_locs.txt", package = "vitessceR")
+
+ obj <- Giotto::createGiottoObject(raw_exprs = expr_path, spatial_locs = loc_path)
+
+ return(obj)
+}
diff --git a/R/namespace.R b/R/namespace.R
new file mode 100644
index 0000000..874128d
--- /dev/null
+++ b/R/namespace.R
@@ -0,0 +1,4 @@
+# Suppress R CMD check note
+#' @import R6
+#' @import plumber
+NULL
diff --git a/R/wrappers_giotto.R b/R/wrappers_giotto.R
new file mode 100644
index 0000000..09b6344
--- /dev/null
+++ b/R/wrappers_giotto.R
@@ -0,0 +1,248 @@
+#' Giotto object wrapper class
+#' @title GiottoWrapper Class
+#' @docType class
+#' @description
+#' Class representing a local Giotto object in a Vitessce dataset.
+#'
+#' @rdname GiottoWrapper
+#' @export
+#' @examples
+#' obj <- get_giotto_obj()
+#' w <- GiottoWrapper$new(
+#' obj,
+#' cell_embeddings = c("pca"),
+#' cell_embedding_names = c("PCA")
+#' )
+GiottoWrapper <- R6::R6Class("GiottoWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field obj The object to wrap.
+ #' @keywords internal
+ obj = NULL,
+ #' @field cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embeddings = NULL,
+ #' @field cell_embedding_names Names
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_names = NULL,
+ #' @field cell_embedding_dims The dimension indices
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_dims = NULL,
+ #' @field cell_set_metas The keys in the Seurat object's meta.data
+ #' to use for creating cell sets.
+ #' @keywords internal
+ cell_set_metas = NULL,
+ #' @field cell_set_meta_names The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to new names.
+ #' @keywords internal
+ cell_set_meta_names = NULL,
+ #' @field cell_set_meta_scores The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to keys for scores.
+ #' @keywords internal
+ cell_set_meta_scores = NULL,
+ #' @field zarr_folder The name for the folder at the root of the zarr store.
+ #' @keywords internal
+ zarr_folder = NULL,
+ #' @description
+ #' Create a wrapper around a Seurat object.
+ #' @param obj The object to wrap.
+ #' @param cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_names Names
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_dims An array of dimension indices to use for each cell_embedding.
+ #' @param cell_set_metas An optional list of keys in the object's meta.data
+ #' list to use for creating cell sets.
+ #' @param cell_set_meta_names If cell_set_metas is provided, this list can
+ #' also be provided to set new names to replace
+ #' the keys in the interface.
+ #' @param cell_set_meta_scores If cell_set_metas is provided, this list can
+ #' also be provided to map between meta.data keys for set annotations
+ #' and keys for annotation scores.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `GiottoWrapper` object.
+ initialize = function(obj, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ self$cell_embeddings <- cell_embeddings
+ self$cell_embedding_names <- cell_embedding_names
+ self$cell_embedding_dims <- cell_embedding_dims
+ self$cell_set_metas <- cell_set_metas
+ self$cell_set_meta_names <- cell_set_meta_names
+ self$cell_set_meta_scores <- cell_set_meta_scores
+
+ self$zarr_folder <- "giotto.zarr"
+
+ self$check_obj()
+ },
+ #' @description
+ #' Check that the object is valid
+ #' @keywords internal
+ #' @return Success or failure.
+ check_obj = function() {
+ success <- TRUE
+ if(!methods::is(self$obj, "giotto")) {
+ warning("Object is not of type giotto.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_embeddings) && !all(self$cell_embeddings %in% names(self$obj@dimension_reduction$cells))) {
+ warning("Specified cell_embeddings not all present in Giotto object dimension_reduction")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_set_metas) && !all(self$cell_set_metas %in% colnames(self$obj@cell_metadata))) {
+ warning("Specified cell_set_metas not all present in Giotto object cell_metadata.")
+ success <- FALSE
+ }
+ return(success)
+ },
+ #' @description
+ #' Get the path to the zarr store, relative to the current directory.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A path as a string.
+ get_zarr_path = function(dataset_uid, obj_i) {
+ out_dir <- super$get_out_dir(dataset_uid, obj_i)
+ zarr_filepath <- file.path(out_dir, self$zarr_folder)
+ return(zarr_filepath)
+ },
+ #' @description
+ #' Get the URL to the Zarr store, to fill in the file URL in the file definitions.
+ #' @param base_url The base URL, on which the route will be served.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A URL as a string.
+ get_zarr_url = function(base_url, dataset_uid, obj_i) {
+ return(super$get_url(base_url, dataset_uid, obj_i, self$zarr_folder))
+ },
+ #' @description
+ #' Create the JSON output files, web server routes, and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ zarr_filepath <- self$get_zarr_path(dataset_uid, obj_i)
+ if(!file.exists(zarr_filepath) || !self$use_cache) {
+ giotto_to_anndata_zarr(self$obj, out_path = zarr_filepath)
+ }
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+ cell_sets_file_creator <- self$make_cell_sets_file_def_creator(dataset_uid, obj_i)
+ expression_matrix_file_creator <- self$make_expression_matrix_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creators functions to the main list.
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, cell_sets_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+
+ # Create a web server route object for the directory of JSON files.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ },
+ #' @description
+ #' Make the file definition creator function for the cells data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ options <- obj_list()
+ if(!is_na(slot(self$obj, "spatial_locs"))) {
+ options[['xy']] <- "obsm/spatial"
+ }
+ if(!is_na(self$cell_embeddings)) {
+ options[['mappings']] <- obj_list()
+ for(i in seq_len(length(self$cell_embeddings))) {
+ embedding_key <- self$cell_embeddings[i]
+ if(!is_na(self$cell_embedding_names)) {
+ embedding_name <- self$cell_embedding_names[i]
+ } else {
+ embedding_name <- embedding_key
+ }
+ if(!is_na(self$cell_embedding_dims)) {
+ embedding_dims <- self$cell_embedding_dims[i]
+ } else {
+ embedding_dims <- c(0, 1)
+ }
+ options[['mappings']][[embedding_name]] <- obj_list(
+ key = paste0("obsm/", embedding_key),
+ dims = embedding_dims
+ )
+ }
+ }
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$ANNDATA_CELLS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ #' @description
+ #' Make the file definition creator function for the cell sets data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cell_sets_file_def_creator = function(dataset_uid, obj_i) {
+ get_cell_sets <- function(base_url) {
+ options <- list()
+ if(!is_na(self$cell_set_metas)) {
+ for(i in seq_len(length(self$cell_set_metas))) {
+ cell_set_key <- self$cell_set_metas[i]
+ if(!is_na(self$cell_set_meta_names)) {
+ group_name <- self$cell_set_meta_names[i]
+ } else {
+ group_name <- cell_set_key
+ }
+
+ cell_set_def <- obj_list(
+ groupName = group_name,
+ setName = paste0("obs/", cell_set_key)
+ )
+ if(!is_na(self$cell_set_meta_scores)) {
+ score_name <- self$cell_set_meta_scores[i]
+ # TODO: uncomment
+ #cell_set_def[['scoreName']] <- score_name
+ }
+ options <- append(options, list(cell_set_def))
+ }
+ }
+ file_def <- list(
+ type = DataType$CELL_SETS,
+ fileType = FileType$ANNDATA_CELL_SETS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cell_sets)
+ },
+ #' @description
+ #' Make the file definition creator function for the expression matrix data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_expression_matrix_file_def_creator = function(dataset_uid, obj_i) {
+ get_expression_matrix <- function(base_url) {
+ options = obj_list(
+ matrix = "X"
+ )
+ file_def <- list(
+ type = DataType$EXPRESSION_MATRIX,
+ fileType = FileType$ANNDATA_EXPRESSION_MATRIX_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_expression_matrix)
+ }
+ ),
+)
diff --git a/R/wrappers_images.R b/R/wrappers_images.R
new file mode 100644
index 0000000..31b7a2e
--- /dev/null
+++ b/R/wrappers_images.R
@@ -0,0 +1,232 @@
+#' Image wrapper class
+#' @title MultiImageWrapper Class
+#' @docType class
+#' @description
+#' Class representing image objects in a Vitessce dataset.
+#'
+#' @rdname MultiImageWrapper
+#' @export
+MultiImageWrapper <- R6::R6Class("MultiImageWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field image_wrappers The object to wrap.
+ #' @keywords internal
+ image_wrappers = NULL,
+ #' @field use_physical_size_scaling Whether or not to scale the image based on the physical size metadata stored in the file.
+ #' @keywords internal
+ use_physical_size_scaling = NULL,
+ #' @description
+ #' Create a wrapper around multiple image objects.
+ #' @param image_wrappers A list of individual image wrapper objects.
+ #' @param use_physical_size_scaling Whether or not to scale the image based on the physical size metadata stored in the file.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `MultiImageWrapper` object.
+ initialize = function(image_wrappers, use_physical_size_scaling = FALSE, ...) {
+ super$initialize(...)
+ self$image_wrappers <- image_wrappers
+ self$use_physical_size_scaling <- use_physical_size_scaling
+ },
+ #' @description
+ #' Create the web server routes and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ for(image in self$image_wrappers) {
+ image$convert_and_save(dataset_uid, obj_i)
+ }
+
+ # Get the file definition creator functions.
+ raster_file_creator <- self$make_raster_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creators functions to the main list.
+ self$file_def_creators <- append(self$file_def_creators, raster_file_creator)
+
+ # Create a web server route object for the directory of JSON files.
+ routes <- self$make_raster_routes()
+ self$routes <- append(self$routes, routes)
+ },
+ #' @description
+ #' Create a list representing the image routes.
+ #' @return A list of server route objects.
+ #' @keywords internal
+ make_raster_routes = function() {
+ obj_routes <- list()
+ for(i in length(self$image_wrappers)) {
+ image <- self$image_wrappers[[i]]
+ image_routes <- image$get_routes()
+ obj_routes <- c(obj_routes, image_routes)
+ }
+ obj_routes
+ },
+ #' @description
+ #' Make the file definition creator function for the raster data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_raster_file_def_creator = function(dataset_uid, obj_i) {
+ get_raster <- function(base_url) {
+ options_def <- list(
+ schemaVersion = "0.0.2",
+ usePhysicalSizeScaling = self$use_physical_size_scaling,
+ images = list(),
+ renderLayers = list()
+ )
+ for(image in self$image_wrappers) {
+ image_def <- image$make_image_def(dataset_uid, obj_i, base_url)
+ options_def$images <- append(options_def$images, list(image_def))
+ options_def$renderLayers <- append(options_def$renderLayers, image$name)
+ }
+ file_def <- list(
+ type = DataType$RASTER,
+ fileType = FileType$RASTER_JSON,
+ options = options_def
+ )
+ return(file_def)
+ }
+ return(get_raster)
+ }
+ ),
+)
+
+#' OME-TIFF object wrapper class
+#' @title OmeTiffWrapper Class
+#' @docType class
+#' @description
+#' Class representing an OME-TIFF file in a Vitessce dataset.
+#'
+#' @rdname OmeTiffWrapper
+#' @export
+OmeTiffWrapper <- R6::R6Class("OmeTiffWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field img_path A local filepath to an OME-TIFF file.
+ #' @keywords internal
+ img_path = NULL,
+ #' @field img_url A remote URL of an OME-TIFF file.
+ #' @keywords internal
+ img_url = NULL,
+ #' @field name The display name for this OME-TIFF within Vitessce.
+ #' @keywords internal
+ name = NULL,
+ #' @field transformation_matrix A column-major ordered matrix for transforming
+ #' this image (see http://www.opengl-tutorial.org/beginners-tutorials/tutorial-3-matrices/#homogeneous-coordinates for more information).
+ #' @keywords internal
+ transformation_matrix = NULL,
+ #' @field is_bitmask Whether or not this image is a bitmask.
+ #' @keywords internal
+ is_bitmask = NULL,
+ #' @field is_remote Whether or not this image is remote.
+ #' @keywords internal
+ is_remote = NULL,
+ #' @description
+ #' Create a wrapper around multiple image objects.
+ #' @param img_path A local filepath to an OME-TIFF file.
+ #' @param img_url A remote URL of an OME-TIFF file.
+ #' @param name The display name for this OME-TIFF within Vitessce.
+ #' @param transformation_matrix A column-major ordered matrix for transforming
+ #' this image (see http://www.opengl-tutorial.org/beginners-tutorials/tutorial-3-matrices/#homogeneous-coordinates for more information).
+ #' @param is_bitmask Whether or not this image is a bitmask.
+ #' @param use_physical_size_scaling Whether or not to scale the image based on the physical size metadata stored in the file.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `OmeTiffWrapper` object.
+ initialize = function(img_path = NA, img_url = NA, name = "", transformation_matrix = NA, is_bitmask = FALSE, ...) {
+ super$initialize(...)
+ self$img_path <- img_path
+ self$img_url <- img_url
+ self$name <- name
+ self$transformation_matrix <- transformation_matrix
+ self$is_bitmask <- is_bitmask
+
+ if(!is.na(img_url) && !is.na(img_path)) {
+ warning("Expected either img_path or img_url to be provided, but not both.")
+ }
+ self$is_remote <- !is.na(img_url)
+
+ },
+ #' @description
+ #' Create the web server routes and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ if(!self$is_remote) {
+ super$convert_and_save(dataset_uid, obj_i)
+ }
+
+ # Get the file definition creator functions.
+ raster_file_creator <- self$make_raster_file_def_creator(dataset_uid, obj_i)
+ self$file_def_creators <- append(self$file_def_creators, raster_file_creator)
+
+ routes <- self$make_raster_routes(dataset_uid, obj_i)
+ self$routes <- c(self$routes, routes)
+ },
+ #' @description
+ #' Create a list representing the server routes.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A list of server route objects.
+ #' @keywords internal
+ make_raster_routes = function(dataset_uid, obj_i) {
+ if(self$is_remote) {
+ return(list())
+ } else {
+ route <- VitessceConfigServerRangeRoute$new(
+ self$get_route_str(dataset_uid, obj_i, basename(self$img_path)),
+ self$img_path
+ )
+ return(list(route))
+ }
+ },
+ #' @description
+ #' Create an object representing a single image in a raster.json list of images.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @param base_url The base URL for the server.
+ #' @return A list that can be converted to JSON.
+ #' @keywords internal
+ make_image_def = function(dataset_uid, obj_i, base_url) {
+ img_url <- NA
+ if(self$is_remote) {
+ img_url <- self$img_url
+ } else {
+ img_url <- self$get_url(base_url, dataset_uid, obj_i, basename(self$img_path))
+ }
+
+ img_def <- list(
+ name = self$name,
+ type = "ome-tiff",
+ url = img_url
+ )
+ metadata <- obj_list()
+ if(!is.na(self$transformation_matrix)) {
+ metadata[['transform']] = list(
+ matrix = self$transformation_matrix
+ )
+ }
+ metadata[['isBitmask']] = self$is_bitmask
+ img_def[['metadata']] = metadata
+ img_def
+ },
+ #' @description
+ #' Make the file definition creator function for the raster data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_raster_file_def_creator = function(dataset_uid, obj_i) {
+ get_raster <- function(base_url) {
+ options_def <- list(
+ schemaVersion = "0.0.2",
+ images = list(
+ self$make_image_def(dataset_uid, obj_i, base_url)
+ )
+ )
+ file_def <- list(
+ type = DataType$RASTER,
+ fileType = FileType$RASTER_JSON,
+ options = options_def
+ )
+ return(file_def)
+ }
+ return(get_raster)
+ }
+ ),
+)
diff --git a/R/wrappers_sce.R b/R/wrappers_sce.R
new file mode 100644
index 0000000..704ebc2
--- /dev/null
+++ b/R/wrappers_sce.R
@@ -0,0 +1,244 @@
+#' SingleCellExperiment object wrapper class
+#' @title SCEWrapper Class
+#' @docType class
+#' @description
+#' Class representing a local SingleCellExperiment object in a Vitessce dataset.
+#'
+#' @rdname SCEWrapper
+#' @export
+#' @examples
+#' obj <- get_sce_obj()
+#' w <- SCEWrapper$new(
+#' obj,
+#' cell_embeddings = c("pca"),
+#' cell_embedding_names = c("PCA")
+#' )
+SCEWrapper <- R6::R6Class("SCEWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field obj The object to wrap.
+ #' @keywords internal
+ obj = NULL,
+ #' @field cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embeddings = NULL,
+ #' @field cell_embedding_names Names
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_names = NULL,
+ #' @field cell_embedding_dims The dimension indices
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_dims = NULL,
+ #' @field cell_set_metas The keys in the Seurat object's meta.data
+ #' to use for creating cell sets.
+ #' @keywords internal
+ cell_set_metas = NULL,
+ #' @field cell_set_meta_names The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to new names.
+ #' @keywords internal
+ cell_set_meta_names = NULL,
+ #' @field cell_set_meta_scores The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to keys for scores.
+ #' @keywords internal
+ cell_set_meta_scores = NULL,
+ #' @field zarr_folder The name for the folder at the root of the zarr store.
+ #' @keywords internal
+ zarr_folder = NULL,
+ #' @description
+ #' Create a wrapper around a Seurat object.
+ #' @param obj The object to wrap.
+ #' @param cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_names Names
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_dims An array of dimension indices to use for each cell_embedding.
+ #' @param cell_set_metas An optional list of keys in the object's meta.data
+ #' list to use for creating cell sets.
+ #' @param cell_set_meta_names If cell_set_metas is provided, this list can
+ #' also be provided to set new names to replace
+ #' the keys in the interface.
+ #' @param cell_set_meta_scores If cell_set_metas is provided, this list can
+ #' also be provided to map between meta.data keys for set annotations
+ #' and keys for annotation scores.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `SCEWrapper` object.
+ initialize = function(obj, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ self$cell_embeddings <- cell_embeddings
+ self$cell_embedding_names <- cell_embedding_names
+ self$cell_embedding_dims <- cell_embedding_dims
+ self$cell_set_metas <- cell_set_metas
+ self$cell_set_meta_names <- cell_set_meta_names
+ self$cell_set_meta_scores <- cell_set_meta_scores
+
+ self$zarr_folder <- "sce.zarr"
+ self$check_obj()
+ },
+ #' @description
+ #' Check that the object is valid
+ #' @keywords internal
+ #' @return Success or failure.
+ check_obj = function() {
+ success <- TRUE
+ if(!methods::is(self$obj, "SingleCellExperiment")) {
+ warning("Object is not of type SingleCellExperiment.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_embeddings) && !all(self$cell_embeddings %in% SingleCellExperiment::reducedDimNames(self$obj))) {
+ warning("Specified cell_embeddings not all present in SCE object reducedDims.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_set_metas) && !all(self$cell_set_metas %in% colnames(SingleCellExperiment::colData(self$obj)))) {
+ warning("Specified cell_set_metas not all present in SCE object colData.")
+ success <- FALSE
+ }
+ return(success)
+ },
+ #' @description
+ #' Get the path to the zarr store, relative to the current directory.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A path as a string.
+ get_zarr_path = function(dataset_uid, obj_i) {
+ out_dir <- super$get_out_dir(dataset_uid, obj_i)
+ zarr_filepath <- file.path(out_dir, self$zarr_folder)
+ return(zarr_filepath)
+ },
+ #' @description
+ #' Get the URL to the Zarr store, to fill in the file URL in the file definitions.
+ #' @param base_url The base URL, on which the route will be served.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A URL as a string.
+ get_zarr_url = function(base_url, dataset_uid, obj_i) {
+ return(super$get_url(base_url, dataset_uid, obj_i, self$zarr_folder))
+ },
+ #' @description
+ #' Create the JSON output files, web server routes, and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ zarr_filepath <- self$get_zarr_path(dataset_uid, obj_i)
+ if(!file.exists(zarr_filepath) || !self$use_cache) {
+ sce_to_anndata_zarr(self$obj, out_path = zarr_filepath)
+ }
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+ cell_sets_file_creator <- self$make_cell_sets_file_def_creator(dataset_uid, obj_i)
+ expression_matrix_file_creator <- self$make_expression_matrix_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creators functions to the main list.
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, cell_sets_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+
+ # Create a web server route object for the directory of JSON files.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ },
+ #' @description
+ #' Make the file definition creator function for the cells data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ options <- obj_list()
+ if(!is_na(self$cell_embeddings)) {
+ options[['mappings']] <- obj_list()
+ for(i in seq_len(length(self$cell_embeddings))) {
+ embedding_key <- self$cell_embeddings[i]
+ if(!is_na(self$cell_embedding_names)) {
+ embedding_name <- self$cell_embedding_names[i]
+ } else {
+ embedding_name <- embedding_key
+ }
+ if(!is_na(self$cell_embedding_dims)) {
+ embedding_dims <- self$cell_embedding_dims[i]
+ } else {
+ embedding_dims <- c(0, 1)
+ }
+ options[['mappings']][[embedding_name]] <- obj_list(
+ key = paste0("obsm/", embedding_key),
+ dims = embedding_dims
+ )
+ }
+ }
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$ANNDATA_CELLS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ #' @description
+ #' Make the file definition creator function for the cell sets data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cell_sets_file_def_creator = function(dataset_uid, obj_i) {
+ get_cell_sets <- function(base_url) {
+ options <- list()
+ if(!is_na(self$cell_set_metas)) {
+ for(i in seq_len(length(self$cell_set_metas))) {
+ cell_set_key <- self$cell_set_metas[i]
+ if(!is_na(self$cell_set_meta_names)) {
+ group_name <- self$cell_set_meta_names[i]
+ } else {
+ group_name <- cell_set_key
+ }
+
+ cell_set_def <- obj_list(
+ groupName = group_name,
+ setName = paste0("obs/", cell_set_key)
+ )
+ if(!is_na(self$cell_set_meta_scores)) {
+ score_name <- self$cell_set_meta_scores[i]
+ # TODO: uncomment
+ #cell_set_def[['scoreName']] <- score_name
+ }
+ options <- append(options, list(cell_set_def))
+ }
+ }
+ file_def <- list(
+ type = DataType$CELL_SETS,
+ fileType = FileType$ANNDATA_CELL_SETS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cell_sets)
+ },
+ #' @description
+ #' Make the file definition creator function for the expression matrix data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_expression_matrix_file_def_creator = function(dataset_uid, obj_i) {
+ get_expression_matrix <- function(base_url) {
+ options = obj_list(
+ matrix = "X"
+ )
+ file_def <- list(
+ type = DataType$EXPRESSION_MATRIX,
+ fileType = FileType$ANNDATA_EXPRESSION_MATRIX_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_expression_matrix)
+ }
+ ),
+)
diff --git a/R/wrappers_seurat.R b/R/wrappers_seurat.R
new file mode 100644
index 0000000..8f004b5
--- /dev/null
+++ b/R/wrappers_seurat.R
@@ -0,0 +1,262 @@
+#' Seurat object wrapper class
+#' @title SeuratWrapper Class
+#' @docType class
+#' @description
+#' Class representing a local Seurat object in a Vitessce dataset.
+#'
+#' @rdname SeuratWrapper
+#' @export
+#' @examples
+#' obj <- get_seurat_obj()
+#' w <- SeuratWrapper$new(
+#' obj,
+#' cell_embeddings = c("pca"),
+#' cell_embedding_names = c("PCA")
+#' )
+SeuratWrapper <- R6::R6Class("SeuratWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field obj The object to wrap.
+ #' @keywords internal
+ obj = NULL,
+ #' @field assay The assay name in the Seurat object.
+ #' @keywords internal
+ assay = NULL,
+ #' @field cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embeddings = NULL,
+ #' @field cell_embedding_names Names
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_names = NULL,
+ #' @field cell_embedding_dims The dimension indices
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_dims = NULL,
+ #' @field cell_set_metas The keys in the Seurat object's meta.data
+ #' to use for creating cell sets.
+ #' @keywords internal
+ cell_set_metas = NULL,
+ #' @field cell_set_meta_names The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to new names.
+ #' @keywords internal
+ cell_set_meta_names = NULL,
+ #' @field cell_set_meta_scores The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to keys for scores.
+ #' @keywords internal
+ cell_set_meta_scores = NULL,
+ #' @field zarr_folder The name for the folder at the root of the zarr store.
+ #' @keywords internal
+ zarr_folder = NULL,
+ #' @description
+ #' Create a wrapper around a Seurat object.
+ #' @param obj The object to wrap.
+ #' @param assay The assay name under the assays part of the Seurat object.
+ #' @param cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_names Names
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_dims An array of dimension indices to use for each cell_embedding.
+ #' @param cell_set_metas An optional list of keys in the object's meta.data
+ #' list to use for creating cell sets.
+ #' @param cell_set_meta_names If cell_set_metas is provided, this list can
+ #' also be provided to set new names to replace
+ #' the keys in the interface.
+ #' @param cell_set_meta_scores If cell_set_metas is provided, this list can
+ #' also be provided to map between meta.data keys for set annotations
+ #' and keys for annotation scores.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `SeuratWrapper` object.
+ initialize = function(obj, assay = NA, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ if(is.na(assay)) {
+ self$assay <- "RNA"
+ } else {
+ self$assay <- assay
+ }
+ self$cell_embeddings <- cell_embeddings
+ self$cell_embedding_names <- cell_embedding_names
+ self$cell_embedding_dims <- cell_embedding_dims
+ self$cell_set_metas <- cell_set_metas
+ self$cell_set_meta_names <- cell_set_meta_names
+ self$cell_set_meta_scores <- cell_set_meta_scores
+
+ self$zarr_folder <- "seurat.zarr"
+
+ self$check_obj()
+ },
+ #' @description
+ #' Check that the object is valid
+ #' @keywords internal
+ #' @return Success or failure.
+ check_obj = function() {
+ success <- TRUE
+ if(is.null(self$obj)) {
+ warning("Object is NULL.")
+ return(FALSE)
+ }
+ if(!methods::is(self$obj, "Seurat")) {
+ warning("Object is not of type Seurat.")
+ success <- FALSE
+ }
+ if(!(self$assay %in% names(self$obj@assays))) {
+ warning("Specified assay not present in Seurat object assays slot.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_embeddings) && !all(self$cell_embeddings %in% names(self$obj@reductions))) {
+ warning("Specified cell_embeddings not all present in Seurat object reductions slot.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_set_metas) && !all(self$cell_set_metas %in% colnames(self$obj@meta.data))) {
+ warning("Specified cell_set_metas not all present in columns of the Seurat object meta.data data frame.")
+ success <- FALSE
+ }
+ return(success)
+ },
+ #' @description
+ #' Get the path to the zarr store, relative to the current directory.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A path as a string.
+ get_zarr_path = function(dataset_uid, obj_i) {
+ out_dir <- super$get_out_dir(dataset_uid, obj_i)
+ zarr_filepath <- file.path(out_dir, self$zarr_folder)
+ return(zarr_filepath)
+ },
+ #' @description
+ #' Get the URL to the Zarr store, to fill in the file URL in the file definitions.
+ #' @param base_url The base URL, on which the route will be served.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A URL as a string.
+ get_zarr_url = function(base_url, dataset_uid, obj_i) {
+ return(super$get_url(base_url, dataset_uid, obj_i, self$zarr_folder))
+ },
+ #' @description
+ #' Create the JSON output files, web server routes, and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ zarr_filepath <- self$get_zarr_path(dataset_uid, obj_i)
+ if(!file.exists(zarr_filepath) || !self$use_cache) {
+ seurat_to_anndata_zarr(self$obj, out_path = zarr_filepath, assay = self$assay)
+ }
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+ cell_sets_file_creator <- self$make_cell_sets_file_def_creator(dataset_uid, obj_i)
+ expression_matrix_file_creator <- self$make_expression_matrix_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creators functions to the main list.
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, cell_sets_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+
+ # Create a web server route object for the directory of JSON files.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ },
+ #' @description
+ #' Make the file definition creator function for the cells data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ options <- obj_list()
+ if(!is_na(self$cell_embeddings)) {
+ options[['mappings']] <- obj_list()
+ for(i in seq_len(length(self$cell_embeddings))) {
+ embedding_key <- self$cell_embeddings[i]
+ if(!is_na(self$cell_embedding_names)) {
+ embedding_name <- self$cell_embedding_names[i]
+ } else {
+ embedding_name <- embedding_key
+ }
+ if(!is_na(self$cell_embedding_dims)) {
+ embedding_dims <- self$cell_embedding_dims[i]
+ } else {
+ embedding_dims <- c(0, 1)
+ }
+ options[['mappings']][[embedding_name]] <- obj_list(
+ key = paste0("obsm/X_", embedding_key),
+ dims = embedding_dims
+ )
+ }
+ }
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$ANNDATA_CELLS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ #' @description
+ #' Make the file definition creator function for the cell sets data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cell_sets_file_def_creator = function(dataset_uid, obj_i) {
+ get_cell_sets <- function(base_url) {
+ options <- list()
+ if(!is_na(self$cell_set_metas)) {
+ for(i in seq_len(length(self$cell_set_metas))) {
+ cell_set_key <- self$cell_set_metas[i]
+ if(!is_na(self$cell_set_meta_names)) {
+ group_name <- self$cell_set_meta_names[i]
+ } else {
+ group_name <- cell_set_key
+ }
+
+ cell_set_def <- obj_list(
+ groupName = group_name,
+ setName = paste0("obs/", cell_set_key)
+ )
+ if(!is_na(self$cell_set_meta_scores)) {
+ score_name <- self$cell_set_meta_scores[i]
+ # TODO: uncomment
+ #cell_set_def[['scoreName']] <- score_name
+ }
+ options <- append(options, list(cell_set_def))
+ }
+ }
+ file_def <- list(
+ type = DataType$CELL_SETS,
+ fileType = FileType$ANNDATA_CELL_SETS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cell_sets)
+ },
+ #' @description
+ #' Make the file definition creator function for the expression matrix data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_expression_matrix_file_def_creator = function(dataset_uid, obj_i) {
+ get_expression_matrix <- function(base_url) {
+ options = obj_list(
+ matrix = "X"
+ )
+ file_def <- list(
+ type = DataType$EXPRESSION_MATRIX,
+ fileType = FileType$ANNDATA_EXPRESSION_MATRIX_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_expression_matrix)
+ }
+ ),
+)
diff --git a/R/wrappers_spe.R b/R/wrappers_spe.R
new file mode 100644
index 0000000..d23270a
--- /dev/null
+++ b/R/wrappers_spe.R
@@ -0,0 +1,319 @@
+#' SpatialExperiment object wrapper class
+#' @title SPEWrapper Class
+#' @docType class
+#' @description
+#' Class representing a local SpatialExperiment object in a Vitessce dataset.
+#'
+#' @rdname SPEWrapper
+#' @export
+#' @examples
+#' obj <- get_spe_obj()
+#' w <- SPEWrapper$new(
+#' obj,
+#' sample_id = "sample1",
+#' image_id = "image1"
+#' )
+SPEWrapper <- R6::R6Class("SPEWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ #' @field obj The object to wrap.
+ #' @keywords internal
+ obj = NULL,
+ #' @field img_sample_id The sample_id for the image of interest.
+ #' @keywords internal
+ img_sample_id = NULL,
+ #' @field img_image_id The image_id for the image of interest.
+ #' @keywords internal
+ img_image_id = NULL,
+ #' @field cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embeddings = NULL,
+ #' @field cell_embedding_names Names
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_names = NULL,
+ #' @field cell_embedding_dims The dimension indices
+ #' to use for creating dimensionality reduction mappings.
+ #' @keywords internal
+ cell_embedding_dims = NULL,
+ #' @field cell_set_metas The keys in the Seurat object's meta.data
+ #' to use for creating cell sets.
+ #' @keywords internal
+ cell_set_metas = NULL,
+ #' @field cell_set_meta_names The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to new names.
+ #' @keywords internal
+ cell_set_meta_names = NULL,
+ #' @field cell_set_meta_scores The keys in the Seurat object's meta.data
+ #' to use for cell set names mapped to keys for scores.
+ #' @keywords internal
+ cell_set_meta_scores = NULL,
+ #' @field zarr_folder The name for the folder at the root of the zarr store.
+ #' @keywords internal
+ zarr_folder = NULL,
+ #' @field img_filename The name for the folder at the root of the zarr store for the image.
+ #' @keywords internal
+ img_filename = NULL,
+ #' @description
+ #' Create a wrapper around a Seurat object.
+ #' @param obj The object to wrap.
+ #' @param sample_id The sample_id for the image of interest.
+ #' @param image_id The image_id for the image of interest.
+ #' @param cell_embeddings The keys in the Seurat object's reductions/cell.embeddings
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_names Names
+ #' to use for creating dimensionality reduction plots.
+ #' @param cell_embedding_dims An array of dimension indices to use for each cell_embedding.
+ #' @param cell_set_metas An optional list of keys in the object's meta.data
+ #' list to use for creating cell sets.
+ #' @param cell_set_meta_names If cell_set_metas is provided, this list can
+ #' also be provided to set new names to replace
+ #' the keys in the interface.
+ #' @param cell_set_meta_scores If cell_set_metas is provided, this list can
+ #' also be provided to map between meta.data keys for set annotations
+ #' and keys for annotation scores.
+ #' @param ... Parameters inherited from `AbstractWrapper`.
+ #' @return A new `SPEWrapper` object.
+ initialize = function(obj, sample_id = NA, image_id = NA, cell_embeddings = NA, cell_embedding_names = NA, cell_embedding_dims = NA, cell_set_metas = NA, cell_set_meta_names = NA, cell_set_meta_scores = NA, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ if(is_na(sample_id) && is_na(image_id)) {
+ img_df <- SpatialExperiment::imgData(obj)
+ if(nrow(img_df) >= 1) {
+ warning("sample_id and image_id not provided, using first image in imgData")
+ self$img_sample_id <- img_df[1, "sample_id"]
+ self$img_image_id <- img_df[1, "image_id"]
+ }
+ } else {
+ self$img_sample_id <- sample_id
+ self$img_image_id <- image_id
+ }
+
+ self$cell_embeddings <- cell_embeddings
+ self$cell_embedding_names <- cell_embedding_names
+ self$cell_embedding_dims <- cell_embedding_dims
+ self$cell_set_metas <- cell_set_metas
+ self$cell_set_meta_names <- cell_set_meta_names
+ self$cell_set_meta_scores <- cell_set_meta_scores
+
+ self$zarr_folder <- "spe.zarr"
+ self$img_filename <- paste0(self$img_sample_id, "__", self$img_image_id, ".zarr")
+
+ self$check_obj()
+ },
+ #' @description
+ #' Check that the object is valid
+ #' @keywords internal
+ #' @return Success or failure.
+ check_obj = function() {
+ success <- TRUE
+ if(!methods::is(self$obj, "SpatialExperiment")) {
+ warning("Object is not of type SpatialExperiment.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_embeddings) && !all(self$cell_embeddings %in% SingleCellExperiment::reducedDimNames(self$obj))) {
+ warning("Specified cell_embeddings not all present in SPE object reducedDims.")
+ success <- FALSE
+ }
+ if(!is_na(self$cell_set_metas) && !all(self$cell_set_metas %in% colnames(SingleCellExperiment::colData(self$obj)))) {
+ warning("Specified cell_set_metas not all present in SPE object colData.")
+ success <- FALSE
+ }
+ img_df <- SpatialExperiment::imgData(self$obj)
+ if(!is_na(self$img_sample_id) && !is_na(self$img_image_id) && !(self$img_sample_id %in% img_df$sample_id && self$img_image_id %in% img_df$image_id)) {
+ warning("Specified sample_id and/or image_id not present in SPE object imgData.")
+ success <- FALSE
+ }
+ return(success)
+ },
+ #' @description
+ #' Get the path to the zarr store, relative to the current directory.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A path as a string.
+ get_zarr_path = function(dataset_uid, obj_i) {
+ out_dir <- super$get_out_dir(dataset_uid, obj_i)
+ zarr_filepath <- file.path(out_dir, self$zarr_folder)
+ return(zarr_filepath)
+ },
+ #' @description
+ #' Get the URL to the Zarr store, to fill in the file URL in the file definitions.
+ #' @param base_url The base URL, on which the route will be served.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A URL as a string.
+ get_zarr_url = function(base_url, dataset_uid, obj_i) {
+ return(super$get_url(base_url, dataset_uid, obj_i, self$zarr_folder))
+ },
+ #' @description
+ #' Get the path to the image Zarr store, relative to the current directory.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A path as a string.
+ get_img_path = function(dataset_uid, obj_i) {
+ out_dir <- super$get_out_dir(dataset_uid, obj_i)
+ zarr_filepath <- file.path(out_dir, self$img_filename)
+ return(zarr_filepath)
+ },
+ #' @description
+ #' Get the URL to the image Zarr store, to fill in the file URL in the file definitions.
+ #' @param base_url The base URL, on which the route will be served.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @keywords internal
+ #' @return A URL as a string.
+ get_img_url = function(base_url, dataset_uid, obj_i) {
+ return(super$get_url(base_url, dataset_uid, obj_i, self$img_filename))
+ },
+ #' @description
+ #' Create the JSON output files, web server routes, and file definition creators.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ zarr_filepath <- self$get_zarr_path(dataset_uid, obj_i)
+ img_filepath <- self$get_img_path(dataset_uid, obj_i)
+ if(!file.exists(zarr_filepath) || !file.exists(img_filepath) || !self$use_cache) {
+ spe_to_anndata_zarr(self$obj, out_path = zarr_filepath)
+ spe_to_ome_zarr(self$obj, sample_id = self$img_sample_id, image_id = self$img_image_id, out_path = img_filepath)
+ }
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+ cell_sets_file_creator <- self$make_cell_sets_file_def_creator(dataset_uid, obj_i)
+ expression_matrix_file_creator <- self$make_expression_matrix_file_def_creator(dataset_uid, obj_i)
+ raster_file_creator <- self$make_raster_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creators functions to the main list.
+ if(!is_na(self$cell_embeddings)) {
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+ }
+ if(!is_na(self$cell_set_metas)) {
+ self$file_def_creators <- append(self$file_def_creators, cell_sets_file_creator)
+ }
+ self$file_def_creators <- append(self$file_def_creators, expression_matrix_file_creator)
+ self$file_def_creators <- append(self$file_def_creators, raster_file_creator)
+
+ # Create a web server route object for the directory of JSON files.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ },
+ #' @description
+ #' Make the file definition creator function for the cells data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ options <- obj_list()
+ if(!is_na(self$cell_embeddings)) {
+ options[['mappings']] <- obj_list()
+ for(i in seq_len(length(self$cell_embeddings))) {
+ embedding_key <- self$cell_embeddings[i]
+ if(!is_na(self$cell_embedding_names)) {
+ embedding_name <- self$cell_embedding_names[i]
+ } else {
+ embedding_name <- embedding_key
+ }
+ if(!is_na(self$cell_embedding_dims)) {
+ embedding_dims <- self$cell_embedding_dims[i]
+ } else {
+ embedding_dims <- c(0, 1)
+ }
+ options[['mappings']][[embedding_name]] <- obj_list(
+ key = paste0("obsm/", embedding_key),
+ dims = embedding_dims
+ )
+ }
+ }
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$ANNDATA_CELLS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ #' @description
+ #' Make the file definition creator function for the cell sets data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_cell_sets_file_def_creator = function(dataset_uid, obj_i) {
+ get_cell_sets <- function(base_url) {
+ options <- list()
+ if(!is_na(self$cell_set_metas)) {
+ for(i in seq_len(length(self$cell_set_metas))) {
+ cell_set_key <- self$cell_set_metas[i]
+ if(!is_na(self$cell_set_meta_names)) {
+ group_name <- self$cell_set_meta_names[i]
+ } else {
+ group_name <- cell_set_key
+ }
+
+ cell_set_def <- obj_list(
+ groupName = group_name,
+ setName = paste0("obs/", cell_set_key)
+ )
+ if(!is_na(self$cell_set_meta_scores)) {
+ score_name <- self$cell_set_meta_scores[i]
+ # TODO: uncomment
+ #cell_set_def[['scoreName']] <- score_name
+ }
+ options <- append(options, list(cell_set_def))
+ }
+ }
+ file_def <- list(
+ type = DataType$CELL_SETS,
+ fileType = FileType$ANNDATA_CELL_SETS_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_cell_sets)
+ },
+ #' @description
+ #' Make the file definition creator function for the expression matrix data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_expression_matrix_file_def_creator = function(dataset_uid, obj_i) {
+ get_expression_matrix <- function(base_url) {
+ options = obj_list(
+ matrix = "X"
+ )
+ file_def <- list(
+ type = DataType$EXPRESSION_MATRIX,
+ fileType = FileType$ANNDATA_EXPRESSION_MATRIX_ZARR,
+ url = self$get_zarr_url(base_url, dataset_uid, obj_i),
+ options = options
+ )
+ return(file_def)
+ }
+ return(get_expression_matrix)
+ },
+ #' @description
+ #' Make the file definition creator function for the raster data type.
+ #' @param dataset_uid The ID for this dataset.
+ #' @param obj_i The index of this data object within the dataset.
+ #' @return A file definition creator function which takes a `base_url` parameter.
+ make_raster_file_def_creator = function(dataset_uid, obj_i) {
+ get_raster <- function(base_url) {
+ file_def <- list(
+ type = DataType$RASTER,
+ fileType = FileType$RASTER_OME_ZARR,
+ url = self$get_img_url(base_url, dataset_uid, obj_i)
+ )
+ return(file_def)
+ }
+ return(get_raster)
+ }
+ ),
+)
diff --git a/README.md b/README.md
index 9c47ceb..4039e5a 100644
--- a/README.md
+++ b/README.md
@@ -1 +1,75 @@
+
+
# vitessceAnalysisR
+
+![R package version](https://img.shields.io/github/r-package/v/vitessce/vitessceAnalysisR) [![docs](https://img.shields.io/badge/docs-📖-57B4E9.svg)](https://vitessce.github.io/vitessceAnalysisR/)
+
+Data preparation functions to support [vitessceR](https://github.com/vitessce/vitessceR).
+
+## Installation
+
+Installation requires R 4.0.0 or greater.
+
+```r
+install.packages("devtools")
+devtools::install_github("vitessce/vitessceAnalysisR")
+```
+
+## Usage
+
+```r
+library(vitessceAnalysisR)
+
+# TODO
+```
+
+For full examples, visit the [documentation](https://vitessce.github.io/vitessceAnalysisR/).
+
+For questions and help with using the package, please open a [discussion](https://github.com/vitessce/vitessceAnalysisR/discussions).
+
+
+## Development
+
+```r
+setwd("path/to/vitessceAnalysisR")
+install.packages("htmlwidgets")
+install.packages("devtools")
+devtools::install()
+devtools::load_all()
+```
+
+## Testing
+
+```r
+devtools::check()
+devtools::test()
+```
+
+## Documentation
+
+```r
+install.packages("devtools")
+install.packages("pkgdown")
+devtools::document()
+pkgdown::build_site()
+```
+
+Documentation is automatically deployed to GitHub pages with GitHub actions.
+
+## Deployment
+
+Currently, the package is only distributed through GitHub.
+In the future, we plan to submit the package to CRAN or Bioconductor.
+
+To increment the package version, update it in [`DESCRIPTION`](https://github.com/vitessce/vitessceAnalysisR/blob/master/DESCRIPTION#L4).
+
+## Resources
+
+- [r leaflet](https://github.com/rstudio/leaflet)
+- [R packages](https://r-pkgs.org/)
+- [roxygen2 syntax](https://cran.r-project.org/web/packages/roxygen2/vignettes/rd-formatting.html)
+- [R6](https://r6.r-lib.org/index.html)
+- [R6 roxygen2 syntax](https://www.tidyverse.org/blog/2019/11/roxygen2-7-0-0/#r6-documentation)
+- [plumber: programmatic usage](https://www.rplumber.io/articles/programmatic-usage.html)
+- [pkgdown](https://pkgdown.r-lib.org/)
+- [S4](http://adv-r.had.co.nz/S4.html)
diff --git a/configure b/configure
new file mode 100755
index 0000000..9b03c32
--- /dev/null
+++ b/configure
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+${R_HOME}/bin/Rscript -e "basilisk::configureBasiliskEnv()"
diff --git a/configure.win b/configure.win
new file mode 100755
index 0000000..e9af497
--- /dev/null
+++ b/configure.win
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe -e "basilisk::configureBasiliskEnv()"
diff --git a/index.md b/index.md
new file mode 100644
index 0000000..7860c3a
--- /dev/null
+++ b/index.md
@@ -0,0 +1,25 @@
+
+Vitessce is a visual integration tool for exploration of spatial single-cell experiments. To learn more about the features of Vitessce, please visit our [core docs](http://vitessce.io).
+
+## Getting Started
+
+The ``vitessceAnalysisR`` package includes data conversion wrapper classes to process data stored in common single-cell file types including Seurat objects.
+
+
+## Installation
+
+Installation requires R 4.0.0 or greater.
+
+```r
+install.packages("devtools")
+devtools::install_github("vitessce/vitessceAnalysisR")
+```
+
+## Examples
+
+
+```r
+library(vitessceAnalysisR)
+
+# TODO
+```
diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml
new file mode 100644
index 0000000..df8817f
--- /dev/null
+++ b/pkgdown/_pkgdown.yml
@@ -0,0 +1,84 @@
+url: https://vitessce.github.io/vitessceAnalysisR/
+
+template:
+ bootstrap: 5
+ bslib:
+ base_font: {google: "Inter"}
+
+authors:
+ Gehlenborg Lab:
+ href: http://gehlenborglab.org/
+ Mark Keller:
+ href: https://github.com/keller-mark
+
+navbar:
+ structure:
+ left: [home, reference, examples, articles]
+ right: [core_docs, github]
+ components:
+ examples:
+ text: Examples
+ menu:
+ - text: "Examples with Remote Data"
+ - text: "Usage with OME-TIFF: Remote Example"
+ href: articles/web_only/ome_tiff_remote.html
+ - text: "Usage with JSON: Remote Example"
+ href: articles/web_only/json_remote.html
+ - text: -------
+ - text: "Examples with Local Data"
+ - text: "Overview: Using the widget with local data"
+ href: articles/local_data_overview.html
+ - text: "Usage with SeuratData"
+ href: articles/seuratdata.html
+ - text: "Usage with Seurat: Basic Example"
+ href: articles/seurat_basic.html
+ - text: "Usage with Seurat: Reference Mapping"
+ href: articles/seurat_azimuth.html
+ - text: "Usage with SingleCellExperiment"
+ href: articles/single_cell_experiment.html
+ - text: "Usage with SpatialExperiment"
+ href: articles/spatial_experiment.html
+ - text: "Usage with OME-TIFF: Local Example"
+ href: articles/ome_tiff_local.html
+ - text: "Usage with JSON: Local Example"
+ href: articles/json_local.html
+ - text: -------
+ - text: "Other Examples"
+ - text: "Usage with Shiny"
+ href: articles/shiny.html
+ - text: "Usage with pkgdown"
+ href: articles/pkgdown.html
+ - text: "Export data to static files"
+ href: articles/export_files.html
+ core_docs:
+ text: "Core Docs"
+ href: http://vitessce.io/docs/
+
+footer:
+ structure:
+ left: [authors]
+ right: built_with
+ components:
+ authors: Developed by the Gehlenborg Lab
+
+reference:
+- title: "Data preparation functions"
+ desc: "Helpers for converting data to formats compatible with Vitessce."
+- contents:
+ - seurat_to_anndata_zarr
+ - sce_to_anndata_zarr
+ - spe_to_anndata_zarr
+ - spe_to_ome_zarr
+ - giotto_to_anndata_zarr
+
+articles:
+ - title: Articles
+ navbar: Developer guides
+ contents:
+ - dev_wrapper_class
+ - dev_wrapper_subclass
+ - title: Articles
+ navbar: Troubleshooting
+ contents:
+ - debugging
+ - session_info
diff --git a/pkgdown/extra.css b/pkgdown/extra.css
new file mode 100644
index 0000000..321187e
--- /dev/null
+++ b/pkgdown/extra.css
@@ -0,0 +1,6 @@
+.vitessce-container .bg-primary, .vitessce-container .bg-secondary {
+ background-color: inherit !important;
+}
+.vitessce-container table {
+ display: table;
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..a1a07c0
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(vitessceR)
+
+test_check("vitessceR")
diff --git a/tests/testthat/setup-wrappers-seurat.R b/tests/testthat/setup-wrappers-seurat.R
new file mode 100644
index 0000000..ca14064
--- /dev/null
+++ b/tests/testthat/setup-wrappers-seurat.R
@@ -0,0 +1,10 @@
+setup({
+ url <- "https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz"
+ dir.create("seurat", showWarnings = FALSE)
+ dir.create(file.path("seurat", "out"), showWarnings = FALSE)
+ download.file(url, destfile = file.path("seurat", "filtered_gene_bc_matrices.tar.gz"))
+ untar(file.path("seurat", "filtered_gene_bc_matrices.tar.gz"), exdir = "seurat")
+})
+teardown({
+ unlink(file.path("seurat", "filtered_gene_bc_matrices.tar.gz"))
+})
diff --git a/tests/testthat/test-config.R b/tests/testthat/test-config.R
new file mode 100644
index 0000000..78915bf
--- /dev/null
+++ b/tests/testthat/test-config.R
@@ -0,0 +1,427 @@
+library(vitessceR)
+
+test_that("VitessceConfig new", {
+ vc <- VitessceConfig$new("My config")
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(),
+ coordinationSpace = obj_list(),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfig add_dataset", {
+ vc <- VitessceConfig$new("My config")
+ vc$add_dataset("My dataset")
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+
+
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list()
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfigDataset add_file", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+ ds$add_file("http://example.com/cells", "cells", "cells.json")
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list(
+ list(
+ url = "http://example.com/cells",
+ type = "cells",
+ fileType = "cells.json"
+ )
+ )
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfigDataset add_file twice", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+ ds$add_file("http://example.com/cells", "cells", "cells.json")$add_file("http://example.com/molecules", "molecules", "molecules.json")
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list(
+ list(
+ url = "http://example.com/cells",
+ type = "cells",
+ fileType = "cells.json"
+ ),
+ list(
+ url = "http://example.com/molecules",
+ type = "molecules",
+ fileType = "molecules.json"
+ )
+ )
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfigDataset add_file with options", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+
+ file_options = obj_list(
+ schemaVersion = "0.0.2",
+ images = list(
+ obj_list(
+ name = "Image",
+ type = "ome-tiff",
+ url = "https://vitessce-demo-data.storage.googleapis.com/exemplar-001/exemplar-001.pyramid.ome.tif"
+ )
+ ),
+ renderLayers = list(
+ "Image"
+ )
+ )
+ ds$add_file(data_type = "cells", file_type = "cells.json", options = file_options)
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list(
+ list(
+ type = "cells",
+ fileType = "cells.json",
+ options = file_options
+ )
+ )
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfigDataset add_object", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+
+ MockWrapper <- R6::R6Class("SeuratWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ convert_and_save = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ return(list(
+ url = "http://localhost:8000/cells",
+ type = "cells",
+ fileType = "cells.json"
+ ))
+ }
+ self$file_def_creators <- append(self$file_def_creators, get_cells)
+ }
+ )
+ )
+
+ obj <- MockWrapper$new()
+ ds$add_object(obj)
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list(
+ list(
+ url = "http://localhost:8000/cells",
+ type = "cells",
+ fileType = "cells.json"
+ )
+ )
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfig add_view", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+ v1 <- vc$add_view(ds, "spatial")
+ v2 <- vc$add_view(ds, "scatterplot", mapping = "UMAP")
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list()
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ ),
+ embeddingType = list(
+ A = jsonlite::unbox("UMAP")
+ )
+ ),
+ layout = list(
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ ),
+ list(
+ component = "scatterplot",
+ coordinationScopes = list(
+ dataset = "A",
+ embeddingType = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ )
+ ),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfig add_coordination", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+ v1 <- vc$add_view(ds, "spatial")
+ v2 <- vc$add_view(ds, "spatial")
+
+ c_scopes <- vc$add_coordination(c("spatialZoom", "spatialTargetX"))
+ c_scopes[[1]]$set_value(10)
+ c_scopes[[2]]$set_value(20)
+ v1$use_coordination(c_scopes)
+ v2$use_coordination(c_scopes)
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list()
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ ),
+ spatialZoom = list(
+ A = jsonlite::unbox(10)
+ ),
+ spatialTargetX = list(
+ A = jsonlite::unbox(20)
+ )
+ ),
+ layout = list(
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A",
+ spatialZoom = "A",
+ spatialTargetX = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ ),
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A",
+ spatialZoom = "A",
+ spatialTargetX = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ )
+ ),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfig layout", {
+ vc <- VitessceConfig$new("My config")
+ ds <- vc$add_dataset("My dataset")
+ v1 <- vc$add_view(ds, "spatial")
+ v2 <- vc$add_view(ds, "description")
+ v3 <- vc$add_view(ds, "layerController")
+
+ vc$layout(hconcat(v1, vconcat(v2, v3)))
+
+ vc_list <- vc$to_list(base_url = "http://localhost:8000")
+ expect_equal(vc_list, list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list()
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = jsonlite::unbox("A")
+ )
+ ),
+ layout = list(
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A"
+ ),
+ x = 0, y = 0, w = 6, h = 12
+ ),
+ list(
+ component = "description",
+ coordinationScopes = list(
+ dataset = "A"
+ ),
+ x = 6, y = 0, w = 6, h = 6
+ ),
+ list(
+ component = "layerController",
+ coordinationScopes = list(
+ dataset = "A"
+ ),
+ x = 6, y = 6, w = 6, h = 6
+ )
+ ),
+ initStrategy = "auto"
+ ))
+})
+
+test_that("VitessceConfig from list", {
+ vc_list_orig <- list(
+ version = "1.0.9",
+ name = "My config",
+ description = "",
+ datasets = list(
+ list(
+ uid = "A",
+ name = "My dataset",
+ files = list()
+ )
+ ),
+ coordinationSpace = list(
+ dataset = list(
+ A = "A"
+ ),
+ spatialZoom = list(
+ A = 10
+ ),
+ spatialTargetX = list(
+ A = 20
+ )
+ ),
+ layout = list(
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A",
+ spatialZoom = "A",
+ spatialTargetX = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ ),
+ list(
+ component = "spatial",
+ coordinationScopes = list(
+ dataset = "A",
+ spatialZoom = "A",
+ spatialTargetX = "A"
+ ),
+ x = 0, y = 0, w = 1, h = 1
+ )
+ ),
+ initStrategy = "auto"
+ )
+
+ vc <- VitessceConfig$from_list(vc_list_orig)
+
+ vc_list_loaded <- vc$to_list(base_url = "http://localhost:8000")
+ vc_list_orig[['coordinationSpace']][['dataset']][['A']] <- jsonlite::unbox("A")
+ vc_list_orig[['coordinationSpace']][['spatialZoom']][['A']] <- jsonlite::unbox(10)
+ vc_list_orig[['coordinationSpace']][['spatialTargetX']][['A']] <- jsonlite::unbox(20)
+ expect_equal(vc_list_loaded, vc_list_orig)
+})
diff --git a/tests/testthat/test-wrappers-seurat.R b/tests/testthat/test-wrappers-seurat.R
new file mode 100644
index 0000000..76d078b
--- /dev/null
+++ b/tests/testthat/test-wrappers-seurat.R
@@ -0,0 +1,64 @@
+library(vitessceR)
+library(Seurat)
+
+test_that("SeuratWrapper create_cells_list", {
+ pbmc.data <- Read10X(data.dir = "seurat/filtered_gene_bc_matrices/hg19")
+
+ pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
+ pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")
+ pbmc <- subset(pbmc, subset = nFeature_RNA > 200 & nFeature_RNA < 2500 & percent.mt < 5)
+ pbmc <- NormalizeData(pbmc, normalization.method = "LogNormalize", scale.factor = 10000)
+ pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)
+ all.genes <- rownames(pbmc)
+ pbmc <- ScaleData(pbmc, features = all.genes)
+ pbmc <- RunPCA(pbmc, features = VariableFeatures(object = pbmc))
+ pbmc <- FindNeighbors(pbmc, dims = 1:10)
+ pbmc <- FindClusters(pbmc, resolution = 0.5)
+
+ w <- SeuratWrapper$new(
+ pbmc,
+ cell_embeddings = c("pca"),
+ cell_embedding_names = c("PCA"),
+ cell_set_metas = c("seurat_clusters"),
+ cell_set_meta_names = c("Clusters"),
+ out_dir = file.path("seurat", "out")
+ )
+
+ cells_file_def <- w$make_cells_file_def_creator("A", "1")("http://localhost")
+ cell_sets_file_def <- w$make_cell_sets_file_def_creator("A", "1")("http://localhost")
+ expr_mtx_file_def <- w$make_expression_matrix_file_def_creator("A", "1")("http://localhost")
+
+ expect_equal(cells_file_def, list(
+ type = "cells",
+ fileType = "anndata-cells.zarr",
+ url = "http://localhost/A/1/seurat.zarr",
+ options = list(
+ mappings = list(
+ PCA = list(
+ key = "obsm/X_pca",
+ dims = c(0, 1)
+ )
+ )
+ )
+ ))
+ expect_equal(cell_sets_file_def, list(
+ type = "cell-sets",
+ fileType = "anndata-cell-sets.zarr",
+ url = "http://localhost/A/1/seurat.zarr",
+ options = list(
+ list(
+ groupName = "Clusters",
+ setName = "obs/seurat_clusters"
+ )
+ )
+ ))
+ expect_equal(expr_mtx_file_def, list(
+ type = "expression-matrix",
+ fileType = "anndata-expression-matrix.zarr",
+ url = "http://localhost/A/1/seurat.zarr",
+ options = list(
+ matrix = "X"
+ )
+ ))
+
+})
diff --git a/tests/testthat/test-wrappers.R b/tests/testthat/test-wrappers.R
new file mode 100644
index 0000000..49b4216
--- /dev/null
+++ b/tests/testthat/test-wrappers.R
@@ -0,0 +1,30 @@
+library(vitessceR)
+
+test_that("AbstractWrapper get_url", {
+ w <- AbstractWrapper$new()
+
+ route <- w$get_url("http://example.com", "A", 1, "cells")
+ expect_equal(route, "http://example.com/A/1/cells")
+})
+
+test_that("AbstractWrapper get_route_str", {
+ w <- AbstractWrapper$new()
+
+ url <- w$get_route_str("A", 1, "cells")
+ expect_equal(url, "/A/1/cells")
+})
+
+test_that("AbstractWrapper get_out_dir_route", {
+ w <- AbstractWrapper$new(out_dir = "test")
+
+ route <- w$get_out_dir_route("A", 1)
+ expect_equal(route$path, "/A/1")
+ expect_equal(route$directory, "test/A/1")
+})
+
+test_that("AbstractWrapper get_out_dir", {
+ w <- AbstractWrapper$new(out_dir = "test")
+
+ out_dir <- w$get_out_dir("A", 1, "cells")
+ expect_equal(out_dir, "test/A/1/cells")
+})
diff --git a/tools/check.env b/tools/check.env
new file mode 100644
index 0000000..fd9ef01
--- /dev/null
+++ b/tools/check.env
@@ -0,0 +1,47 @@
+# Reference: https://cran.r-project.org/doc/manuals/r-devel/R-ints.html#Tools
+
+# Report if package size is larger than 25 megabytes
+_R_CHECK_PKG_SIZES_THRESHOLD_=25
+
+# If true, give an error if suggested packages are not available.
+_R_CHECK_FORCE_SUGGESTS_=FALSE
+
+# Reference: https://github.com/Bioconductor/packagebuilder/blob/master/check.Renviron
+#_R_CHECK_FORCE_SUGGESTS_=TRUE
+_R_CHECK_RD_LINE_WIDTHS_=TRUE
+_R_CHECK_EXECUTABLES_=FALSE
+_R_CHECK_EXECUTABLES_EXCLUSIONS_=FALSE
+_R_CHECK_FF_DUP_=TRUE
+_R_CHECK_VC_DIR_=TRUE
+_R_CHECK_PKG_SIZES_=TRUE
+#_R_CHECK_PKG_SIZES_THRESHOLD_=5
+_R_CHECK_REPLACING_IMPORTS_=TRUE
+_R_CHECK_TIMINGS_="0"
+_R_CHECK_INSTALL_DEPENDS_=TRUE
+_R_CHECK_SUGGESTS_ONLY_=TRUE
+_R_CHECK_NO_RECOMMENDED_=TRUE
+_R_CHECK_CODE_ASSIGN_TO_GLOBALENV_=TRUE
+_R_CHECK_CODE_ATTACH_=TRUE
+_R_CHECK_CODE_DATA_INTO_GLOBALENV_=TRUE
+_R_CHECK_DOT_FIRSTLIB_=TRUE
+_R_CHECK_DEPRECATED_DEFUNCT_=TRUE
+_R_CHECK_TOPLEVELFILES_=TRUE
+_R_CHECK_LIMIT_CORES_=TRUE
+_R_CHECK_CODE_USAGE_VIA_NAMESPACES_=TRUE
+_R_CHECK_S3_METHODS_NOT_REGISTERED_=TRUE
+_R_CHECK_OVERWRITE_REGISTERED_S3_METHODS_=TRUE
+_R_S3_METHOD_LOOKUP_BASEENV_AFTER_GLOBALENV_=TRUE
+_R_CHECK_TESTS_NLINES_=20
+_R_CHECK_NATIVE_ROUTINE_REGISTRATION_=TRUE
+_R_CHECK_NO_STOP_ON_TEST_ERROR_=TRUE
+_R_CHECK_PRAGMAS_=TRUE
+_R_CHECK_COMPILATION_FLAGS_=TRUE
+_R_CHECK_R_DEPENDS_="warn"
+_R_CHECK_SERIALIZATION_=TRUE
+_R_CHECK_R_ON_PATH_=TRUE
+_R_CHECK_PACKAGES_USED_IN_TESTS_USE_SUBDIRS_=TRUE
+_R_CHECK_SHLIB_OPENMP_FLAGS_=TRUE
+_R_CHECK_CONNECTIONS_LEFT_OPEN_=TRUE
+_R_CHECK_FUTURE_FILE_TIMESTAMPS_=TRUE
+_R_CHECK_LENGTH_1_CONDITION_ =package:_R_CHECK_PACKAGE_NAME_
+_R_CHECK_LENGTH_1_LOGIC2_=package:_R_CHECK_PACKAGE_NAME_
diff --git a/vignettes/debugging.Rmd b/vignettes/debugging.Rmd
new file mode 100644
index 0000000..817e347
--- /dev/null
+++ b/vignettes/debugging.Rmd
@@ -0,0 +1,61 @@
+---
+title: "Debugging"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Debugging}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+When working with the `vitessceR` package, you may encounter issues, particularly related to file formatting, file permissions, URL typos, etc. Below, we list some debugging methods that may help to resolve these bugs.
+
+If none of these tips help, please write an issue on [GitHub](https://github.com/vitessce/vitessceR/issues).
+
+The following code snippets assume that `vitessceR` has been loaded via `library(vitessceR)` and the Vitessce configuration instance is stored in the variable `vc`:
+
+
+```r
+library(vitessceR)
+vc <- VitessceConfig$new("My single-cell data visualization")
+```
+
+## Use the `out_dir` parameter for data object wrapper classes
+
+Rather than using a temporary directory, this will write converted files to the specified directory.
+This way, you can open and explore the converted output files.
+
+```r
+dir.create("./debug")
+
+dataset <- vc$add_dataset("My dataset")
+dataset <- dataset$add_object(SeuratWrapper$new(pbmc3k.final, out_dir = "./debug"))
+```
+
+## Use the `port` parameter
+
+```r
+vc$widget(port = 9000)
+```
+
+## Add the `status` component to the layout
+
+```r
+status <- vc$add_view(dataset, Component$STATUS)
+vc$layout(hconcat(scatterplot, status))
+```
+
+## Write the configuration to JSON
+
+```r
+vc_list <- vc$to_list()
+jsonlite::toJSON(vc_list, auto_unbox = TRUE)
+```
+
+## Open the browser console
+
+If the Vitessce widget loads in the RStudio "Viewer" tab, but the data fails to load or there are issues related to the user interface, you can open the browser console to check for errors or warning messages.
+
+To do so, right click in the Viewer area and select "Inspect Element."
+
+Then, click "Console" in the inspector window that appears.
+
diff --git a/vignettes/dev_wrapper_class.Rmd b/vignettes/dev_wrapper_class.Rmd
new file mode 100644
index 0000000..5b42590
--- /dev/null
+++ b/vignettes/dev_wrapper_class.Rmd
@@ -0,0 +1,208 @@
+---
+title: "Developer guide: Writing a data wrapper class"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Developer guide: Writing a data wrapper class}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is a guide for development of wrapper classes for single-cell data structures.
+For this guide, we will focus on writing a wrapper class for Seurat objects which supports the `cells`, `cell-sets`, and `expression-matrix` Vitessce data types.
+
+To begin, we can write a skeleton for the class, which contains functions that we will fill in.
+Here, we start by overriding the `convert_and_save` function of the parent `AbstractWrapper` class.
+
+The `initialize` constructor function takes the parameter `obj` which will be the Seurat of interest (i.e., the object that we are wrapping).
+
+The `convert_and_save` function performs any required data conversion steps, creates the web server routes, and creates the corresponding file definition creator functions.
+
+Complete file definitions cannot be finalized at this stage because the file definitions depend on the `base_url` (the URL on which the files will ultimately be served, typically "http://localhost:8000").
+
+```r
+SeuratWrapper <- R6::R6Class("SeuratWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ obj = NULL,
+ initialize = function(obj, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ },
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+ # TODO
+ }
+ )
+)
+```
+
+## Cells
+
+We can begin to create the output files and web server route details for the `cells` data type.
+Files with the `cells` data type can contain cell-level observations, such as dimensionality reduction coordinates for each cell.
+
+For now, we can create a new function called `create_cells_list` which we will fill in later.
+
+The `make_cells_file_def_creator` is a function which creates and returns a new "file definition creator" function.
+All file definition creator functions must take the `base_url` parameter and return a complete file definition.
+File definitions should be lists with named values:
+
+- `type`: a Vitessce data type string (for convenience, the values in the `DataType` list can be used),
+- `fileType`: a Vitessce file type string (for convenience, the values in the `FileType` list can be used),
+- `url`: a URL string (required for most file types, but optional for the `raster.json` file type),
+- `options`: optional list of extra options (not necessary for any JSON file types).
+
+In `convert_and_save` we append the new file definition creator to the list `self$file_def_creators` and we append a new web server route to `self$routes`.
+
+```r
+SeuratWrapper <- R6::R6Class("SeuratWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ obj = NULL,
+ initialize = function(obj, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ },
+ create_cells_list = function() {
+ # TODO
+ },
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$CELLS_JSON,
+ url = super$get_url(base_url, dataset_uid, obj_i, "cells.json")
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ # Get list representations of the data.
+ cells_list <- self$create_cells_list()
+
+ # Convert the lists to JSON strings.
+ cells_json <- jsonlite::toJSON(cells_list)
+
+ # Save the JSON strings to JSON files.
+ write(cells_json, file = self$get_out_dir(dataset_uid, obj_i, "cells.json"))
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creator function to the main list.
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+
+ # Append a new web server route object which corresponds to the directory of JSON files to be served.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ }
+ )
+)
+```
+
+Next, we want to fill in the `create_cells_list` function.
+This function should return an R list which will be automatically converted to a JSON object by [jsonlite](https://cran.r-project.org/web/packages/jsonlite/vignettes/json-aaquickstart.html).
+
+For reference:
+
+- [`cells.json` schema](https://github.com/vitessce/vitessce/blob/master/src/schemas/cells.schema.json)
+- [`cells.json` small example](https://github.com/vitessce/vitessce/blob/master/src/schemas/fixtures/cells.good.json)
+- [`cells.json` full example](https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/dries/dries.cells.json)
+
+We know that we need to obtain the following from the Seurat object:
+
+- a unique ID for each cell, and
+- an (x, y) scatterplot coordinate representing the first two dimensions of a dimensionality reduction for each cell.
+
+When we inspect a Seurat object in the R environment, we can see that it has the type `S4 object of class Seurat`.
+
+To access the values in an S4 object, we can use `slot(obj, "key")` where `"key"` is replaced by the key for the part of the object that we want to access.
+
+Inspecting the object further, we can see that:
+
+- dimensionality reductions are stored under the key `"reductions"`
+- cell barcodes are stored under the key `"active.ident"`
+
+To generalize our function, we can get a list of names of each dimensionality reduction available with `names(slot(obj, "reductions"))`.
+
+We can get a list of cell IDs with `names(slot(obj, "active.ident"))`.
+
+Then we can iterate over the cell IDs and set up a new empty object with `obj_list()`.
+Note [`obj_list()`](https://github.com/vitessce/vitessce-r/blob/8d4d7f9/R/helpers.R#L35) returns an empty R list that is always translated to a JSON object (rather than the base R `list()` which is translated to a JSON _array_ when empty).
+
+Then we can iterate over each available dimensionality reduction and cell.
+We obtain the cell's (x,y) coordinates with `embedding_matrix[cell_id, 1:2]` where `embedding_matrix` is the dimensionality reduction matrix.
+For example, if the dimensionality reduction is `"pca"` then the matrix can be accessed at `slot(slot(obj, "reductions")[["pca"]], "cell.embeddings")`.
+
+Finally, we return the R list we created.
+
+```r
+SeuratWrapper <- R6::R6Class("SeuratWrapper",
+ inherit = AbstractWrapper,
+ public = list(
+ obj = NULL,
+ initialize = function(obj, ...) {
+ super$initialize(...)
+ self$obj <- obj
+ },
+ create_cells_list = function() {
+ obj <- self$obj
+ embeddings <- slot(obj, "reductions")
+ available_embeddings <- names(embeddings)
+
+ cell_ids <- names(slot(obj, "active.ident"))
+ cells_list <- obj_list()
+ for(cell_id in cell_ids) {
+ cells_list[[cell_id]] <- list(
+ mappings = obj_list()
+ )
+ }
+ for(embedding_name in available_embeddings) {
+ embedding <- embeddings[[embedding_name]]
+ embedding_matrix <- slot(embedding, "cell.embeddings")
+ for(cell_id in cell_ids) {
+ cells_list[[cell_id]]$mappings[[embedding_name]] <- unname(embedding_matrix[cell_id, 1:2])
+ }
+ }
+
+ return(cells_list)
+ },
+ make_cells_file_def_creator = function(dataset_uid, obj_i) {
+ get_cells <- function(base_url) {
+ file_def <- list(
+ type = DataType$CELLS,
+ fileType = FileType$CELLS_JSON,
+ url = super$get_url(base_url, dataset_uid, obj_i, "cells.json")
+ )
+ return(file_def)
+ }
+ return(get_cells)
+ },
+ convert_and_save = function(dataset_uid, obj_i) {
+ super$convert_and_save(dataset_uid, obj_i)
+
+ # Get list representations of the data.
+ cells_list <- self$create_cells_list()
+
+ # Convert the lists to JSON strings.
+ cells_json <- jsonlite::toJSON(cells_list)
+
+ # Save the JSON strings to JSON files.
+ write(cells_json, file = self$get_out_dir(dataset_uid, obj_i, "cells.json"))
+
+ # Get the file definition creator functions.
+ cells_file_creator <- self$make_cells_file_def_creator(dataset_uid, obj_i)
+
+ # Append the new file definition creator function to the main list.
+ self$file_def_creators <- append(self$file_def_creators, cells_file_creator)
+
+ # Append a new web server route object which corresponds to the directory of JSON files to be served.
+ self$routes <- append(self$routes, self$get_out_dir_route(dataset_uid, obj_i))
+ }
+ )
+)
+```
+
+
diff --git a/vignettes/dev_wrapper_subclass.Rmd b/vignettes/dev_wrapper_subclass.Rmd
new file mode 100644
index 0000000..fd40cb3
--- /dev/null
+++ b/vignettes/dev_wrapper_subclass.Rmd
@@ -0,0 +1,144 @@
+---
+title: "Developer guide: Extending a data wrapper class"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Developer guide: Extending a data wrapper class}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The existing data object wrapper classes are not yet very flexible, but they can be extended to support custom use cases.
+
+Here, we extend the `SeuratWrapper` class so that it supports multiple cell sets, to deal with the fact that the Seurat [`FindClusters`](https://satijalab.org/seurat/reference/findclusters) overwrites its results each time.
+
+```r
+library(vitessceR)
+
+#' Subclass of SeuratWrapper to deal with cell sets.
+#' @title MyCustomSeuratWrapper Class
+#' @docType class
+#' @description
+#' Subclass of SeuratWrapper.
+MyCustomSeuratWrapper <- R6::R6Class("MyCustomSeuratWrapper",
+ inherit = SeuratWrapper,
+ public = list(
+ #' @field cell_sets The cell sets.
+ #' @keywords internal
+ cell_sets = NULL,
+ #' @description
+ #' Create a wrapper around a Seurat object.
+ #' @param obj The object to wrap.
+ #' @param cell_sets A list of cell sets.
+ #' @param ... Parameters inherited from `SeuratWrapper`.
+ #' @return A new `SeuratWrapper` object.
+ initialize = function(obj, cell_sets, ...) {
+ super$initialize(obj, ...)
+ self$cell_sets <- cell_sets
+ },
+ #' @description
+ #' Create a list representing the cluster assignments in the cell set list.
+ #' @return A list that can be converted to JSON.
+ #' @keywords internal
+ create_cell_sets_list = function() {
+ obj <- self$obj
+
+ cells <- Seurat::Idents(obj)
+
+ # https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.cell-sets.json
+ cell_sets_list <- list(
+ datatype = jsonlite::unbox("cell"),
+ version = jsonlite::unbox("0.1.3"),
+ tree = list()
+ )
+
+ if(!is.na(self$cell_sets)) {
+ for(cell_set_name in names(self$cell_sets)) {
+ cell_set <- self$cell_sets[[cell_set_name]]
+
+ cell_set_meta_node <- list(
+ name = jsonlite::unbox(cell_set_name),
+ children = list()
+ )
+ cell_set_annotations <- cell_set
+ cell_set_annotation_scores <- NA
+
+ cluster_names <- sort(unique(cell_set_annotations))
+
+ for(cluster_name in cluster_names) {
+ cells_in_cluster <- names(cells[cell_set_annotations == cluster_name])
+
+ # TODO: find out if there is a way to return NULL
+ make_null_tuples <- function(x) { list(jsonlite::unbox(x), jsonlite::unbox(NA)) }
+ cells_in_cluster_with_score <- purrr::map(cells_in_cluster, make_null_tuples)
+
+ cluster_node <- list(
+ name = jsonlite::unbox(cluster_name),
+ set = cells_in_cluster_with_score
+ )
+ cell_set_meta_node$children <- append(cell_set_meta_node$children, list(cluster_node))
+ }
+ cell_sets_list$tree <- append(cell_sets_list$tree, list(cell_set_meta_node))
+ }
+ }
+ cell_sets_list
+ }
+ )
+)
+```
+
+Next, we can preprocess the dataset.
+```r
+library(Seurat)
+
+# Download example dataset
+url <- "https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz"
+dir.create("seurat")
+download.file(url, destfile = "seurat/filtered_gene_bc_matrices.tar.gz")
+untar("seurat/filtered_gene_bc_matrices.tar.gz", exdir = "seurat")
+
+# Load example dataset
+pbmc.data <- Read10X(data.dir = "seurat/filtered_gene_bc_matrices/hg19")
+
+# Process example dataset (run PCA and cluster)
+pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
+pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")
+pbmc <- subset(pbmc, subset = nFeature_RNA > 200 & nFeature_RNA < 2500 & percent.mt < 5)
+pbmc <- NormalizeData(pbmc, normalization.method = "LogNormalize", scale.factor = 10000)
+pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)
+all.genes <- rownames(pbmc)
+pbmc <- ScaleData(pbmc, features = all.genes)
+pbmc <- RunPCA(pbmc, features = VariableFeatures(object = pbmc))
+pbmc <- FindNeighbors(pbmc, dims = 1:10)
+```
+
+We can run `FindClusters` with different algorithms and save the clustering results to new variables between each algorithm, since the results in the Seurat object will be overwritten each time.
+
+```r
+louvain_clusters <- slot(FindClusters(pbmc, algorithm = 1, resolution = 0.3), "meta.data")$seurat_clusters
+slm_clusters <- slot(FindClusters(pbmc, algorithm = 3), "meta.data")$seurat_clusters
+cell_sets_list <- list(louvain = louvain_clusters, SLM = slm_clusters)
+```
+
+With this list of cell sets, we can now create an instance of our custom SeuratWrapper subclass:
+
+```r
+my_wrapped_object <- MyCustomSeuratWrapper$new(pbmc, cell_sets = cell_sets_list, out_dir = "out")
+```
+
+Now, we create the Vitessce config as usual:
+```r
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(my_wrapped_object)
+scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "pca")
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a Seurat object containing the PBMC 3K dataset.")
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+vc$layout(hconcat(
+ vconcat(scatterplot),
+ vconcat(cell_sets, vconcat(desc, status))
+))
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
diff --git a/vignettes/export_files.Rmd b/vignettes/export_files.Rmd
new file mode 100644
index 0000000..53c8bfe
--- /dev/null
+++ b/vignettes/export_files.Rmd
@@ -0,0 +1,120 @@
+---
+title: "Export data to static files"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Export data to static files}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+After configuring a Vitessce widget, you may want to obtain the static files associated and deploy the same Vitessce configuration as a static website.
+This page demonstrates this process for an example dataset from [SeuratData](https://github.com/satijalab/seurat-data).
+
+First, install the dependencies:
+
+```r
+install.packages("devtools")
+devtools::install_github("satijalab/seurat-data")
+```
+
+Create the Vitessce configuration:
+
+```r
+library(vitessceR)
+library(SeuratData)
+
+SeuratData::InstallData("pbmc3k")
+data("pbmc3k.final")
+force(pbmc3k.final)
+
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")
+dataset <- dataset$add_object(
+ SeuratWrapper$new(
+ pbmc3k.final,
+ cell_embeddings = c("pca", "umap"),
+ cell_embedding_names = c("PCA", "UMAP"),
+ cell_set_meta_names = c("seurat_annotations", "seurat_clusters"),
+ out_dir = file.path("data", "seuratdata")
+ )
+)
+scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+vc$layout(scatterplot)
+```
+
+# Export files for serving locally
+
+Run the `export` function on the `VitessceConfig`.
+Specify the directory in which to store the exported files with `out_dir`.
+
+```r
+vc$export(out_dir = "./my_vitessce_files")
+```
+
+The directory `./my_vitessce_files` should now contain three files:
+
+- `cells.json`
+- `cell-sets.json`
+- `clusters.json`
+
+## Serve the exported files
+
+Now that the files have been saved to the `./my_vitessce_files` directory, they can be served by any static web server.
+
+If you would like to serve the files locally, we recommend [http-server](https://github.com/http-party/http-server) which can be installed with NPM or Homebrew:
+
+```sh
+http-server ./my_vitessce_files/ --cors -p 3000
+```
+
+## View on vitessce.io
+
+The returned view config dict can be converted to a URL, and if the files are served on the internet (rather than locally), this URL can be used to share the interactive visualizations with colleagues.
+
+```r
+vc_list <- vc$to_list(base_url = "http://localhost:3000")
+vitessce_url <- paste0("http://vitessce.io/?url=data:,", URLencode(jsonlite::toJSON(vc_list, auto_unbox = TRUE)))
+print(vitessce_url)
+```
+
+# Export files for serving from AWS S3
+
+Rather than serving the data files locally, you may want to upload the files to a remote static file hosting service such as AWS S3, allowing the Vitessce URL to be shared with others.
+Visit our [data hosting](http://beta.vitessce.io/docs/data-hosting/index.html) documentation page to learn more about configuring file hosting services for use with Vitessce.
+Install the AWS S3 command-line interface by following the instructions [here](https://docs.aws.amazon.com/cli/latest/userguide/install-cliv2.html).
+
+Confirm that the CLI has been installed:
+
+```sh
+aws --version
+```
+
+Configure the AWS CLI by using any of the configuration methods, such as the [environment variable method](https://docs.aws.amazon.com/cli/latest/userguide/cli-configure-envvars.html).
+
+
+In the case of AWS S3, you know ahead of time that the data files will ultimately be served from your S3 bucket, so you can include the `base_url` and `with_config = TRUE` parameters when calling the export function.
+For instance, if you intend to upload the files to an AWS S3 bucket called `my_bucket`:
+
+```r
+vc$export(with_config = TRUE, base_url = "https://my_bucket.s3.amazonaws.com", out_dir = "./my_vitessce_files")
+```
+
+The directory `./my_vitessce_files` should now contain the three data files, plus the view config as a JSON file (`config.json`):
+
+- `cells.json`
+- `cell-sets.json`
+- `clusters.json`
+- `config.json` (the file URLs in this config will include the `base_url` for the bucket)
+
+## Upload exported files to S3
+
+Upload all four files to your bucket:
+
+```sh
+aws s3 cp --recursive ./my_vitessce_files s3://my_bucket
+```
+
+In this case, rather than including the configuration as url-encoded JSON in the URL, you can simply point to the configuration JSON file in the bucket:
+
+`http://vitessce.io/?url=https://my_bucket.s3.amazonaws.com/config.json`
+
diff --git a/vignettes/giotto.Rmd b/vignettes/giotto.Rmd
new file mode 100644
index 0000000..be60e8b
--- /dev/null
+++ b/vignettes/giotto.Rmd
@@ -0,0 +1,162 @@
+---
+title: "Usage with Giotto"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with Giotto}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is a full example of usage of the widget with a [Giotto](https://github.com/RubD/Giotto) object.
+
+First, install the R dependencies:
+
+```r
+install.packages("devtools")
+devtools::install_github("RubD/Giotto")
+```
+
+
+Download and preprocess the Giotto object (adapted from this [tutorial](https://rubd.github.io/Giotto_site/articles/mouse_seqFISH_cortex_200914.html)):
+
+(replace ``python_path`` appropriately)
+
+```r
+library(Giotto)
+
+save_dir <- file.path("data", "giotto", "save_dir")
+dir.create(save_dir, showWarnings = FALSE)
+instrs <- createGiottoInstructions(
+ save_plot = TRUE,
+ show_plot = FALSE,
+ save_dir = save_dir,
+ python_path = "~/miniconda3/envs/vitessce-r-env/bin/python"
+)
+
+getSpatialDataset(dataset = "seqfish_SS_cortex", directory = save_dir, method = "wget")
+
+expr_path <- file.path(save_dir, "cortex_svz_expression.txt")
+loc_path <- file.path(save_dir, "cortex_svz_centroids_coord.txt")
+meta_path <- file.path(save_dir, "cortex_svz_centroids_annot.txt")
+
+# First, merge location and additional metadata.
+SS_locations = data.table::fread(loc_path)
+cortex_fields = data.table::fread(meta_path)
+SS_loc_annot = data.table::merge.data.table(SS_locations, cortex_fields, by = 'ID')
+SS_loc_annot[, ID := factor(ID, levels = paste0('cell_',1:913))]
+data.table::setorder(SS_loc_annot, ID)
+# Create file with offset information.
+my_offset_file = data.table::data.table(field = c(0, 1, 2, 3, 4, 5, 6), x_offset = c(0, 1654.97, 1750.75, 1674.35, 675.5, 2048, 675), y_offset = c(0, 0, 0, 0, -1438.02, -1438.02, 0))
+# Create a stitch file.
+stitch_file = stitchFieldCoordinates(
+ location_file = SS_loc_annot,
+ offset_file = my_offset_file,
+ cumulate_offset_x = T,
+ cumulate_offset_y = F,
+ field_col = 'FOV',
+ reverse_final_x = F,
+ reverse_final_y = T
+)
+stitch_file = stitch_file[,.(ID, X_final, Y_final)]
+my_offset_file = my_offset_file[,.(field, x_offset_final, y_offset_final)]
+# Create Giotto object
+SS_seqfish <- createGiottoObject(
+ raw_exprs = expr_path,
+ spatial_locs = stitch_file,
+ offset_file = my_offset_file,
+ instructions = instrs
+)
+# Filtering, normalization
+SS_seqfish = addCellMetadata(
+ SS_seqfish,
+ new_metadata = cortex_fields,
+ by_column = T,
+ column_cell_ID = 'ID'
+)
+cell_metadata = pDataDT(SS_seqfish)
+cortex_cell_ids = cell_metadata[FOV %in% 0:4]$cell_ID
+SS_seqfish = subsetGiotto(
+ SS_seqfish,
+ cell_ids = cortex_cell_ids
+)
+SS_seqfish <- filterGiotto(
+ gobject = SS_seqfish,
+ expression_threshold = 1,
+ gene_det_in_min_cells = 10,
+ min_det_genes_per_cell = 10,
+ expression_values = c('raw'),
+ verbose = T
+)
+# Normalize
+SS_seqfish <- normalizeGiotto(
+ gobject = SS_seqfish,
+ scalefactor = 6000,
+ verbose = T
+)
+# Add gene & cell statistics
+SS_seqfish <- addStatistics(gobject = SS_seqfish)
+# Adjust expression matrix for technical or known variables
+SS_seqfish <- adjustGiottoMatrix(
+ gobject = SS_seqfish,
+ expression_values = c('normalized'),
+ batch_columns = NULL,
+ covariate_columns = c('nr_genes', 'total_expr'),
+ return_gobject = TRUE,
+ update_slot = c('custom')
+)
+SS_seqfish <- calculateHVG(
+ gobject = SS_seqfish,
+ method = 'cov_loess',
+ difference_in_cov = 0.1,
+ save_param = list(save_name = '3_a_HVGplot', base_height = 5, base_width = 5)
+)
+# Select genes based on HVG and gene statistics, both found in gene metadata
+gene_metadata = fDataDT(SS_seqfish)
+featgenes = gene_metadata[hvg == 'yes' & perc_cells > 4 & mean_expr_det > 0.5]$gene_ID
+# Run PCA
+SS_seqfish <- runPCA(gobject = SS_seqfish, genes_to_use = featgenes, scale_unit = F, center = T)
+SS_seqfish <- runtSNE(SS_seqfish, dimensions_to_use = 1:15)
+```
+
+Set up the Vitessce widget:
+
+```r
+library(vitessceR)
+
+w <- GiottoWrapper$new(
+ SS_seqfish,
+ cell_set_metas = c("cell_types"),
+ cell_set_meta_names = c("Cell Types"),
+ cell_embeddings = c("pca", "tsne"),
+ cell_embedding_names = c("PCA", "t-SNE"),
+ out_dir = file.path("data", "giotto")
+)
+
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(w)
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+scatterplot_tsne <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "t-SNE")
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a Giotto object.")
+
+vc$layout(
+ hconcat(
+ vconcat(
+ spatial,
+ scatterplot_tsne
+ ),
+ vconcat(
+ cell_sets,
+ hconcat(desc, status)
+ )
+ )
+)
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/json_local.Rmd b/vignettes/json_local.Rmd
new file mode 100644
index 0000000..4f1c217
--- /dev/null
+++ b/vignettes/json_local.Rmd
@@ -0,0 +1,102 @@
+---
+title: "Usage with JSON: Local Example"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with JSON: Local Example}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of usage of the widget with JSON files. In this example, the JSON files are stored locally.
+
+## Setup
+
+In this tutorial, we will serve the JSON files using a local web server.
+
+Any static web server will work, and an easy one to install and configure is [http-server](https://github.com/http-party/http-server#readme).
+
+
+## Download the data
+
+First, download the files used in this example:
+
+- https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.cells.json
+- https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.cell-sets.json
+- https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.molecules.json
+- https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.clusters.json
+- https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/linnarsson.raster.json
+
+## Serve the JSON files locally
+
+To serve the downloaded JSON files, move them to a new folder (for instance `vitessce_json_example` in the `Downloads` folder). Using the terminal, change directories to this folder containing the JSON files.
+
+```sh
+cd ~/Downloads/vitessce_json_example/
+```
+
+Serve the contents of this directory (the JSON files) using `http-server`:
+
+```sh
+http-server ./ --cors -p 8000
+```
+
+## Configure the Vitessce widget
+
+Add JSON files to the dataset using the `add_file` function. The `add_file` function returns the updated dataset, allowing the function calls to be chained.
+
+```r
+library(vitessceR)
+
+base_url <- "http://localhost:8000/"
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("Codeluppi et al., Nature Methods 2018")
+dataset <- vc$add_dataset("Codeluppi")$add_file(
+ url = paste0(base_url, "linnarsson.cells.json"),
+ data_type = DataType$CELLS,
+ file_type = FileType$CELLS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.cell-sets.json"),
+ data_type = DataType$CELL_SETS,
+ file_type = FileType$CELL_SETS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.molecules.json"),
+ data_type = DataType$MOLECULES,
+ file_type = FileType$MOLECULES_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.clusters.json"),
+ data_type = DataType$EXPRESSION_MATRIX,
+ file_type = FileType$CLUSTERS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.raster.json"),
+ data_type = DataType$RASTER,
+ file_type = FileType$RASTER_JSON
+)
+
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Codeluppi et al., Nature Methods 2018: Spatial organization of the somatosensory cortex revealed by osmFISH.")
+
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+spatial_layers <- vc$add_view(dataset, Component$LAYER_CONTROLLER)
+
+scatterplot_pca <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+scatterplot_tsne <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "t-SNE")
+status <- vc$add_view(dataset, Component$STATUS)
+
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+gene_list <- vc$add_view(dataset, Component$GENES)
+heatmap <- vc$add_view(dataset, Component$HEATMAP)$set_props(transpose = TRUE)
+
+vc$layout(hconcat(
+ vconcat(vconcat(desc, status), spatial_layers),
+ vconcat(heatmap, spatial),
+ vconcat(scatterplot_tsne, scatterplot_pca),
+ vconcat(gene_list, cell_sets)
+))
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/local_data_overview.Rmd b/vignettes/local_data_overview.Rmd
new file mode 100644
index 0000000..2b44508
--- /dev/null
+++ b/vignettes/local_data_overview.Rmd
@@ -0,0 +1,27 @@
+---
+title: "Overview: Using the widget with local data"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Overview: Using the widget with local data}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The main goal of this R package is to enable configuring Vitessce visualizations using R syntax.
+
+We also aim to simplify the data conversion process by providing [dataset wrapper classes](../reference/index.html#dataset-wrapper-classes) that automatically convert common single-cell data structures to [file formats supported by Vitessce](http://vitessce.io/docs/data-types-file-types/).
+
+Our effort to develop converters for R formats remains ongoing. However, we provide a guide for R developers to [write data conversion functions](./dev_wrapper_class.html) to support any type of R single-cell data structure (or to improve conversion for already-supported data structures).
+
+The following vignettes in the "Examples with Local Data" section demonstrate how the dataset wrapper classes can be used with single-cell datasets stored on your local machine.
+
+## Zarr via Reticulate via Basilisk
+
+Due to a lack of native R support for Zarr, the R dataset conversion functions currently depend on a Python environment.
+
+We currently use [basilisk](https://github.com/LTLA/basilisk) and [reticulate](https://rstudio.github.io/reticulate/) to write to Zarr stores via the ``zarr`` Python package.
+
+
+## Zarr natively
+
+Subscribe to the [Zarr in R issue](https://github.com/vitessce/vitessce-r/issues/7) for future updates about native Zarr support that would avoid the need for the Python environment.
diff --git a/vignettes/ome_tiff_local.Rmd b/vignettes/ome_tiff_local.Rmd
new file mode 100644
index 0000000..5a3de6a
--- /dev/null
+++ b/vignettes/ome_tiff_local.Rmd
@@ -0,0 +1,41 @@
+---
+title: "Usage with OME-TIFF: Local Example"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with OME-TIFF: Local Example}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of usage of the widget to visualize a local OME-TIFF image file.
+
+Configure the Vitessce widget:
+
+```r
+library(vitessceR)
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(
+ MultiImageWrapper$new(
+ image_wrappers = list(
+ OmeTiffWrapper$new(name="Test", img_path="/Users/mkeller/Downloads/exemplar-001.pyramid.ome.tif")
+ )
+ )
+)
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+spatial_layers <- vc$add_view(dataset, Component$LAYER_CONTROLLER)
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of an OME-TIFF file.")
+vc$layout(hconcat(
+ spatial,
+ hconcat(spatial_layers, vconcat(desc, status))
+))
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/pkgdown.Rmd b/vignettes/pkgdown.Rmd
new file mode 100644
index 0000000..5ec139f
--- /dev/null
+++ b/vignettes/pkgdown.Rmd
@@ -0,0 +1,39 @@
+---
+title: "Usage with pkgdown"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with pkgdown}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r setup, include = FALSE}
+chunk <- "```"
+```
+
+[Pkgdown](https://pkgdown.r-lib.org/) is an R package designed to build documentation websites for R packages.
+However, it can also be an easy way to create a static website using R.
+
+The Vitessce widget can be embedded in a static website built with pkgdown. In fact, this documentation website was built with pkgdown, and both of the remote data examples ([Usage with JSON: Remote Example](./web_only/json_remote.html) and [Usage with OME-TIFF: Remote Example](./web_only/ome_tiff_remote.html)) take advantage of the ability to render R htmlwidgets into a pkgdown website.
+
+To render a Vitessce widget into a pkgdown article, set the [chunk options](https://r4ds.had.co.nz/r-markdown.html#chunk-options) at the top of the code block such that output is rendered, and execute the widget function in the final line of the code block.
+
+ `r chunk`{r echo = TRUE}
+ library(vitessceR)
+
+ vc <- VitessceConfig$new("My config")
+
+ # configure vitessce here
+
+ vc$widget(theme = "light", width = "100%")
+ `r chunk`
+
+Note that because `pkgdown` sites are static, pkgdown cannot be used to serve data to Vitessce, so only remote datasets (with files added via the [dataset$add_file](../reference/VitessceConfigDataset.html#method-add_file) method) can be used on pkgdown sites.
+
+The full code for the two examples linked above can be explored on GitHub:
+
+* https://github.com/vitessce/vitessceR/blob/main/vignettes/web_only/json_remote.Rmd
+* https://github.com/vitessce/vitessceR/blob/main/vignettes/web_only/ome_tiff_remote.Rmd
+* Pkgdown configuration files: https://github.com/vitessce/vitessceR/tree/main/pkgdown
+* GitHub Actions deployment script: https://github.com/vitessce/vitessceR/blob/main/.github/workflows/deploy.yml#L30
+
diff --git a/vignettes/session_info.Rmd b/vignettes/session_info.Rmd
new file mode 100644
index 0000000..24081eb
--- /dev/null
+++ b/vignettes/session_info.Rmd
@@ -0,0 +1,16 @@
+---
+title: "R Session Info"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{R Session Info}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+This page runs the `sessionInfo()` function and prints the results.
+The output can be used to check the dependency versions that were used to run tests.
+
+```{r include=TRUE, echo=TRUE}
+library(vitessceR)
+sessionInfo()
+```
diff --git a/vignettes/seurat_azimuth.Rmd b/vignettes/seurat_azimuth.Rmd
new file mode 100644
index 0000000..826679e
--- /dev/null
+++ b/vignettes/seurat_azimuth.Rmd
@@ -0,0 +1,242 @@
+---
+title: "Usage with Seurat: Reference Mapping"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with Seurat: Reference Mapping}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of using the Vitessce widget to visualize a reference and mapped query dataset, with mapping performed by [Seurat v4](https://satijalab.org/v4preprint) and scripts from [Azimuth](https://satijalab.org/azimuth/).
+
+
+First, install the R dependencies:
+
+```r
+install.packages("Seurat")
+install.packages("devtools")
+install.packages("BiocManager")
+BiocManager::install("glmGamPoi")
+devtools::install_github("satijalab/azimuth")
+devtools::install_github("mojaveazure/seurat-disk")
+```
+
+Download the dataset and map the query to the reference:
+
+```r
+library(vitessceR)
+library(Seurat)
+library(Azimuth)
+source("https://raw.githubusercontent.com/satijalab/azimuth/master/R/helpers.R")
+library(Matrix)
+
+# Download query dataset
+url <- "https://www.dropbox.com/s/cmbvq2og93lnl9z/pbmc_10k_v3_filtered_feature_bc_matrix.h5?dl=1"
+data_dir <- file.path("data", "azimuth")
+h5_file <- file.path(data_dir, "pbmc_10k_v3_filtered_feature_bc_matrix.h5")
+dir.create(data_dir, showWarnings = FALSE)
+if(!file.exists(h5_file)) {
+ download.file(url, destfile = h5_file)
+}
+
+# Download the reference
+# Change the file path based on where the reference is located on your system.
+reference <- LoadReference(path = "https://seurat.nygenome.org/azimuth/references/v1.0.0/human_pbmc", seconds = 30L)
+
+# Load the query object for mapping
+# Change the file path based on where the query file is located on your system.
+query <- LoadFileInput(path = h5_file)
+
+# Calculate nCount_RNA and nFeature_RNA if the query does not
+# contain them already
+if (!all(c("nCount_RNA", "nFeature_RNA") %in% c(colnames(x = query[[]])))) {
+ calcn <- as.data.frame(x = Seurat:::CalcN(object = query))
+ colnames(x = calcn) <- paste(
+ colnames(x = calcn),
+ "RNA",
+ sep = '_'
+ )
+ query <- AddMetaData(
+ object = query,
+ metadata = calcn
+ )
+ rm(calcn)
+}
+
+# Calculate percent mitochondrial genes if the query contains genes
+# matching the regular expression "^MT-"
+if (any(grepl(pattern = '^MT-', x = rownames(x = query)))) {
+ query <- PercentageFeatureSet(
+ object = query,
+ pattern = '^MT-',
+ col.name = 'percent.mt',
+ assay = "RNA"
+ )
+}
+
+# Filter cells based on the thresholds for nCount_RNA and nFeature_RNA
+# you set in the app
+cells.use <- query[["nCount_RNA", drop = TRUE]] <= 79534 &
+ query[["nCount_RNA", drop = TRUE]] >= 501 &
+ query[["nFeature_RNA", drop = TRUE]] <= 7211 &
+ query[["nFeature_RNA", drop = TRUE]] >= 54
+
+# If the query contains mitochondrial genes, filter cells based on the
+# thresholds for percent.mt you set in the app
+if ("percent.mt" %in% c(colnames(x = query[[]]))) {
+ cells.use <- cells.use & (query[["percent.mt", drop = TRUE]] <= 97 &
+ query[["percent.mt", drop = TRUE]] >= 0)
+}
+
+# Remove filtered cells from the query
+query <- query[, cells.use]
+
+# Preprocess with SCTransform
+query <- SCTransform(
+ object = query,
+ assay = "RNA",
+ new.assay.name = "refAssay",
+ residual.features = rownames(x = reference$map),
+ reference.SCT.model = reference$map[["refAssay"]]@SCTModel.list$refmodel,
+ method = 'glmGamPoi',
+ ncells = 2000,
+ n_genes = 2000,
+ do.correct.umi = FALSE,
+ do.scale = FALSE,
+ do.center = TRUE
+)
+
+# Find anchors between query and reference
+anchors <- FindTransferAnchors(
+ reference = reference$map,
+ query = query,
+ k.filter = NA,
+ reference.neighbors = "refdr.annoy.neighbors",
+ reference.assay = "refAssay",
+ query.assay = "refAssay",
+ reference.reduction = "refDR",
+ normalization.method = "SCT",
+ features = intersect(rownames(x = reference$map), VariableFeatures(object = query)),
+ dims = 1:50,
+ n.trees = 20,
+ mapping.score.k = 100
+)
+
+# Transfer cell type labels and impute protein expression
+#
+# Transferred labels are in metadata columns named "predicted.*"
+# The maximum prediction score is in a metadata column named "predicted.*.score"
+# The prediction scores for each class are in an assay named "prediction.score.*"
+# The imputed assay is named "impADT" if computed
+
+refdata <- lapply(X = "celltype.l2", function(x) {
+ reference$map[[x, drop = TRUE]]
+})
+names(x = refdata) <- "celltype.l2"
+if (TRUE) {
+ refdata[["impADT"]] <- GetAssayData(
+ object = reference$map[['ADT']],
+ slot = 'data'
+ )
+}
+query <- TransferData(
+ reference = reference$map,
+ query = query,
+ dims = 1:50,
+ anchorset = anchors,
+ refdata = refdata,
+ n.trees = 20,
+ store.weights = TRUE
+)
+
+# Calculate the embeddings of the query data on the reference SPCA
+query <- IntegrateEmbeddings(
+ anchorset = anchors,
+ reference = reference$map,
+ query = query,
+ reductions = "pcaproject",
+ reuse.weights.matrix = TRUE
+)
+
+# Calculate the query neighbors in the reference
+# with respect to the integrated embeddings
+query[["query_ref.nn"]] <- FindNeighbors(
+ object = Embeddings(reference$map[["refDR"]])[, 1:50],
+ query = Embeddings(query[["integrated_dr"]]),
+ return.neighbor = TRUE,
+ l2.norm = TRUE,
+ n.trees = 20
+)
+
+# The reference used in the app is downsampled compared to the reference on which
+# the UMAP model was computed. This step, using the helper function NNTransform,
+# corrects the Neighbors to account for the downsampling.
+query <- NNTransform(
+ object = query,
+ meta.data = reference$map[[]]
+)
+
+# Project the query to the reference UMAP.
+query[["umap.proj"]] <- RunUMAP(
+ object = query[["query_ref.nn"]],
+ reduction.model = reference$map[["refUMAP"]],
+ reduction.key = 'UMAP_'
+)
+
+# Calculate mapping score and add to metadata
+query <- AddMetaData(
+ object = query,
+ metadata = MappingScore(anchors = anchors),
+ col.name = "mapping.score"
+)
+
+ref_obj <- reference$plot
+qry_obj <- query
+
+# Trick SeuratDisk into saving the UMAP even though it is not based on an internal assay
+ref_obj@reductions$refUMAP@assay.used <- "RNA"
+
+#### Use Vitessce for visualization ####
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("Azimuth")
+ref_dataset <- vc$add_dataset("Reference")$add_object(
+ SeuratWrapper$new(
+ ref_obj,
+ assay = Seurat::DefaultAssay(ref_obj),
+ cell_embeddings = c("refUMAP"),
+ cell_embedding_names = c("UMAP"),
+ cell_set_metas = c("celltype.l2"),
+ out_dir = file.path(data_dir, "reference"), overwrite = TRUE
+ )
+)
+qry_dataset <- vc$add_dataset("Query")$add_object(
+ SeuratWrapper$new(
+ qry_obj,
+ assay = Seurat::DefaultAssay(qry_obj),
+ cell_embeddings = c("umap.proj"),
+ cell_embedding_names = c("UMAP"),
+ cell_set_metas = c("predicted.celltype.l2"),
+ cell_set_meta_names = c("celltype.l2"),
+ cell_set_meta_scores = c("predicted.celltype.l2.score"),
+ out_dir = file.path(data_dir, "query"), overwrite = TRUE
+ )
+)
+
+ref_plot <- vc$add_view(ref_dataset, Component$SCATTERPLOT, mapping = "UMAP")
+qry_plot <- vc$add_view(qry_dataset, Component$SCATTERPLOT, mapping = "UMAP")
+cell_sets <- vc$add_view(ref_dataset, Component$CELL_SETS)
+cell_sets_2 <- vc$add_view(qry_dataset, Component$CELL_SETS)
+
+vc$link_views(
+ c(ref_plot, qry_plot),
+ c(CoordinationType$EMBEDDING_ZOOM, CoordinationType$EMBEDDING_TARGET_X, CoordinationType$EMBEDDING_TARGET_Y),
+ c_values = c(1, 0, 0)
+)
+
+vc$layout(hconcat(vconcat(ref_plot, qry_plot), vconcat(cell_sets, cell_sets_2)))
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
diff --git a/vignettes/seurat_basic.Rmd b/vignettes/seurat_basic.Rmd
new file mode 100644
index 0000000..be6794b
--- /dev/null
+++ b/vignettes/seurat_basic.Rmd
@@ -0,0 +1,82 @@
+---
+title: "Usage with Seurat: Basic Example"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with Seurat: Basic Example}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is a full example of usage of the widget with a [Seurat](https://satijalab.org/seurat/) object.
+
+
+First, install the R dependencies:
+
+```r
+install.packages("seurat")
+install.packages("devtools")
+devtools::install_github("mojaveazure/seurat-disk")
+```
+
+
+Download the dataset, load and preprocess the Seurat object, and configure the Vitessce widget:
+
+```r
+library(vitessceR)
+library(Seurat)
+
+# Download example dataset
+url <- "https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_matrices.tar.gz"
+save_dir <- file.path("data", "seurat")
+dir.create(save_dir)
+download.file(url, destfile = file.path(save_dir, "filtered_gene_bc_matrices.tar.gz"))
+untar(file.path(save_dir, "filtered_gene_bc_matrices.tar.gz"), exdir = save_dir)
+
+# Load example dataset
+pbmc.data <- Read10X(data.dir = file.path(save_dir, "filtered_gene_bc_matrices", "hg19"))
+
+# Process example dataset (run PCA and cluster)
+pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
+pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")
+pbmc <- subset(pbmc, subset = nFeature_RNA > 200 & nFeature_RNA < 2500 & percent.mt < 5)
+pbmc <- NormalizeData(pbmc, normalization.method = "LogNormalize", scale.factor = 10000)
+pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)
+all.genes <- rownames(pbmc)
+pbmc <- ScaleData(pbmc, features = all.genes)
+pbmc <- RunPCA(pbmc, features = VariableFeatures(object = pbmc))
+pbmc <- FindNeighbors(pbmc, dims = 1:10)
+pbmc <- FindClusters(pbmc, resolution = 0.5)
+
+pbmc <- ScaleData(pbmc, features = all.genes, do.center = FALSE)
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(SeuratWrapper$new(
+ pbmc,
+ cell_set_metas = c("seurat_clusters"),
+ cell_embeddings = c("pca"),
+ cell_embedding_names = c("PCA"),
+ out_dir = file.path("data", "seurat_basic"), use_cache = TRUE
+))
+scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a Seurat object containing the PBMC 3K dataset.")
+genes <- vc$add_view(dataset, Component$GENES)
+heatmap <- vc$add_view(dataset, Component$HEATMAP)
+vc$link_views(
+ list(scatterplot, heatmap),
+ list(CoordinationType$GENE_EXPRESSION_COLORMAP_RANGE),
+ list(c(0.0, 0.05))
+)
+vc$layout(hconcat(
+ vconcat(scatterplot, heatmap),
+ vconcat(genes, vconcat(desc, status))
+))
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/seuratdata.Rmd b/vignettes/seuratdata.Rmd
new file mode 100644
index 0000000..cb7b0cd
--- /dev/null
+++ b/vignettes/seuratdata.Rmd
@@ -0,0 +1,68 @@
+---
+title: "Usage with SeuratData"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with SeuratData}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of usage of the widget with a [Seurat](https://satijalab.org/seurat/) object loaded from the [SeuratData](https://github.com/satijalab/seurat-data) package.
+
+
+First, install the R dependencies:
+
+```r
+install.packages("seurat")
+install.packages("devtools")
+devtools::install_github("satijalab/seurat-data")
+devtools::install_github("mojaveazure/seurat-disk")
+```
+
+Download the dataset, load and preprocess the Seurat object, and configure the Vitessce widget:
+
+```r
+library(vitessceR)
+library(SeuratData)
+library(Seurat)
+
+SeuratData::InstallData("pbmc3k")
+data("pbmc3k.final")
+force(pbmc3k.final)
+
+all.genes <- rownames(pbmc3k.final)
+pbmc3k.final <- ScaleData(pbmc3k.final, features = all.genes, do.center = FALSE)
+
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")
+dataset <- dataset$add_object(SeuratWrapper$new(
+ pbmc3k.final,
+ cell_embeddings = c("pca", "umap"),
+ cell_embedding_names = c("PCA", "UMAP"),
+ cell_set_metas = c("seurat_annotations", "seurat_clusters"),
+ out_dir = file.path("data", "seuratdata")
+))
+scatterplot_pca <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+scatterplot_umap <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "UMAP")
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+genes <- vc$add_view(dataset, Component$GENES)
+heatmap <- vc$add_view(dataset, Component$HEATMAP)
+vc$link_views(
+ list(scatterplot_pca, scatterplot_umap, heatmap),
+ list(CoordinationType$GENE_EXPRESSION_COLORMAP_RANGE),
+ list(c(0.0, 0.035))
+)
+vc$link_views(
+ list(scatterplot_pca, scatterplot_umap),
+ list("embeddingCellSetLabelsVisible"),
+ list(TRUE)
+)
+vc$layout(vconcat(
+ hconcat(scatterplot_pca, scatterplot_umap),
+ hconcat(cell_sets, genes, heatmap)
+))
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/shiny.Rmd b/vignettes/shiny.Rmd
new file mode 100644
index 0000000..a3fc550
--- /dev/null
+++ b/vignettes/shiny.Rmd
@@ -0,0 +1,172 @@
+---
+title: "Usage with Shiny"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with Shiny}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is an example of usage of the widget in a [Shiny](https://shiny.rstudio.com/) app.
+
+First, install the dependencies:
+```r
+install.packages("shiny")
+install.packages("devtools")
+devtools::install_github("satijalab/seurat-data")
+```
+
+Next, create an output element in the UI with `vitessce_output` and a corresponding server response with `render_vitessce`.
+
+The value for the `output_id` parameter in the `vitessce_output` function should match the key for the result of `render_vitessce` in the server.
+
+```r
+library(shiny)
+library(vitessceR)
+library(SeuratData)
+
+SeuratData::InstallData("pbmc3k")
+data("pbmc3k.final")
+force(pbmc3k.final)
+
+w <- SeuratWrapper$new(
+ pbmc3k.final,
+ cell_embeddings = c("pca", "umap"),
+ cell_embedding_names = c("PCA", "UMAP"),
+ cell_set_metas = c("seurat_annotations", "seurat_clusters")
+)
+
+ui <- fluidPage(
+ "Vitessce in a Shiny app",
+ vitessce_output(output_id = "vitessce_visualization", height = "600px"),
+)
+
+server <- function(input, output, session) {
+ output$vitessce_visualization <- render_vitessce(expr = {
+ vc <- VitessceConfig$new("My config")
+ dataset <- vc$add_dataset("My dataset")
+ dataset <- dataset$add_object(w)
+ scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+ vc$layout(scatterplot)
+ vc$widget()
+ })
+}
+
+shinyApp(ui, server)
+```
+
+When running the Shiny app, the Vitessce widget will take a few seconds to appear on the screen.
+We plan to optimize the internal widget data preparation and conversion functions to reduce this delay.
+
+## Shiny apps on remote servers
+
+When running a Shiny app on a remote server, you will need to use the `base_url` parameter of the `vc$widget()` function.
+When a value for `base_url` is provided, the default `http://localhost` base URL will be overridden, allowing the client of the Shiny app to be running on a different computer than the Shiny server.
+
+You also may want to serve the Vitessce widget data files through a custom static web server rather than the built-in R [plumber](https://www.rplumber.io/) web server (either for security or scalability reasons).
+To do so, be sure to set the parameter `out_dir` when calling the `SeuratWrapper$new()` constructor. This will allow you to specify the output directory for the converted Vitessce data files.
+Then, you can set the parameter `serve` to `FALSE` in `vc$widget()` to prevent the built-in plumber server from starting when you launch the widget.
+
+For example, if you know that your Shiny server will be running at `http://example.com/shiny` and you want to turn off the plumber server, then you would call `vc$widget(base_url = "http://example.com/shiny", serve = FALSE)`.
+
+The following example demonstrates swapping out the Vitessce widget's built-in server for Shiny's [addResourcePath](https://shiny.rstudio.com/reference/shiny/1.0.2/addResourcePath.html):
+
+```r
+library(shiny)
+library(vitessceR)
+library(SeuratData)
+
+SeuratData::InstallData("pbmc3k")
+data("pbmc3k.final")
+force(pbmc3k.final)
+
+OUT_DIR <- file.path("data", "shiny")
+
+w <- SeuratWrapper$new(
+ pbmc3k.final,
+ cell_embeddings = c("pca", "umap"),
+ cell_embedding_names = c("PCA", "UMAP"),
+ cell_set_metas = c("seurat_annotations", "seurat_clusters"),
+ out_dir = OUT_DIR
+)
+
+ui <- fluidPage(
+ "Vitessce in a Shiny app",
+ vitessce_output(output_id = "vitessce_visualization", height = "600px"),
+)
+
+server <- function(input, output, session) {
+ addResourcePath("vitessce", OUT_DIR)
+ output$vitessce_visualization <- render_vitessce(expr = {
+ vc <- VitessceConfig$new("My config")
+ dataset <- vc$add_dataset("My dataset")
+ dataset <- dataset$add_object(w)
+ scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+ vc$layout(scatterplot)
+
+ BASE_URL <- paste0(
+ session$clientData$url_protocol,
+ "//",
+ session$clientData$url_hostname,
+ ":",
+ session$clientData$url_port,
+ "/vitessce"
+ )
+
+ vc$widget(serve = FALSE, base_url = BASE_URL)
+ })
+}
+
+shinyApp(ui, server)
+```
+
+## Style issues
+
+By default, Shiny includes CSS from bootstrap in all apps.
+The bootstrap styles (font sizes in particular) can interfere with the styles for the Vitessce widget.
+
+One solution is add CSS to reset the font sizes for the root element of the Shiny app:
+
+```r
+library(shiny)
+library(vitessceR)
+library(SeuratData)
+
+SeuratData::InstallData("pbmc3k")
+data("pbmc3k.final")
+force(pbmc3k.final)
+
+w <- SeuratWrapper$new(
+ pbmc3k.final,
+ cell_embeddings = c("pca", "umap"),
+ cell_embedding_names = c("PCA", "UMAP"),
+ cell_set_metas = c("seurat_annotations", "seurat_clusters")
+)
+
+ui <- fluidPage(
+ tags$head(
+ tags$style(HTML("
+ html, body {
+ font-size: inherit;
+ }
+ "))
+ ),
+ "Vitessce in a Shiny app",
+ vitessce_output(output_id = "vitessce_visualization", height = "600px"),
+)
+
+server <- function(input, output, session) {
+ output$vitessce_visualization <- render_vitessce(expr = {
+ vc <- VitessceConfig$new("My config")
+ dataset <- vc$add_dataset("My dataset")
+ dataset <- dataset$add_object(w)
+ scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+ vc$layout(scatterplot)
+ vc$widget()
+ })
+}
+
+shinyApp(ui, server)
+```
+
+
diff --git a/vignettes/single_cell_experiment.Rmd b/vignettes/single_cell_experiment.Rmd
new file mode 100644
index 0000000..4c2554c
--- /dev/null
+++ b/vignettes/single_cell_experiment.Rmd
@@ -0,0 +1,64 @@
+---
+title: "Usage with SingleCellExperiment"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with SingleCellExperiment}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is a full example of usage of the widget with a [SingleCellExperiment](https://bioconductor.org/packages/release/bioc/html/SingleCellExperiment.html) object.
+
+First, install the R dependencies:
+
+```r
+install.packages("BiocManager")
+BiocManager::install("scRNAseq")
+BiocManager::install("scater")
+```
+
+Download the dataset, load and preprocess the SingleCellExperiment object, and configure the Vitessce widget:
+
+```r
+library(vitessceR)
+library(scRNAseq)
+library(scater)
+
+sce_zeisel <- ZeiselBrainData()
+
+sce_zeisel <- addPerCellQC(sce_zeisel, subsets=list(Mito = grep("mt-", rownames(sce_zeisel))))
+sce_zeisel <- logNormCounts(sce_zeisel)
+sce_zeisel <- runPCA(sce_zeisel)
+
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(SCEWrapper$new(
+ sce_zeisel,
+ cell_set_metas = c("tissue", "level1class", "level2class"),
+ cell_set_meta_names = c("Tissue", "Cell Type Level 1", "Cell Type Level 2"),
+ cell_embeddings = c("PCA"),
+ out_dir = file.path("data", "sce")
+))
+scatterplot <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a SingleCellExperiment object.")
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+heatmap <- vc$add_view(dataset, Component$HEATMAP)
+vc$link_views(
+ list(scatterplot, heatmap),
+ list(CoordinationType$GENE_EXPRESSION_COLORMAP_RANGE),
+ list(c(0.0, 0.05))
+)
+vc$layout(hconcat(
+ vconcat(scatterplot, heatmap),
+ vconcat(cell_sets, vconcat(desc, status))
+))
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/spatial_experiment.Rmd b/vignettes/spatial_experiment.Rmd
new file mode 100644
index 0000000..5c817d9
--- /dev/null
+++ b/vignettes/spatial_experiment.Rmd
@@ -0,0 +1,51 @@
+---
+title: "Usage with SpatialExperiment"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with SpatialExperiment}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+The following is a full example of usage of the widget with a [SpatialExperiment](https://bioconductor.org/packages/release/bioc/html/SpatialExperiment.html) object.
+
+First, install the R dependencies:
+
+```r
+install.packages("BiocManager")
+BiocManager::install("STexampleData")
+```
+
+Download the dataset, load and preprocess the SpatialExperiment object, and configure the Vitessce widget:
+
+```r
+library(vitessceR)
+library(STexampleData)
+
+spe_visium <- STexampleData::Visium_mouseCoronal()
+
+w <- SPEWrapper$new(
+ spe_visium,
+ sample_id = "sample01",
+ image_id = "hires",
+ out_dir = file.path("data", "spe")
+)
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_object(w)
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of a SpatialExperiment object.")
+
+vc$layout(
+ hconcat(spatial, vconcat(desc, status))
+)
+
+# Render the Vitessce widget
+vc$widget(theme = "light")
+```
+
+
+
diff --git a/vignettes/web_only/json_remote.Rmd b/vignettes/web_only/json_remote.Rmd
new file mode 100644
index 0000000..d294a81
--- /dev/null
+++ b/vignettes/web_only/json_remote.Rmd
@@ -0,0 +1,87 @@
+---
+title: "Usage with JSON: Remote Example"
+output: rmarkdown::html_vignette
+package: vitessce
+vignette: >
+ %\VignetteIndexEntry{Usage with JSON: Remote Example}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, setup, include=FALSE}
+knitr::opts_knit$set(
+ root.dir = dirname(dirname(getwd())),
+ rmarkdown.pandoc.to = knitr::opts_knit$get("rmarkdown.pandoc.to")
+)
+```
+
+The following is an example of usage of the widget with JSON files. In this example, the JSON files are stored on a remote AWS S3 bucket. For information about remote file hosting, please visit the [Hosting Data](http://vitessce.io/docs/data-hosting/) page of the main Vitessce documentation website.
+
+## Configure the Vitessce widget
+
+Add JSON files to the dataset using the `add_file` function. The `add_file` function returns the updated dataset, allowing the function calls to be chained.
+
+```{r echo = TRUE, warning = FALSE}
+library(vitessceR)
+
+base_url <- "https://s3.amazonaws.com/vitessce-data/0.0.31/master_release/linnarsson/"
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("Codeluppi et al., Nature Methods 2018")
+dataset <- vc$add_dataset("Codeluppi")$add_file(
+ url = paste0(base_url, "linnarsson.cells.json"),
+ data_type = DataType$CELLS,
+ file_type = FileType$CELLS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.cell-sets.json"),
+ data_type = DataType$CELL_SETS,
+ file_type = FileType$CELL_SETS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.molecules.json"),
+ data_type = DataType$MOLECULES,
+ file_type = FileType$MOLECULES_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.clusters.json"),
+ data_type = DataType$EXPRESSION_MATRIX,
+ file_type = FileType$CLUSTERS_JSON
+)$add_file(
+ url = paste0(base_url, "linnarsson.raster.json"),
+ data_type = DataType$RASTER,
+ file_type = FileType$RASTER_JSON
+)
+
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Codeluppi et al., Nature Methods 2018: Spatial organization of the somatosensory cortex revealed by osmFISH.")
+
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+spatial_layers <- vc$add_view(dataset, Component$LAYER_CONTROLLER)
+
+scatterplot_pca <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "PCA")
+scatterplot_tsne <- vc$add_view(dataset, Component$SCATTERPLOT, mapping = "t-SNE")
+status <- vc$add_view(dataset, Component$STATUS)
+
+cell_sets <- vc$add_view(dataset, Component$CELL_SETS)
+gene_list <- vc$add_view(dataset, Component$GENES)
+heatmap <- vc$add_view(dataset, Component$HEATMAP)$set_props(transpose = TRUE)
+
+vc$layout(hconcat(
+ vconcat(vconcat(desc, status), spatial_layers),
+ vconcat(heatmap, spatial),
+ vconcat(scatterplot_tsne, scatterplot_pca),
+ vconcat(gene_list, cell_sets)
+))
+```
+
+```{r eval = FALSE, echo = TRUE}
+# Render the Vitessce widget
+vc$widget(theme = "light", width = "100%")
+```
+
+```{r eval = TRUE, echo = FALSE}
+if(!is.null(knitr::opts_knit$get("rmarkdown.pandoc.to")) && knitr::opts_knit$get("rmarkdown.pandoc.to") == "html") {
+ vc$widget(theme = "light", width = "100%")
+}
+```
+
+
+
diff --git a/vignettes/web_only/ome_tiff_remote.Rmd b/vignettes/web_only/ome_tiff_remote.Rmd
new file mode 100644
index 0000000..2fc3c60
--- /dev/null
+++ b/vignettes/web_only/ome_tiff_remote.Rmd
@@ -0,0 +1,70 @@
+---
+title: "Usage with OME-TIFF: Remote Example"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteIndexEntry{Usage with OME-TIFF: Remote Example}
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteEncoding{UTF-8}
+---
+
+```{r, setup, include=FALSE}
+knitr::opts_knit$set(
+ root.dir = dirname(dirname(getwd())),
+ rmarkdown.pandoc.to = knitr::opts_knit$get("rmarkdown.pandoc.to")
+)
+```
+
+The following is an example of usage of the widget to visualize a remote OME-TIFF image file.
+
+First, configure the Vitessce widget:
+
+```{r echo = TRUE, warning = FALSE}
+library(vitessceR)
+
+# Define the image file options object.
+file_options = obj_list(
+ schemaVersion = "0.0.2",
+ images = list(
+ obj_list(
+ name = "My Image",
+ type = "ome-tiff",
+ url = "https://vitessce-demo-data.storage.googleapis.com/exemplar-001/exemplar-001.pyramid.ome.tif"
+ )
+ ),
+ renderLayers = list(
+ "My Image"
+ )
+)
+
+# Create Vitessce view config
+vc <- VitessceConfig$new("My config")
+dataset <- vc$add_dataset("My dataset")$add_file(
+ data_type = DataType$RASTER,
+ file_type = FileType$RASTER_JSON,
+ options = file_options
+)
+spatial <- vc$add_view(dataset, Component$SPATIAL)
+spatial_layers <- vc$add_view(dataset, Component$LAYER_CONTROLLER)
+status <- vc$add_view(dataset, Component$STATUS)
+desc <- vc$add_view(dataset, Component$DESCRIPTION)
+desc <- desc$set_props(description = "Visualization of an OME-TIFF file.")
+vc$layout(hconcat(
+ spatial,
+ hconcat(spatial_layers, vconcat(desc, status))
+))
+```
+
+```{r eval = FALSE, echo = TRUE}
+# Render the Vitessce widget
+vc$widget(theme = "light", width = "100%")
+```
+
+```{r eval = TRUE, echo = FALSE}
+if(!is.null(knitr::opts_knit$get("rmarkdown.pandoc.to")) && knitr::opts_knit$get("rmarkdown.pandoc.to") == "html") {
+ vc$widget(theme = "light", width = "100%")
+}
+```
+
+
+
+