diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index cf89bf2..540e64a 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -40,11 +40,15 @@ jobs:
with:
r-version: ${{ matrix.config.r }}
http-user-agent: ${{ matrix.config.http-user-agent }}
- use-public-rspm: true
+ # Use CRAN's macOS binaries with CRAN R's bundled OpenMP runtime.
+ # Keep Posit Package Manager enabled on Linux and Windows.
+ use-public-rspm: ${{ runner.os != 'macOS' }}
- uses: r-lib/actions/setup-r-dependencies@v2
if: matrix.config.r == 'release'
with:
+ # Do not restore macOS binaries from the previous repository setup.
+ cache-version: ${{ runner.os == 'macOS' && '2' || '1' }}
extra-packages: any::rcmdcheck
needs: check
@@ -54,6 +58,17 @@ jobs:
extra-packages: any::rcmdcheck, cran/ggrepel@0.9.6
needs: check
+ - name: Verify macOS dependencies load
+ if: runner.os == 'macOS'
+ shell: Rscript {0}
+ run: |
+ print(R.version)
+ print(getOption("repos"))
+ library(Rtsne)
+ library(dotCall64)
+ library(SeuratObject)
+ library(Seurat)
+
- uses: r-lib/actions/check-r-package@v2
with:
upload-snapshots: true
diff --git a/DESCRIPTION b/DESCRIPTION
index 7db99e2..32db8d1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,19 +1,30 @@
Package: CyteTypeR
Title: CyteType for R
-Version: 0.5.1
-Description: CyteTypeR is the R version of CyteType python package.
-Authors@R:
- person("Nygen Analytics AB", , ,"contact@nygen.io", role = c("aut", "cre"))
-License: MIT + file LICENSE
+Version: 0.6.0
+Authors@R:
+ person("Nygen Analytics AB", , , "contact@nygen.io", role = c("aut", "cre", "cph"))
+Description: R client for 'CyteType', an agentic, evidence-based cell type
+ annotation service for single-cell RNA sequencing data. It prepares a
+ clustered 'Seurat' object and its marker genes, writes the expression and
+ cell metadata files that are uploaded with a job, submits the job to the
+ 'CyteType' API and adds the results to the object: a cell type label, a
+ Cell Ontology term, a cell state and the reviewer's confidence for every
+ cluster, together with the evidence behind each label. Every job also
+ produces an interactive report. Using the service requires an API key; the
+ documentation is at .
+License: BSD_3_clause + file LICENSE
+URL: https://docs.nygen.io/CyteType/, https://github.com/NygenAnalytics/CyteTypeR
+BugReports: https://github.com/NygenAnalytics/CyteTypeR/issues
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
Depends:
- R (>= 4.1.0)
-Imports:
+ R (>= 4.2.0)
+Imports:
askpass,
cli,
crayon,
dplyr,
+ duckdb,
httpuv,
httr2,
jsonlite,
@@ -24,10 +35,11 @@ Imports:
purrr,
rhdf5,
Seurat,
- tibble,
- tidyr
-Suggests:
- duckdb,
+ SeuratObject,
+ stats,
+ utils,
+ withr
+Suggests:
future,
furrr,
knitr,
@@ -39,4 +51,4 @@ Remotes:
bioc::rhdf5
Config/testthat/edition: 3
VignetteBuilder: knitr
-Config/roxygen2/version: 8.0.0
+Config/roxygen2/version: 8.1.0
diff --git a/LICENSE b/LICENSE
index de4d7ba..d9691d4 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,2 +1,3 @@
-YEAR: 2026
-COPYRIGHT HOLDER: CyteTypeR authors
+YEAR: 2025-2026
+COPYRIGHT HOLDER: Nygen Analytics AB
+ORGANIZATION: Nygen Analytics AB
diff --git a/LICENSE.md b/LICENSE.md
index 6c9924b..04a71bf 100644
--- a/LICENSE.md
+++ b/LICENSE.md
@@ -1,37 +1,29 @@
-# MIT License
-
-Copyright (c) 2025 Nygen Analytics AB
-
-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.
-
-## CyteTypeR API
-
-### Academic Use (Free)
-- Rate-limited API access for academic research and education
-- **No rate limits** when using your own LLM
-- Generated data under [CC BY-SA-NC 4.0 (non-commercial)](https://creativecommons.org/licenses/by-nc-sa/4.0/)
-
-### Commercial Use & Higher Rate Limits
-- Requires a commercial use license from Nygen Analytics AB
-- Generated data includes commercial rights
-- Contact: contact@nygen.io
-
-### Getting API Access
-1. Academic users: Start with free rate-limited access
-2. Need higher rates or commercial use: contact@nygen.io
+BSD 3-Clause License
+
+Copyright (c) 2025-2026, Nygen Analytics AB
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+* Neither the name of the copyright holder nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/NAMESPACE b/NAMESPACE
index f420747..ae9b123 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand
+S3method(conditionCall,cytetype_api_error)
S3method(print,cytetype_api_error)
export(CleanUpArtifacts)
export(CyteTypeR)
@@ -13,36 +14,37 @@ export(SetupCyteTypeR)
export(ViewCyteTypeJob)
export(cytetype_api_error)
importFrom(Matrix,rowSums)
-importFrom(Seurat,AddMetaData)
-importFrom(Seurat,Embeddings)
-importFrom(Seurat,GetAssayData)
-importFrom(dplyr,"%>%")
-importFrom(dplyr,arrange)
-importFrom(dplyr,desc)
-importFrom(dplyr,filter)
-importFrom(dplyr,group_by)
-importFrom(dplyr,slice_head)
-importFrom(dplyr,ungroup)
-importFrom(httr2,req_auth_bearer_token)
-importFrom(httr2,req_body_json)
-importFrom(httr2,req_headers)
-importFrom(httr2,req_method)
-importFrom(httr2,req_perform)
-importFrom(httr2,req_timeout)
-importFrom(httr2,request)
-importFrom(httr2,resp_body_json)
-importFrom(httr2,resp_body_string)
-importFrom(httr2,resp_status)
-importFrom(jsonlite,fromJSON)
-importFrom(jsonlite,write_json)
-importFrom(logger,log_debug)
-importFrom(logger,log_error)
-importFrom(logger,log_info)
-importFrom(logger,log_warn)
+importFrom(dplyr,
+ "%>%",
+ arrange,
+ desc,
+ filter,
+ group_by,
+ slice_head,
+ ungroup
+)
+importFrom(httr2,
+ req_auth_bearer_token,
+ req_body_json,
+ req_headers,
+ req_method,
+ req_perform,
+ req_timeout,
+ request,
+ resp_body_json,
+ resp_body_string,
+ resp_status
+)
+importFrom(jsonlite,
+ fromJSON,
+ write_json
+)
+importFrom(logger,
+ log_debug,
+ log_error,
+ log_info,
+ log_warn
+)
importFrom(methods,as)
-importFrom(purrr,list_rbind)
-importFrom(purrr,map_dfr)
importFrom(stats,setNames)
-importFrom(tibble,tibble)
-importFrom(tidyr,pivot_longer)
importFrom(utils,flush.console)
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..f29b72a
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,171 @@
+# CyteTypeR 0.6.0
+
+## Results
+
+* The evidence columns of `obj@misc$cytetype_results` (`justification`,
+ `supportingMarkers`, `conflictingMarkers`, `missingExpression` and
+ `unexpectedExpression`) are populated again. They had been empty since
+ 0.3.0, even for older jobs, because only six fields of each result were
+ kept. For jobs that store the evidence in their structured output, an empty
+ field is filled from it (the conclusion, the key supporting genes, the
+ unexpected genes and the explanations of missing and unexpected genes);
+ stored values are never overwritten. The CyteType server and the Python
+ client apply the same rules.
+* The results table gains three columns after the existing eleven:
+ `reviewerConfidence` (`"High"`, `"Moderate"`, `"Low"` or `NA`),
+ `isHeterogeneous` (`TRUE`, `FALSE` or `NA`) and `heterogeneityType`.
+* `CyteTypeR()` adds the factor column
+ `_reviewerConfidence_` to `obj@meta.data`, with the
+ levels `"High"`, `"Moderate"`, `"Low"` and `"Unknown"` in that order (only
+ the levels that occur are kept). The four existing columns and the three
+ columns kept under older names are unchanged.
+* With the default prefix, `obj@misc$cytetype_results` is still the
+ per-cluster data.frame. It now carries the job ID and the full results as
+ the attributes `"job_id"` and `"result"`.
+* The full results (returned by `GetResults()` for other prefixes and for
+ jobs fetched through the object) list every field for each cluster, plus
+ `reviewerConfidence`, `isHeterogeneous` and `heterogeneityType`, and keep
+ the server's per-cluster results unchanged as `raw_annotations`. Full
+ results that earlier versions stored under another prefix gain the three
+ keys (as `NULL`) when `GetResults()` reads them, but not the evidence
+ fields, because those versions kept neither the evidence nor the raw
+ results. With the default prefix, `GetResults(obj)` returns the stored
+ table unchanged, so a table saved by an earlier version keeps its eleven
+ columns and empty evidence; fetch the job again with
+ `GetResults(job_id = ...)` for the new columns.
+* A run with another `results_prefix` no longer overwrites
+ `obj@misc$cytetype_results`; it only writes
+ `obj@misc[[paste0(prefix, "_results")]]`.
+* Clusters without a result (for example clusters that failed) no longer stop
+ `CyteTypeR()` at the end of a run, which lost the annotated object: with two
+ or more such clusters, 0.5.1 failed on duplicated `"NULL"` row names. These
+ clusters now have no row in the results table, their cells are marked
+ `"Unknown"`, and a warning names them. Raw results and already flat entries
+ are recognized per cluster, and a result without a cluster ID takes the ID
+ under which the server returned it.
+
+## Retrieving results
+
+* `GetResults(job_id = ...)` checks the job's status first. While the job is
+ still running it returns `NULL` with a message instead of an empty table,
+ and an unknown job also returns `NULL` with a message. A failed job is an
+ error. HTTP 202 (`JOB_PROCESSING`) from the results endpoint is treated as
+ "still running".
+* `GetResults()` gains `save_json`. `GetResults(job_id = ...)` writes
+ `cytetypeR_results_.json` only when results are available, and
+ `save_json = FALSE` skips the file. The returned table carries the job ID
+ and the full results as attributes.
+* `GetResults(obj)` prints a message when the stored job has not finished yet.
+* When the status or the results of a job cannot be fetched, `GetResults()`
+ signals a `cytetype_api_error` with one message, such as "Error while
+ checking job status: HTTP 410 [REPORT_DELETED] This report has been deleted
+ by the owner", the server's code in `error_code` and the HTTP status in
+ `status_code`. 0.5.1 raised a plain error for jobs stored in the object.
+ `cytetype_api_error()` gains the `error_code` and `status_code` arguments,
+ and these conditions print as `Error: ` instead of
+ `Error in "api" : `. Problems with the API key still signal
+ `cytetype_auth_error`.
+
+## Running jobs
+
+* `timeout_seconds` is enforced. 0.5.1 compared the elapsed time in automatic
+ `difftime` units (minutes or hours), so the timeout effectively never
+ fired. When it is reached, `CyteTypeR()` stops with an error of class
+ `cytetype_timeout_error` that names the job ID and the
+ `GetResults(job_id = ...)` call to fetch the results later; the job keeps
+ running on the server. The default is still 7200 seconds, so jobs that take
+ longer now stop waiting.
+* While waiting, network errors (no response from the server) are retried
+ until `timeout_seconds` is reached, as in the Python client. Other errors
+ still stop the run after five in a row, now with a `cytetype_api_error`
+ whose message says how to fetch the results later. When the results of a
+ completed job cannot be fetched, the rate limit and server errors (HTTP
+ 500, 502, 503 and 504) are retried in the same way; 0.5.1 stopped at once.
+ Other errors while fetching the results, such as a deleted report (HTTP
+ 410), still stop the run at once, now with a `cytetype_api_error`.
+* The hint printed when a job is submitted, and the message printed when a run
+ is interrupted, show `GetResults(job_id = "")`. The earlier
+ `GetResults()` hint could not work, because an interrupted run does not
+ return the object that holds the job details.
+* New `visibility` argument of `CyteTypeR()`: `"private"`, `"org"` or
+ `"public"`, sent as the request's top-level `visibility` and stored in the
+ job details. The default, `NULL`, uses the server default (`"private"`).
+ `"org"` needs an organization API key. When the key looks like a personal
+ key (it starts with `cyt_p_`), `CyteTypeR()` logs a warning before uploading
+ the files and continues; the server checks the key when the job is
+ submitted and rejects personal keys.
+* `llm_configs` accepts the `deepseek`, `nebius` and `together` providers.
+* The rate-limit message no longer says that your own LLM API key bypasses the
+ free-tier limits. The limits apply to every job, including jobs that use
+ your own LLM.
+* Error messages from the server are read in all the forms it sends: the
+ server's own `{"error_code", "message"}`, a plain text explanation, and the
+ list of validation errors of an HTTP 422 response. 0.5.1 showed only the
+ HTTP status for the last two, for example "Job submission failed: HTTP 400
+ Bad Request.".
+
+## Preparing data
+
+* Seurat v5 objects whose RNA layers are split (for example by sample) are
+ supported. The layers are joined on a copy; your object is not changed.
+* A default assay other than `"RNA"` (such as `"SCT"`) no longer breaks the
+ preparation. Expression, gene names and the uploaded files all come from the
+ RNA assay, and the warning that RNA is used is shown once.
+* `NA` values in the `group_key` column stop `PrepareCyteTypeR()` early with
+ a clear error instead of "subscript out of bounds".
+* Sampling cells for the report's plot no longer resets the global random
+ number generator (`set.seed(42)` was called in your session); a local seed
+ keeps the sample reproducible. A cluster with a single cell now keeps that
+ cell; 0.5.1 could pick another one.
+* Expression percentages are mapped to the right clusters when the cluster
+ column is a factor with unused levels.
+* Coordinates fall back from `coordinates_key` to `"umap"`, `"tsne"` and
+ `"pca"`, matched case-insensitively. Without any, the job runs without the
+ plot and the preparation continues. `prepped_data$coordinates_key` names the
+ reduction that was used, or is `NULL` when none was.
+* Raw counts are written to `vars.h5` only when they are whole numbers. 0.5.1
+ truncated other values silently.
+* The counts and normalized data are read directly from the RNA assay. With
+ SeuratObject 4, 0.5.1 read the normalized values where it meant the raw
+ counts.
+* The gene symbol checks work: a warning is logged when most genes of the
+ marker table or of the RNA assay look like database IDs (Ensembl IDs with
+ or without a version suffix, RefSeq accessions or numeric IDs). The checks
+ only warn.
+* DuckDB spills to a private temporary directory that is removed afterwards,
+ instead of `tmp/duckdb` in the working directory. With duckdb versions that
+ support it, writing `obs.duckdb` no longer uses the shared `~/.duckdb`
+ directory.
+* The feature index in `vars.h5` holds gene names for Seurat v5 objects
+ instead of row numbers.
+* `PrepareCyteTypeR()` no longer assigns `obj@misc$query`, which never reached
+ the caller's object.
+
+## Sign-in and the cytetyper command
+
+* `cytetyper login` works. The launcher runs R non-interactively, where the
+ hidden prompt returned nothing, so the command stopped with "API key is
+ required". The key is now read from standard input and can be piped in:
+ `printf '%s\n' "$CYTETYPE_API_KEY" | cytetyper login`. Typed into a
+ terminal, the key is hidden on Linux and macOS (through `stty`) but shown on
+ Windows. `LoginCyteTypeR()` reads standard input the same way when R is not
+ interactive.
+* `OpenCyteTypeDashboard()` documents that it opens
+ `https://cytetype.nygen.io/dashboard` when no credentials are saved.
+
+## Package
+
+* CyteTypeR is now released under the BSD 3-Clause License.
+* `duckdb`, `SeuratObject` and `withr` are required dependencies, and R 4.2 or
+ newer is needed (the current duckdb requires it). `tibble` and `tidyr` are
+ no longer used. `duckdb` is checked before `vars.h5` is written.
+* `CleanUpArtifacts()` returns `TRUE` invisibly when it removed the files and
+ `FALSE` when they were never built.
+* New package help page (`?"CyteTypeR-package"`), `URL` and `BugReports`
+ fields, and corrected help for `results_prefix`, the return values and the
+ examples.
+* The documentation moved to , which covers
+ the R and Python clients. The "Getting Started" vignette is now a short
+ overview with links, the "Configurations" vignette was removed, and
+ `inst/cytetypeR_table_export.tsv` was removed because it no longer matched
+ the results table.
diff --git a/R/CyteTypeR-package.R b/R/CyteTypeR-package.R
new file mode 100644
index 0000000..13de07c
--- /dev/null
+++ b/R/CyteTypeR-package.R
@@ -0,0 +1,37 @@
+#' CyteTypeR: CyteType for R
+#'
+#' @description
+#' CyteTypeR is the R client of CyteType, an agentic, evidence-based cell type
+#' annotation service for single-cell RNA-seq data. It prepares a clustered
+#' Seurat object and its marker genes, submits an annotation job to the
+#' CyteType API and adds the results to the object: a cell type label, a Cell
+#' Ontology term, a cell state and the reviewer's confidence for every
+#' cluster. Every job also produces an interactive report.
+#'
+#' @section Workflow:
+#' 1. Sign in once per computer with [SetupCyteTypeR()], or save an API key
+#' you already have with [LoginCyteTypeR()].
+#' 2. Run [PrepareCyteTypeR()] on a normalized, clustered Seurat object and the
+#' marker table from `Seurat::FindAllMarkers()`.
+#' 3. Run [CyteTypeR()] to upload the data, submit the job, wait for it and add
+#' the results to the object.
+#' 4. Use [GetResults()] to read the results again, or to fetch the results of
+#' a job by its ID, and [CleanUpArtifacts()] to delete the uploaded files.
+#'
+#' [OpenCyteTypeDashboard()] and [ViewCyteTypeJob()] open the dashboard and a
+#' job's report. [InstallCyteTypeRCli()] installs the `cytetyper` terminal
+#' command, which signs in and opens reports from a shell.
+#'
+#' @section Documentation:
+#' The CyteType documentation at covers both
+#' the R and the Python client: installation, sign-in, the R quickstart, the
+#' results, the report and the usage limits.
+#'
+#' @section License:
+#' The package code is released under the BSD 3-Clause License. Annotation runs
+#' on the CyteType service, which requires an API key: academic and
+#' non-commercial use is free within the usage limits, and commercial use
+#' requires a license from Nygen Analytics AB ().
+#'
+#' @keywords internal
+"_PACKAGE"
diff --git a/R/api.R b/R/api.R
index d8eb9f3..0c78016 100644
--- a/R/api.R
+++ b/R/api.R
@@ -6,7 +6,8 @@
vars_h5 = 50 * 1024 * 1024 * 1024 # 50 GB
)
-# Chunked upload retry: delays (sec) after 1st, 2nd, 3rd failure; status codes treated as transient (incl. network/gateway)
+# Chunked upload retry: delays (sec) after 1st, 2nd, 3rd failure; status codes treated as transient (incl. network/gateway).
+# The same statuses are retried while waiting for the results of a completed job.
.CHUNK_UPLOAD_BACKOFF_SECS <- c(1L, 5L, 20L)
.CHUNK_UPLOAD_TRANSIENT_STATUSES <- c(500L, 502L, 503L, 504L)
@@ -25,9 +26,19 @@
}
#' @importFrom httr2 req_auth_bearer_token req_body_json req_headers req_method req_perform req_timeout request resp_body_json resp_body_string resp_status
+# GET /status/{job_id} or /results/{job_id}. Returns list(status_code, data)
+# for 2xx responses and 404. Every other failure is signalled once, with one
+# message: cytetype_auth_error for HTTP 401 and 403, cytetype_api_error
+# (carrying the server's error_code when it sent one) otherwise. Both carry
+# the HTTP status as status_code when the server answered with an error.
.api_response_helper <- function(job_id, api_url, req_item, auth_token = NULL) {
req_api_url <- .url_path(api_url, req_item, job_id)
+ context <- if (identical(req_item, "results")) {
+ "Error while fetching job results"
+ } else {
+ "Error while checking job status"
+ }
tryCatch({
# Build and execute request
@@ -40,7 +51,7 @@
}
response <- req |>
- httr2::req_error(is_error = function(resp) resp_status(resp) == 429L) |>
+ httr2::req_error(is_error = function(resp) FALSE) |>
req_perform()
status_code <- resp_status(response)
@@ -53,14 +64,16 @@
log_debug("Authentication failed for job {job_id}")
.stop_authentication(
"Authentication failed: Invalid or expired auth token",
- "INVALID_TOKEN"
+ "INVALID_TOKEN",
+ status_code = status_code
)
},
"403" = {
log_debug("Authorization failed for job {job_id}")
.stop_authentication(
"Authorization failed: Access denied",
- "ACCESS_DENIED"
+ "ACCESS_DENIED",
+ status_code = status_code
)
}
)
@@ -68,19 +81,38 @@
# Check for other non-success status codes
if (status_code < 200 || status_code >= 300) {
parsed <- .parse_server_error(response)
- if (!is.null(parsed)) {
- stop(paste0("HTTP ", status_code, " [", parsed$error_code, "] ", parsed$message))
+ if (!is.null(parsed) && identical(parsed$error_code, "RATE_LIMIT_EXCEEDED")) {
+ stop(cytetype_api_error(
+ message = .rate_limit_message(parsed$message),
+ call = "api",
+ error_code = "RATE_LIMIT_EXCEEDED",
+ status_code = status_code
+ ))
+ }
+ detail <- if (!is.null(parsed)) {
+ .format_parsed_error(parsed)
+ } else {
+ error_body <- tryCatch(trimws(resp_body_string(response)), error = function(e) "")
+ if (nzchar(error_body)) error_body else "Unknown error"
}
- error_body <- tryCatch(resp_body_string(response), error = function(e) "Unknown error")
- stop(paste("HTTP", status_code, "error:", error_body))
+ stop(cytetype_api_error(
+ message = paste0(context, ": HTTP ", status_code, " ", detail),
+ call = "api",
+ error_code = parsed$error_code,
+ status_code = status_code
+ ))
}
- # Parse successful response
+ # Parse successful response. The results endpoint answers 202 with a
+ # JOB_PROCESSING body while the job runs; callers check status_code.
response_data <- tryCatch({
resp_body_json(response)
}, error = function(e) {
- log_debug("Error parsing JSON response for job {job_id}: {e$message}")
- stop(paste("Invalid JSON response:", e$message))
+ log_debug("Error parsing JSON response for job {job_id}: {conditionMessage(e)}")
+ stop(cytetype_api_error(
+ message = paste0(context, ": invalid JSON response: ", conditionMessage(e)),
+ call = "api"
+ ))
})
return(list(
@@ -89,27 +121,25 @@
))
}, error = function(e) {
- .stop_if_rate_limited(e)
-
- # Preserve authentication/authorization errors
- if (grepl("Authentication failed|Authorization failed", e$message)) {
- stop(e)
- }
-
- # Don't double-wrap custom errors
+ # Signalled above (including authentication and authorization errors):
+ # pass on as they are, so the message is never prefixed twice.
if (inherits(e, "cytetype_api_error")) {
stop(e)
}
- # Categorize and wrap other errors
- error_type <- if (grepl("network|connection|resolve|timeout", tolower(e$message))) {
+ # Categorize and wrap other errors. httr2 signals requests that received
+ # no response (DNS, refused connections, timeouts) as httr2_failure.
+ error_type <- if (
+ inherits(e, "httr2_failure") ||
+ grepl("network|connection|resolve|timeout", tolower(conditionMessage(e)))
+ ) {
"network"
} else {
"api"
}
- log_debug("Error during status check for job {job_id}: {e$message}")
- stop(cytetype_api_error(message = paste("Error while checking job status:", e$message), call = error_type))
+ log_debug("Error during {req_item} request for job {job_id}: {conditionMessage(e)}")
+ stop(cytetype_api_error(message = paste0(context, ": ", conditionMessage(e)), call = error_type))
})
}
diff --git a/R/artifacts.R b/R/artifacts.R
index 1d2c18c..b1c4fec 100644
--- a/R/artifacts.R
+++ b/R/artifacts.R
@@ -136,8 +136,21 @@
n_obs <- nrow(mat)
n_vars <- ncol(mat)
- if (!requireNamespace("rhdf5filters", quietly = TRUE)) {
- stop("Package 'rhdf5filters' is required to write vars.h5 with LZ4 compression.")
+ # rhdf5 imports rhdf5filters, which provides the BLOSC LZ4 filter.
+
+ # Raw counts are stored as int32, so only write them when every value is a
+ # whole number; as.integer() would silently truncate anything else.
+ if (!is.null(raw_mat)) {
+ if (nrow(raw_mat) != n_vars || ncol(raw_mat) != n_obs) {
+ log_warn(paste0(
+ "Raw counts have ", nrow(raw_mat), " genes and ", ncol(raw_mat), " cells, but the ",
+ "expression matrix has ", n_vars, " and ", n_obs, ". Skipping raw counts in vars.h5."
+ ))
+ raw_mat <- NULL
+ } else if (!.is_integer_valued(raw_mat)) {
+ log_warn("The raw counts are not integer-valued. Skipping raw counts in vars.h5.")
+ raw_mat <- NULL
+ }
}
if (is.null(col_batch)) {
@@ -185,10 +198,8 @@
.save_obs_duckdb <- function(out_file, obs_df, coordinates = NULL, coordinates_key = NULL,
table_name = "obs",
- threads = "4", memory_limit = "4GB", temp_directory = "tmp/duckdb") {
- if (!requireNamespace("duckdb", quietly = TRUE)) {
- stop("Package 'duckdb' is required to build obs.duckdb. Install with: install.packages('duckdb')")
- }
+ threads = "4", memory_limit = "4GB", temp_directory = NULL) {
+ .require_duckdb()
if (!grepl("^[A-Za-z_][A-Za-z0-9_]*$", table_name)) {
stop("Invalid table_name. Use letters, numbers, and underscores only.")
}
@@ -197,6 +208,10 @@
if (!is.null(coordinates) && !is.null(coordinates_key)) {
coords <- as.matrix(coordinates)
+ if (!is.null(rownames(coords)) && !is.null(rownames(df)) &&
+ !identical(rownames(coords), rownames(df)) && all(rownames(df) %in% rownames(coords))) {
+ coords <- coords[rownames(df), , drop = FALSE]
+ }
if (ncol(coords) >= 2 && nrow(coords) == nrow(df)) {
col1 <- paste0("__vis_coordinates_", coordinates_key, "_1")
col2 <- paste0("__vis_coordinates_", coordinates_key, "_2")
@@ -208,9 +223,35 @@
cli::cli_progress_step("Writing obs.duckdb")
if (file.exists(out_file)) file.remove(out_file)
- config <- list(threads = as.character(threads), memory_limit = memory_limit, temp_directory = temp_directory)
- con <- duckdb::dbConnect(duckdb::duckdb(), out_file, config = config)
- on.exit(duckdb::dbDisconnect(con, shutdown = TRUE), add = TRUE)
+ config <- list(threads = as.character(threads), memory_limit = memory_limit)
+ if (is.null(temp_directory)) {
+ # DuckDB spills to temp_directory when memory_limit is exceeded. A fixed
+ # path relative to the working directory is shared between runs and never
+ # cleaned up, so use a private directory under the session's tempdir().
+ spill_directory <- tempfile("cytetype-duckdb-")
+ if (dir.create(spill_directory, showWarnings = FALSE, recursive = TRUE, mode = "0700")) {
+ on.exit(unlink(spill_directory, recursive = TRUE, force = TRUE), add = TRUE)
+ temp_directory <- spill_directory
+ } else {
+ log_warn("Could not create a temporary directory for DuckDB; using DuckDB's default spill location.")
+ }
+ }
+ if (!is.null(temp_directory)) {
+ config$temp_directory <- temp_directory
+ }
+ con <- duckdb::dbConnect(.duckdb_driver(), out_file, config = config)
+ # Disconnect before the spill directory is removed.
+ on.exit(duckdb::dbDisconnect(con, shutdown = TRUE), add = TRUE, after = FALSE)
duckdb::dbWriteTable(con, table_name, df, overwrite = TRUE)
invisible(out_file)
}
+
+# Writing obs.duckdb needs no extensions or secrets, so keep newer duckdb
+# versions from storing them in the shared ~/.duckdb directory.
+.duckdb_driver <- function() {
+ if ("shared_home" %in% names(formals(duckdb::duckdb))) {
+ duckdb::duckdb(shared_home = FALSE)
+ } else {
+ duckdb::duckdb()
+ }
+}
diff --git a/R/auth.R b/R/auth.R
index fdac998..1b162df 100644
--- a/R/auth.R
+++ b/R/auth.R
@@ -296,18 +296,24 @@
credentials$dashboardUrl
}
-.new_authentication_error <- function(message, error_code) {
+.new_authentication_error <- function(message, error_code, status_code = NULL) {
structure(
- list(message = message, call = NULL, error_code = error_code),
+ list(
+ message = message,
+ call = NULL,
+ error_code = error_code,
+ status_code = status_code
+ ),
class = c("cytetype_auth_error", "cytetype_api_error", "error", "condition")
)
}
.stop_authentication <- function(
message,
- error_code = "AUTHENTICATION_REQUIRED"
+ error_code = "AUTHENTICATION_REQUIRED",
+ status_code = NULL
) {
- stop(.new_authentication_error(message, error_code))
+ stop(.new_authentication_error(message, error_code, status_code))
}
.resolve_auth_token <- function(api_url, auth_token = NULL) {
@@ -867,6 +873,68 @@
result$value
}
+.is_interactive <- function() {
+ interactive()
+}
+
+# First line of the process's standard input (not R's console), or
+# character(0) at the end of input.
+.read_stdin_line <- function() {
+ con <- file("stdin")
+ on.exit(close(con), add = TRUE)
+ readLines(con, n = 1L, warn = FALSE)
+}
+
+.stdin_is_terminal <- function() {
+ if (!identical(.Platform$OS.type, "unix")) {
+ return(FALSE)
+ }
+ status <- suppressWarnings(system(
+ "test -t 0",
+ ignore.stdout = TRUE,
+ ignore.stderr = TRUE
+ ))
+ identical(as.integer(status), 0L)
+}
+
+.set_terminal_echo <- function(enabled) {
+ status <- suppressWarnings(system(
+ if (enabled) "stty echo" else "stty -echo",
+ ignore.stdout = TRUE,
+ ignore.stderr = TRUE
+ ))
+ identical(as.integer(status), 0L)
+}
+
+# Read an API key. Rscript, and so the cytetyper command, is not interactive,
+# where askpass returns NULL: read the key from standard input instead. When
+# the input is a terminal, `stty` hides the key on Linux and macOS; Windows has
+# no `stty`, so the key is shown there.
+.prompt_api_key <- function(prompt = "API key: ") {
+ if (.is_interactive()) {
+ return(askpass::askpass(prompt))
+ }
+ cat(prompt, file = stderr())
+ terminal <- .stdin_is_terminal()
+ echo_disabled <- terminal && .set_terminal_echo(FALSE)
+ on.exit(
+ {
+ if (echo_disabled) {
+ .set_terminal_echo(TRUE)
+ }
+ if (echo_disabled || !terminal) {
+ cat("\n", file = stderr())
+ }
+ },
+ add = TRUE
+ )
+ line <- .read_stdin_line()
+ if (length(line) == 0L || is.na(line[[1L]])) {
+ return(NULL)
+ }
+ line[[1L]]
+}
+
#' Set up CyteType authentication
#'
#' Validates matching saved credentials. When none are available, opens
@@ -964,7 +1032,11 @@ SetupCyteTypeR <- function(api_url = NULL, force = FALSE) {
#'
#' Validates an API key and stores it for later CyteTypeR requests.
#'
-#' @param api_token Optional API key. When omitted, a hidden prompt is shown.
+#' @param api_token Optional API key. When omitted, a hidden prompt is shown
+#' in an interactive session. Otherwise the key is read from the first line
+#' of standard input, so `cytetyper login` and scripts can pipe it in. Typed
+#' into a terminal, the key is hidden on Linux and macOS but shown on
+#' Windows.
#' @param api_url Optional CyteType server origin. When `NULL`, uses
#' `CYTETYPE_API_URL` or `https://cytetype.nygen.io`.
#' @return The saved credential metadata, invisibly.
@@ -977,7 +1049,7 @@ SetupCyteTypeR <- function(api_url = NULL, force = FALSE) {
LoginCyteTypeR <- function(api_token = NULL, api_url = NULL) {
api_url <- .resolve_api_url(api_url)
if (is.null(api_token)) {
- api_token <- askpass::askpass("API key: ")
+ api_token <- .prompt_api_key("API key: ")
}
if (!.is_scalar_string(api_token) || !nzchar(trimws(api_token))) {
stop("API key is required", call. = FALSE)
@@ -1045,7 +1117,8 @@ LogoutCyteTypeR <- function() {
#' @return The dashboard URL, invisibly.
#' @details
#' Uses the dashboard associated with saved credentials. When credentials are
-#' absent, opens the production dashboard at `https://cytetype.nygen.io`.
+#' absent, opens the production dashboard at
+#' `https://cytetype.nygen.io/dashboard`.
#' @examples
#' \dontrun{
#' OpenCyteTypeDashboard()
diff --git a/R/cli.R b/R/cli.R
index e16f5cc..db0b71e 100644
--- a/R/cli.R
+++ b/R/cli.R
@@ -51,7 +51,10 @@
login = paste(
"Usage: cytetyper login [--api-url URL]",
"",
- "Securely prompt for, validate, and save an existing API key.",
+ "Prompt for, validate, and save an existing API key. The key is read",
+ "from standard input and hidden while you type on Linux and macOS (not",
+ "on Windows). It can also be piped in, for example:",
+ "printf '%s\\n' \"$CYTETYPE_API_KEY\" | cytetyper login",
sep = "\n"
),
logout = paste(
diff --git a/R/client.R b/R/client.R
index 1e6a72b..1e289c8 100644
--- a/R/client.R
+++ b/R/client.R
@@ -247,8 +247,16 @@
# Multi-step job results request (status check + results fetch)
.make_results_request <- function(job_id, api_url, auth_token = NULL) {
- make_response <- function(status, result = NULL, message, raw = NULL) {
- list(status = status, result = result, message = message, raw_response = raw)
+ make_response <- function(status, result = NULL, message, raw = NULL, error_type = NULL,
+ condition = NULL) {
+ list(
+ status = status,
+ result = result,
+ message = message,
+ raw_response = raw,
+ error_type = error_type,
+ condition = condition
+ )
}
tryCatch({
@@ -268,15 +276,19 @@
if (inherits(e, "cytetype_auth_error")) {
stop(e)
}
+ condition <- .as_fetch_error(e, "Error while fetching job results")
make_response(
- "failed",
- message = paste("Job completed but results unavailable:", e$message),
- raw = status_data
+ # Transient errors are retried while waiting; others end the wait.
+ if (.is_transient_error(condition)) "error" else "failed",
+ message = conditionMessage(condition),
+ raw = status_data,
+ error_type = condition$call,
+ condition = condition
)
}
)
- if (!is.null(results_resp$status) && results_resp$status == "failed") {
+ if (!is.null(results_resp[["status"]])) {
return(results_resp)
}
@@ -288,6 +300,15 @@
))
}
+ # HTTP 202 (JOB_PROCESSING): the results are not ready yet.
+ if (results_resp$status_code == 202) {
+ return(make_response(
+ "processing",
+ message = "Job is processing",
+ raw = status_data
+ ))
+ }
+
return(make_response(
"completed",
result = results_resp$data,
@@ -322,13 +343,68 @@
if (inherits(e, "cytetype_auth_error")) {
stop(e)
}
+ condition <- .as_fetch_error(e, "Error while checking job status")
return(make_response(
"error",
- message = paste("Error checking job status:", e$message)
+ message = conditionMessage(condition),
+ error_type = condition$call,
+ condition = condition
))
})
}
+# A failed status or results request as a cytetype_api_error. Errors from
+# .api_response_helper() already are one and keep their message.
+.as_fetch_error <- function(e, context) {
+ if (inherits(e, "cytetype_api_error")) {
+ return(e)
+ }
+ cytetype_api_error(
+ message = paste0(context, ": ", conditionMessage(e)),
+ call = .error_type(e)
+ )
+}
+
+# Errors worth retrying: no response (network), the rate limit, and server and
+# gateway errors (HTTP 500, 502, 503 and 504). Others, such as HTTP 410
+# (REPORT_DELETED) or 404, are permanent; authentication errors (HTTP 401 and
+# 403) are signalled before this is asked.
+.is_transient_error <- function(condition) {
+ identical(condition$call, "network") ||
+ identical(condition$error_code, "RATE_LIMIT_EXCEEDED") ||
+ isTRUE(condition$status_code %in% .CHUNK_UPLOAD_TRANSIENT_STATUSES)
+}
+
+# "network" when no response was received, "api" for other request errors.
+.error_type <- function(e) {
+ if (inherits(e, "cytetype_api_error") && .is_string(e$call)) {
+ return(e$call)
+ }
+ if (inherits(e, "httr2_failure")) {
+ return("network")
+ }
+ "api"
+}
+
+# Seams for tests: the clock and the waits.
+.now <- function() Sys.time()
+.sleep <- function(seconds) Sys.sleep(seconds)
+
+.new_timeout_error <- function(job_id, timeout) {
+ structure(
+ list(
+ message = paste0(
+ "Job ", job_id, " did not finish within ", timeout,
+ " seconds (timeout_seconds). The job keeps running on the server; ",
+ "retrieve its results later with ", .results_hint(job_id), "."
+ ),
+ call = NULL,
+ job_id = job_id
+ ),
+ class = c("cytetype_timeout_error", "error", "condition")
+ )
+}
+
# Polling for results
.poll_for_results <- function(job_id, api_url, poll_interval = NULL,
timeout = NULL, auth_token = NULL,
@@ -337,10 +413,15 @@
poll_interval <- poll_interval %||% .get_default_poll_interval()
timeout <- timeout %||% .get_default_timeout()
+ # The timeout includes the initial wait.
+ start_time <- .now()
+ # difftime() picks its units automatically; always compare seconds.
+ elapsed <- function() as.numeric(difftime(.now(), start_time, units = "secs"))
+ # A wait never runs past the deadline.
+ capped <- function(seconds) max(0, min(seconds, timeout - elapsed()))
- # Initialize
log_info("CyteType job (id: {job_id}) submitted. Polling for results...")
- Sys.sleep(5)
+ .sleep(capped(5))
report_url <- .url_path(api_url, "report", job_id)
@@ -353,24 +434,26 @@
cli::cli_text("{.url {report_url}}")
}
- log_info("If disconnected, retrieve results with: GetResults()")
+ log_info("If disconnected, retrieve results with: {.results_hint(job_id)}")
# Initialize tracking
- start_time <- Sys.time()
last_cluster_status <- list()
spinner_frame = 0
consecutive_not_found <- 0
consecutive_errors <- 0
+ consecutive_network_errors <- 0
max_consecutive_errors <- 5
# Main polling loop
repeat {
- elapsed <- as.numeric(Sys.time() - start_time)
-
- if (elapsed > timeout) {
+ # The deadline is checked only before each request. A request that starts
+ # in time and finds the job completed returns its results even if it ends
+ # slightly after the deadline: a finished result is better than a timeout.
+ if (elapsed() >= timeout) {
cat("\n")
- stop("timeout", "Timeout while fetching results")
+ log_info("Report: {report_url}")
+ stop(.new_timeout_error(job_id, timeout))
}
tryCatch({
@@ -379,7 +462,10 @@
# Reset counters on valid server response
if (status != "not_found") consecutive_not_found <- 0
- if (status != "error") consecutive_errors <- 0
+ if (status != "error") {
+ consecutive_errors <- 0
+ consecutive_network_errors <- 0
+ }
# Extract cluster status
current_cluster_status <- status_response$raw_response$clusterStatus %||% list()
@@ -420,6 +506,10 @@
)
last_cluster_status <- current_cluster_status
}
+ # The results of a completed job could not be fetched.
+ if (inherits(status_response$condition, "cytetype_api_error")) {
+ stop(status_response$condition)
+ }
error_msg <- status_response$message %||% "Unknown server error"
stop(paste("Server error:", error_msg))
},
@@ -427,9 +517,9 @@
"pending" = {
log_debug("Job {job_id} status: {status}. Waiting {poll_interval}s...")
if (show_progress && length(current_cluster_status) > 0){
- .sleep_with_spinner(poll_interval, current_cluster_status, show_progress)
+ .sleep_with_spinner(capped(poll_interval), current_cluster_status, show_progress)
} else {
- Sys.sleep(poll_interval)
+ .sleep(capped(poll_interval))
}
last_cluster_status <- current_cluster_status
},
@@ -443,19 +533,40 @@
stop(paste0("Job '", job_id, "' not found after ", consecutive_not_found,
" attempts. Verify the job_id is correct."))
}
- .sleep_with_spinner(poll_interval, current_cluster_status, show_progress)
+ .sleep_with_spinner(capped(poll_interval), current_cluster_status, show_progress)
last_cluster_status <- current_cluster_status
},
"error" = {
- consecutive_errors <- consecutive_errors + 1
error_msg <- status_response$message %||% "Unknown error"
- log_warn("Error checking job {job_id} ({consecutive_errors}/{max_consecutive_errors}): {error_msg}")
- if (consecutive_errors >= max_consecutive_errors) {
- cat("\n")
- stop(paste("Stopping after", max_consecutive_errors, "consecutive errors:", error_msg))
+ if (identical(status_response$error_type, "network")) {
+ # As in the Python client, network errors are retried until
+ # timeout_seconds is reached.
+ consecutive_network_errors <- consecutive_network_errors + 1
+ if (consecutive_network_errors == 1) {
+ log_warn("Could not reach CyteType to check job {job_id}: {error_msg}. Retrying until timeout_seconds ({timeout}s) is reached...")
+ } else {
+ log_debug("Network error for {job_id} (attempt {consecutive_network_errors}): {error_msg}. Retrying...")
+ }
+ .sleep_with_spinner(capped(min(poll_interval, 5)), current_cluster_status, show_progress)
+ } else {
+ consecutive_errors <- consecutive_errors + 1
+ log_warn("{error_msg} (attempt {consecutive_errors}/{max_consecutive_errors} for job {job_id})")
+ if (consecutive_errors >= max_consecutive_errors) {
+ cat("\n")
+ stop(cytetype_api_error(
+ message = paste0(
+ "Stopping after ", max_consecutive_errors, " consecutive errors: ", error_msg,
+ "\nThe job may still be running; retrieve its results later with ",
+ .results_hint(job_id), "."
+ ),
+ call = status_response$error_type %||% "api",
+ error_code = status_response$condition$error_code,
+ status_code = status_response$condition$status_code
+ ))
+ }
+ .sleep_with_spinner(capped(poll_interval), current_cluster_status, show_progress)
}
- .sleep_with_spinner(poll_interval, current_cluster_status, show_progress)
},
{
@@ -480,7 +591,7 @@
if (grepl("Network error", error_msg)) {
log_debug("Network error for {job_id}: {error_msg}. Retrying...")
retry_interval <- min(poll_interval, 5)
- .sleep_with_spinner(retry_interval,current_cluster_status,show_progress)
+ .sleep_with_spinner(capped(retry_interval),current_cluster_status,show_progress)
} else {
cat("\n")
stop(e)
@@ -493,10 +604,12 @@
}
}
-# Helper for sleeping with spinner animation
+# Helper for sleeping with spinner animation. The spinner moves every half
+# second; the last step is shorter when the wait was cut to the time left
+# before the deadline, so the whole `duration` is slept.
.sleep_with_spinner <- function(duration,cluster_status,show_progress = TRUE) {
- for (i in seq_len(duration * 2)) {
- Sys.sleep(0.5)
+ for (i in seq_len(ceiling(duration * 2))) {
+ .sleep(min(0.5, duration - (i - 1) / 2))
if (show_progress){
.display_cluster_status_cli(cluster_status, is_final=FALSE, spinner_frame=i)
}
diff --git a/R/cytetype.R b/R/cytetype.R
index af74d82..9b42de5 100644
--- a/R/cytetype.R
+++ b/R/cytetype.R
@@ -3,15 +3,24 @@
#' @description
#' Prepares a Seurat object and a gene marker table for CyteType API by extracting and formatting
#' cluster labels, metadata, marker genes, visualization coordinates, and
-#' expression data into the required data structure.
+#' expression data into the required data structure. It also writes the two
+#' files that [CyteTypeR()] uploads with the job: `vars.h5` (expression) and
+#' `obs.duckdb` (cell metadata and coordinates).
#'
-#' @param obj A Seurat object with normalized data and clustering results.
-#' @param marker_table Data frame containing marker genes with columns:
-#' 'cluster', 'gene', and 'avg_log2FC'. Output from Seurat's
-#' `FindAllMarkers()` function.
+#' @param obj A Seurat object with normalized data and clustering results. It
+#' needs an assay named `"RNA"` with a normalized `data` layer.
+#' @param marker_table Data frame containing marker genes with the columns
+#' `cluster`, `gene` and `avg_log2FC`, such as the output of Seurat's
+#' `FindAllMarkers()`. Its clusters must be exactly the clusters in
+#' `group_key`, each with at least five marker genes.
#' @param group_key Character string specifying the metadata column containing
-#' cluster assignments. Default is "seurat_clusters".
-#' @param gene_symbols Character string specifying the gene symbol field name. Default is 'gene_symbols'.
+#' cluster assignments. Every cell needs a cluster: `NA` values stop the
+#' preparation with an error. Default is `"seurat_clusters"`.
+#' @param gene_symbols Character string naming the column of the RNA assay's
+#' feature metadata that holds gene symbols. It is used only to check that
+#' the genes are symbols rather than database identifiers; when the column
+#' does not exist, the row names of the RNA assay are checked instead.
+#' Default is `"gene_symbols"`.
#' @param n_top_genes Integer specifying the maximum number of top marker genes
#' per cluster to include after ordering by `avg_log2FC`. Filter
#' `marker_table` before calling this function when a fold-change threshold is
@@ -25,8 +34,12 @@
#' exceeding this limit are silently skipped. Default is 500.
#' @param pcent_batch_size Integer specifying batch size for expression percentage
#' calculations. Default is 5000.
-#' @param coordinates_key Character string specifying which dimensional reduction
-#' to use for visualization coordinates (e.g., "umap", "tsne"). Default is "umap".
+#' @param coordinates_key Character string naming the dimensional reduction used
+#' for the report's visualization, such as `"umap"` or `"tsne"`. This
+#' reduction is tried first, then `"umap"`, `"tsne"` and `"pca"`, matched
+#' case-insensitively; the first one with a row for every cell and at least
+#' two dimensions is used. When none qualifies, the job runs without
+#' visualization. Default is `"umap"`.
#' @param max_cells_per_group Integer specifying maximum cells per cluster for
#' visualization subsampling. Default is 1000.
#' @param vars_h5_path Character string specifying the local file path for the
@@ -34,32 +47,47 @@
#' @param obs_duckdb_path Character string specifying the local file path for the
#' generated obs.duckdb artifact (cell metadata). Default is `"obs.duckdb"`.
#'
-#' @return Named list containing formatted data for CyteType analysis:
+#' @return A named list to pass to [CyteTypeR()]:
#' \itemize{
-#' \item `clusterLabels`: List mapping numeric cluster IDs to original labels
+#' \item `clusterLabels`: List mapping the CyteType cluster IDs (`"1"`,
+#' `"2"`, ...) to your cluster labels
#' \item `clusterMetadata`: Aggregated metadata by cluster (if enabled)
#' \item `markerGenes`: List of top marker genes per cluster
-#' \item `visualizationData`: Coordinates and cluster assignments for plotting
+#' \item `visualizationData`: Sampled coordinates and cluster assignments
+#' for plotting, or `NULL` when no coordinates were found
#' \item `expressionData`: Expression percentages by cluster
#' \item `group_key`: The metadata column name used for cluster assignments
#' \item `build_succeeded`: Logical indicating whether artifact files were built successfully
#' \item `vars_h5_path`: Path to the generated vars.h5 file
#' \item `obs_duckdb_path`: Path to the generated obs.duckdb file
+#' \item `coordinates_key`: The name of the reduction whose coordinates
+#' were used for the visualization, or `NULL` when none was used
#' }
#'
#' @details
#' The function performs the following steps:
-#' 1. Validates the Seurat object structure
+#' 1. Validates the Seurat object structure and the cluster labels
#' 2. Creates a mapping from original cluster labels to sequential numeric IDs
#' 3. Aggregates metadata across cells within clusters (optional)
#' 4. Filters and selects top marker genes per cluster
#' 5. Extracts dimensional reduction coordinates for visualization
#' 6. Calculates expression percentages across clusters
-#' 7. Builds a vars.h5 artifact from the normalized expression matrix
+#' 7. Builds a vars.h5 artifact from the normalized expression matrix, with
+#' the raw counts when they are whole numbers
#' 8. Builds an obs.duckdb artifact from the cell metadata
#'
-#' Clusters are renumbered sequentially (1, 2, 3, ...) to ensure consistent
-#' formatting regardless of original cluster naming.
+#' Clusters are renumbered sequentially (1, 2, 3, ...) in the sorted order of
+#' your labels (level order for a factor) to ensure consistent formatting
+#' regardless of original cluster naming.
+#'
+#' Expression always comes from the `"RNA"` assay, whatever the default assay
+#' is, and Seurat v5 layers split by sample are joined on a copy (your object is
+#' not changed). The gene names come from the same assay. When the default
+#' assay is not `"RNA"`, a warning says that `"RNA"` is used.
+#'
+#' Errors while building the two files are logged and recorded as
+#' `build_succeeded = FALSE`; [CyteTypeR()] then stops unless
+#' `require_artifacts = FALSE`.
#'
#' @examples
#' \dontrun{
@@ -73,11 +101,11 @@
#' )
#' }
#'
+#' @seealso [CyteTypeR()] to submit the job, [CleanUpArtifacts()] to delete the
+#' files afterwards.
#' @importFrom logger log_info log_debug log_error log_warn
#' @importFrom dplyr group_by filter slice_head ungroup arrange desc %>%
-#' @importFrom tidyr pivot_longer
#' @importFrom stats setNames
-#' @importFrom Seurat Embeddings GetAssayData AddMetaData
#' @importFrom jsonlite write_json fromJSON
#' @export
PrepareCyteTypeR <- function(obj,
@@ -95,9 +123,11 @@ PrepareCyteTypeR <- function(obj,
obs_duckdb_path = "obs.duckdb"
){
.validate_seurat(obj, group_key, gene_symbols, coordinates_key)
+ # duckdb writes obs.duckdb; check it before the (slow) vars.h5 write.
+ .require_duckdb()
sorted_clusters <- sort(unique(obj[[group_key, drop = TRUE]]))
- cluster_map <- setNames(as.character(1:length(sorted_clusters)), sorted_clusters)
+ cluster_map <- setNames(as.character(seq_along(sorted_clusters)), as.character(sorted_clusters))
.validate_marker_table(marker_table,sorted_clusters)
@@ -126,49 +156,54 @@ PrepareCyteTypeR <- function(obj,
coords <- NULL
visualization_data <- NULL
- tryCatch({
- coords <- Seurat::Embeddings(obj, reduction = coordinates_key)
- log_info("Preparing visualization data...")
- visualization_data <- .sample_visualization_data(obj, group_key, coordinates_key, cluster_map, max_cells_per_group)
- }, error = function(e) {
- log_warn(paste("Could not extract coordinates for reduction '", coordinates_key,
- "'. Continuing without visualization data. Error:", conditionMessage(e)))
- })
+ # The reduction actually used; stays NULL when there is none.
+ used_coordinates_key <- NULL
+ found_coordinates_key <- .resolve_coordinates_key(obj, coordinates_key)
+ if (!is.null(found_coordinates_key)) {
+ visualization <- tryCatch({
+ log_info("Preparing visualization data...")
+ list(
+ coords = .reduction_coordinates(obj, found_coordinates_key),
+ data = .sample_visualization_data(obj, group_key, found_coordinates_key, cluster_map, max_cells_per_group)
+ )
+ }, error = function(e) {
+ log_warn(paste0("Could not extract coordinates for reduction '", found_coordinates_key,
+ "'. Continuing without visualization data. Error: ", conditionMessage(e)))
+ NULL
+ })
+ if (!is.null(visualization)) {
+ coords <- visualization$coords
+ visualization_data <- visualization$data
+ used_coordinates_key <- found_coordinates_key
+ }
+ }
log_info("Calculating expression percentages...")
- expression_percentages <- .calculate_pcent(obj, group_key, cluster_map, pcent_batch_size)
+ expr <- .get_rna_layer(obj, "data")
+ if (is.null(expr)) {
+ stop("The RNA assay has no normalized 'data' layer. Run NormalizeData() first.", call. = FALSE)
+ }
+ expression_percentages <- .calculate_pcent(obj, group_key, cluster_map, pcent_batch_size, expr = expr)
# Prep cluster_map to named list for each "group/cluster"
cluster_map <- as.list(as.character(sorted_clusters))
- names(cluster_map) <- as.character(1:length(sorted_clusters))
+ names(cluster_map) <- as.character(seq_along(sorted_clusters))
# build artefacts for upload
build_succeeded <- FALSE
tryCatch({
log_info("Building vars.h5 from normalized counts (cells x features)...")
- default_assay <- .resolve_seurat_assay_rna(obj)
# Seurat stores expression as features x cells; API expects cells x features (n_obs x n_vars).
- expr_mat <- tryCatch(
- Seurat::GetAssayData(obj, assay = default_assay, layer = "data"),
- error = function(e) Seurat::GetAssayData(obj, assay = default_assay, slot = "data")
- )
- mat <- Matrix::t(expr_mat)
-
- feature_df <- tryCatch(
- as.data.frame(Seurat::GetAssay(obj, default_assay)@meta.features),
- error = function(e) tryCatch(
- as.data.frame(Seurat::GetAssay(obj, default_assay)@meta.data),
- error = function(e2) NULL
- )
- )
- feature_names <- tryCatch(rownames(obj), error = function(e) NULL)
+ mat <- Matrix::t(expr)
+ feature_names <- rownames(expr)
+ feature_df <- .align_feature_metadata(.assay_feature_metadata(obj, "RNA"), feature_names)
raw_mat <- tryCatch(
- tryCatch(
- Seurat::GetAssayData(obj, assay = default_assay, layer = "counts"),
- error = function(e) Seurat::GetAssayData(obj, assay = default_assay, slot = "counts")
- ),
- error = function(e) NULL
+ .align_raw_counts(.get_rna_layer(obj, "counts"), feature_names),
+ error = function(e) {
+ log_warn("Could not read the RNA counts layer, skipping raw counts: {conditionMessage(e)}")
+ NULL
+ }
)
.save_vars_h5(vars_h5_path, mat, raw_mat = raw_mat, feature_df = feature_df, feature_names = feature_names)
log_info("Built vars.h5 successfully.")
@@ -176,7 +211,7 @@ PrepareCyteTypeR <- function(obj,
log_info("Building obs.duckdb (API) from cell metadata (Seurat obj@meta.data)...")
.save_obs_duckdb(obs_duckdb_path, obj@meta.data,
- coordinates = coords, coordinates_key = coordinates_key)
+ coordinates = coords, coordinates_key = used_coordinates_key)
log_info("Built obs.duckdb successfully.")
build_succeeded <- TRUE
@@ -194,15 +229,137 @@ PrepareCyteTypeR <- function(obj,
build_succeeded = build_succeeded,
vars_h5_path = vars_h5_path,
obs_duckdb_path = obs_duckdb_path,
- coordinates_key = coordinates_key
+ coordinates_key = used_coordinates_key
)
- # Store query
- obj@misc$query <- prepped_data
log_info("Preparation complete.")
return(prepped_data)
}
-#'
+
+# Feature metadata in the order of `features`, or NULL when it cannot be aligned.
+.align_feature_metadata <- function(feature_df, features) {
+ if (is.null(feature_df)) {
+ return(NULL)
+ }
+ if (identical(rownames(feature_df), features)) {
+ return(feature_df)
+ }
+ if (!is.null(rownames(feature_df)) && all(features %in% rownames(feature_df))) {
+ return(feature_df[features, , drop = FALSE])
+ }
+ log_warn("The RNA feature metadata does not match the genes of the data layer; writing vars.h5 without it.")
+ NULL
+}
+
+# Raw counts with the genes of the data layer in the same order, or NULL.
+.align_raw_counts <- function(raw_mat, features) {
+ if (is.null(raw_mat)) {
+ return(NULL)
+ }
+ if (identical(rownames(raw_mat), features)) {
+ return(raw_mat)
+ }
+ if (!is.null(rownames(raw_mat)) && all(features %in% rownames(raw_mat))) {
+ return(raw_mat[features, , drop = FALSE])
+ }
+ log_warn("The RNA counts layer does not contain the genes of the data layer; skipping raw counts in vars.h5.")
+ NULL
+}
+
+.has_namespace <- function(package) {
+ requireNamespace(package, quietly = TRUE)
+}
+
+.require_duckdb <- function() {
+ if (!.has_namespace("duckdb")) {
+ stop(
+ "Package 'duckdb' is required to build obs.duckdb. ",
+ "Install it with install.packages(\"duckdb\").",
+ call. = FALSE
+ )
+ }
+ invisible(TRUE)
+}
+
+.JOB_VISIBILITY <- c("private", "org", "public")
+
+.validate_visibility <- function(visibility) {
+ if (is.null(visibility)) {
+ return(invisible(NULL))
+ }
+ if (!.is_string(visibility) || !visibility %in% .JOB_VISIBILITY) {
+ stop(
+ "visibility must be \"private\", \"org\", \"public\" or NULL",
+ call. = FALSE
+ )
+ }
+ invisible(visibility)
+}
+
+# The server gives API keys of users without an organization license the
+# prefix "cyt_p_" (organization keys get "cyt_") and refuses "org" visibility
+# for them when the job is submitted, after the upload. The prefix only
+# suggests a personal key: an organization key's random part can begin with
+# "p_". So warn before uploading, and leave the decision to the server.
+.PERSONAL_API_KEY_PREFIX <- "cyt_p_"
+
+.warn_org_visibility_key <- function(visibility, auth_token) {
+ if (
+ identical(visibility, "org") &&
+ .is_string(auth_token) &&
+ startsWith(auth_token, .PERSONAL_API_KEY_PREFIX)
+ ) {
+ # Logged at once, before the upload starts (a warning() would only be
+ # shown when CyteTypeR() returns). Name the kind of key, never the key.
+ log_warn(paste0(
+ "visibility = \"org\" needs an organization API key, and this key looks ",
+ "like a personal key (cyt_p_...). If it is, the server rejects the job ",
+ "after the upload. Use an organization key, or choose \"private\" or ",
+ "\"public\"."
+ ))
+ }
+ invisible(NULL)
+}
+
+.results_hint <- function(job_id) {
+ paste0("GetResults(job_id = \"", job_id, "\")")
+}
+
+# Warn about clusters that have no result; their cells are marked "Unknown".
+.log_unannotated_clusters <- function(result, cluster_labels) {
+ annotated <- vapply(
+ .normalized_entries(result),
+ function(entry) .scalar_text(.json_get(entry, "clusterId"), ""),
+ character(1)
+ )
+ missing <- setdiff(names(cluster_labels), annotated)
+ if (length(missing) > 0L) {
+ labels <- .map_cluster_labels(missing, cluster_labels)
+ log_warn(paste0(
+ "No annotations received for clusters: ", paste(labels, collapse = ", "),
+ ". Their cells are marked as 'Unknown'."
+ ))
+ }
+ invisible(missing)
+}
+
+.log_result_locations <- function(results_prefix, group_key) {
+ column <- function(field) paste0("obj@meta.data$", results_prefix, "_", field, "_", group_key)
+ results_location <- if (identical(results_prefix, "cytetype")) {
+ "obj@misc$cytetype_results"
+ } else {
+ paste0("obj@misc$", results_prefix, "_results")
+ }
+ log_info(paste0(
+ "Annotation labels: ", column("annotation"), "\n",
+ "Cell Ontology terms: ", column("cellOntologyTerm"), "\n",
+ "Cell Ontology term IDs: ", column("cellOntologyTermID"), "\n",
+ "Cell states: ", column("cellState"), "\n",
+ "Reviewer confidence: ", column("reviewerConfidence"), "\n",
+ "Full results: ", results_location
+ ))
+}
+
#' Submit CyteType Analysis Job
#'
#' @description
@@ -212,13 +369,25 @@ PrepareCyteTypeR <- function(obj,
#'
#' @param obj A Seurat object (will be returned with annotations added).
#' @param prepped_data Named list containing prepared data from `PrepareCyteTypeR()`.
-#' @param study_context Optional character. Biological context for the experimental setup (e.g. organisms, tissues, diseases, developmental stages, single_cell methods, experimental conditions). Default is `NULL`.
-#' @param llm_configs Optional list of LLM configs. Each element must match the LLMModelConfig schema with required `provider` and `name`; either `apiKey` or all AWS credentials (`awsAccessKeyId`, `awsSecretAccessKey`, `awsDefaultRegion`) must be provided. Default is `NULL` (API default model).
+#' @param study_context Optional character. Biological context for the experimental setup (e.g. organisms, tissues, diseases, developmental stages, single-cell methods, experimental conditions). Default is `NULL`.
+#' @param llm_configs Optional list of LLM configs. Each element must match the LLMModelConfig schema with required `provider` and `name`; either `apiKey` or all AWS credentials (`awsAccessKeyId`, `awsSecretAccessKey`, `awsDefaultRegion`) must be provided. `provider` is one of `"anthropic"`, `"bedrock"`, `"deepseek"`, `"fireworks"`, `"google"`, `"groq"`, `"huggingface"`, `"mistral"`, `"nebius"`, `"openai"`, `"openrouter"`, `"together"`, `"vertex"` or `"xai"`. Default is `NULL` (API default model).
#' @param metadata Optional named list. Custom metadata tags for the report header; URL-like values are made clickable in the report. Default is `NULL`.
#' @param n_parallel_clusters Integer. Number of parallel requests to the model (max 50). High values can trigger rate limits. Default is 2.
-#' @param results_prefix Character. Prefix for keys added to `obj@meta.data` and `obj@misc` storing results; the annotation column is `obj@meta.data[[paste(results_prefix, group_key, sep = "_")]]`. Default is `"cytetype"`.
+#' @param results_prefix Character. Prefix for the results added to `obj`. The
+#' factor columns `_annotation_`,
+#' `_cellOntologyTerm_`,
+#' `_cellOntologyTermID_`, `_cellState_`
+#' and `_reviewerConfidence_` are added to `obj@meta.data`,
+#' with three copies under older names: `_` (label),
+#' `_ontologyTerm_` and `_ontologyID_`.
+#' The job details are stored in `obj@misc[[paste0(prefix, "_jobDetails")]]`
+#' and the results as described under Value. Default is `"cytetype"`.
#' @param poll_interval_seconds Integer. How often (seconds) to poll the API for results. Default from options (10).
-#' @param timeout_seconds Integer. Maximum time (seconds) to wait for results before erroring. Default from options (7200).
+#' @param timeout_seconds Integer. Maximum time (seconds) to wait for results.
+#' When it is reached, `CyteTypeR()` stops with an error of class
+#' `cytetype_timeout_error` that names the job ID; the job keeps running on
+#' the server and [GetResults()] retrieves its results later. Default from
+#' options (7200).
#' @param api_url Optional character. CyteType API server origin. If `NULL`,
#' uses `CYTETYPE_API_URL`, the configured R option, or
#' `https://cytetype.nygen.io`.
@@ -235,19 +404,63 @@ PrepareCyteTypeR <- function(obj,
#' @param require_artifacts Logical. If `TRUE`, an error during artifact build or upload stops the run; if `FALSE`, failures are skipped and annotation continues without artifacts. Default is `TRUE`.
#' @param show_progress Logical. Whether to show progress (spinner and cluster status). Set `FALSE` to disable. Default is `TRUE`.
#' @param override_existing_results Logical. If `TRUE`, allow overwriting existing results with the same `results_prefix`. If `FALSE` and results exist, an error is raised. Default is `FALSE`.
+#' @param visibility Optional character. Who can view the report: `"private"`,
+#' `"org"` (your organization; needs an organization API key) or `"public"`
+#' (anyone with the link). Default is `NULL`, which uses the server default
+#' (`"private"`). With `"org"` and an API key that looks like a personal key
+#' (it starts with `cyt_p_`), a warning is logged before the files are
+#' uploaded and the run continues; the server checks the key when the job is
+#' submitted and rejects personal keys.
#'
-#' @return The input Seurat object with added annotation metadata (and artifact uploads when artifacts are built and uploaded).
+#' @return The Seurat object `obj` with the results added. Assign it, for
+#' example `obj <- CyteTypeR(obj, prepped_data)`; the object you pass in is
+#' not changed.
+#' \itemize{
+#' \item `obj@meta.data` gains the factor columns listed under
+#' `results_prefix`. Cells in clusters without a result get `"Unknown"`
+#' (`""` for the cell state) in the first five columns and `NA` in the
+#' three older ones. The reviewer confidence column holds `"High"`,
+#' `"Moderate"`, `"Low"`, or `"Unknown"` when it is missing; its levels
+#' follow that order, and only the levels that occur are kept.
+#' \item `obj@misc[[paste0(prefix, "_jobDetails")]]` holds `job_id`,
+#' `report_url`, `api_url`, `group_key`, `cluster_labels` and, when set,
+#' `visibility`.
+#' \item With the default prefix, `obj@misc$cytetype_results` is a
+#' data.frame with one row per annotated cluster and the columns
+#' `clusterId` (your cluster label), `annotation`, `ontologyTerm`,
+#' `ontologyTermID`, `granularAnnotation`, `cellState`, `justification`,
+#' `supportingMarkers`, `conflictingMarkers`, `missingExpression`,
+#' `unexpectedExpression`, `reviewerConfidence`, `isHeterogeneous` and
+#' `heterogeneityType`. Its attributes `"job_id"` and `"result"` hold the
+#' job ID and the full results in the form returned by [GetResults()].
+#' \item With another prefix, `obj@misc[[paste0(prefix, "_results")]]` is a
+#' list with `job_id` and `result` (the full results), and
+#' `obj@misc$cytetype_results` is left as it is.
+#' }
#'
#' @details
#' The function performs the following workflow:
#' 1. Constructs the analysis query from prepared data
#' 2. Optionally saves the query to a JSON file
-#' 3. Submits the job and records its details in the returned object
+#' 3. Uploads the artifact files and submits the job
#' 4. Polls for job completion with progress updates
#' 5. Retrieves results and integrates annotations into the Seurat object
#'
-#' Job details are stored in the returned Seurat object's `misc` slot for later
-#' retrieval with [GetResults()].
+#' The evidence columns of the results table (`justification`,
+#' `supportingMarkers`, `conflictingMarkers`, `missingExpression` and
+#' `unexpectedExpression`) are filled from the structured output of current
+#' jobs when the stored fields are empty. `supportingMarkers` and
+#' `conflictingMarkers` list genes separated by `"; "`.
+#'
+#' While waiting, network errors are retried until `timeout_seconds` is
+#' reached. Other errors while checking the job stop the run after five in a
+#' row. When the results of a completed job cannot be fetched, the rate limit
+#' and server errors (HTTP 500, 502, 503 and 504) are retried in the same way,
+#' and other errors, such as a deleted report (HTTP 410), stop the run at once.
+#' These errors signal a [cytetype_api_error()] condition. If the run stops or
+#' is interrupted, the job keeps running on the server: retrieve its results
+#' with `GetResults(job_id = "")`, using the job ID printed when the job
+#' was submitted.
#'
#' @examples
#' \dontrun{
@@ -268,7 +481,8 @@ PrepareCyteTypeR <- function(obj,
#' "GEO_Accession" = "GSE123456"
#' ),
#' timeout_seconds = 1800,
-#' poll_interval_seconds = 60
+#' poll_interval_seconds = 60,
+#' visibility = "public"
#' )
#' }
#'
@@ -292,7 +506,8 @@ CyteTypeR <- function(obj,
upload_max_workers = 6L,
require_artifacts = TRUE,
show_progress = TRUE,
- override_existing_results = FALSE
+ override_existing_results = FALSE,
+ visibility = NULL
){
api_url <- .resolve_api_url(api_url)
poll_interval_seconds <- poll_interval_seconds %||% .get_default_poll_interval()
@@ -315,6 +530,8 @@ CyteTypeR <- function(obj,
)
}
+ .validate_visibility(visibility)
+
prepped_data$studyInfo <- study_context %||% ""
prepped_data$infoTags <- metadata %||% list()
prepped_data$nParallelClusters <- n_parallel_clusters
@@ -324,10 +541,10 @@ CyteTypeR <- function(obj,
)
group_key <- prepped_data$group_key
- coordinates_key <- prepped_data$coordinates_key %||% "umap"
.validate_input_data(prepped_data)
auth_token <- .resolve_auth_token(api_url, auth_token)
+ .warn_org_visibility_key(visibility, auth_token)
if (!is.null(llm_configs) && length(llm_configs) > 0L) {
if (is.null(names(llm_configs)) && is.list(llm_configs[[1]])) {
@@ -345,6 +562,9 @@ CyteTypeR <- function(obj,
input_data = prepped_data,
llm_configs = llm_configs
)
+ if (!is.null(visibility)) {
+ query_list$visibility <- visibility
+ }
build_succeeded <- isTRUE(prepped_data$build_succeeded)
@@ -393,42 +613,46 @@ CyteTypeR <- function(obj,
job_id <- .submit_job(query_for_json, api_url, auth_token)
- if (is.na(job_id) || is.null(job_id)) {
+ if (is.null(job_id) || is.na(job_id)) {
stop("Job submission failed: no job ID returned.", call. = FALSE)
}
- obj <- .store_job_details_seurat(obj, job_id, api_url, results_prefix, group_key, prepped_data$clusterLabels)
+ obj <- .store_job_details_seurat(
+ obj, job_id, api_url, results_prefix, group_key, prepped_data$clusterLabels,
+ visibility = visibility
+ )
- # poll for results
- result <- .poll_for_results(
- job_id,
- api_url,
- poll_interval_seconds,
- timeout_seconds,
- auth_token = auth_token,
- show_progress = show_progress
+ # The object holding the job details is lost if the session is interrupted,
+ # so point to the job ID instead.
+ result <- withCallingHandlers(
+ .poll_for_results(
+ job_id,
+ api_url,
+ poll_interval_seconds,
+ timeout_seconds,
+ auth_token = auth_token,
+ show_progress = show_progress
+ ),
+ interrupt = function(cnd) {
+ cat("\n")
+ message(
+ "The CyteType job ", job_id, " keeps running on the server. ",
+ "Retrieve its results later with ", .results_hint(job_id), "."
+ )
+ }
)
+
if (!is.null(result)){
- result <- .normalize_result_annotations(result)
+ result <- .normalize_results(result)
+ results_table <- .transform_results_seurat(result, cluster_map = prepped_data$clusterLabels)
obj <- .store_annotations_seurat(
obj, result, job_id, results_prefix, group_key,
- prepped_data$clusterLabels
+ prepped_data$clusterLabels,
+ results_table = results_table
)
- transformed_results <- .transform_results_seurat(result, cluster_map = prepped_data$clusterLabels)
- obj@misc$cytetype_results <- transformed_results
-
- ann_colname <- paste(results_prefix, group_key, sep = "_")
- onto_colname <- paste(results_prefix, "ontologyTerm", group_key, sep = "_")
- ontoID_colname <- paste(results_prefix, "ontologyID", group_key, sep = "_")
- cluster_ann_map <- setNames(transformed_results$annotation, transformed_results$clusterId)
- cluster_onto_map <- setNames(transformed_results$ontologyTerm, transformed_results$clusterId)
- cluster_onto_id_map <- setNames(transformed_results$ontologyTermID, transformed_results$clusterId)
- cells_group <- as.character(as.vector(obj@meta.data[[group_key]]))
- obj@meta.data[[ann_colname]] <- factor(cluster_ann_map[cells_group])
- obj@meta.data[[onto_colname]] <- factor(cluster_onto_map[cells_group])
- obj@meta.data[[ontoID_colname]] <- factor(cluster_onto_id_map[cells_group])
-
- return(obj)
+ obj <- .add_legacy_annotation_columns(obj, results_table, results_prefix, group_key)
+ .log_unannotated_clusters(result, prepped_data$clusterLabels)
+ .log_result_locations(results_prefix, group_key)
}
return(obj)
@@ -440,7 +664,7 @@ CyteTypeR <- function(obj,
#' If \code{obj} and \code{results_prefix} are given, tries to load from
#' \code{obj@misc} first. If no local result exists but job details are
#' available, fetches the result from the API.
-#' If only \code{job_id} is given, fetches from the API and returns (saves JSON).
+#' If only \code{job_id} is given, fetches the result from the API.
#'
#' @param obj Seurat object that may contain stored results (optional).
#' @param job_id Job ID from submission (optional if \code{obj} + \code{results_prefix} have stored job details).
@@ -451,7 +675,55 @@ CyteTypeR <- function(obj,
#' @param api_url Optional CyteType server origin for standalone or legacy job
#' retrieval. When `NULL`, uses `CYTETYPE_API_URL` or
#' `https://cytetype.nygen.io`.
-#' @return Result list (annotations, summary, etc.), or transformed results when fetching by \code{job_id} only.
+#' @param save_json Logical. When the results are fetched by `job_id`, whether
+#' to save the server's response as `cytetypeR_results_.json` in the
+#' working directory. Default is `TRUE`.
+#' @return Depends on where the results come from:
+#' \itemize{
+#' \item `GetResults(obj)` after a run with the default prefix: the
+#' data.frame in `obj@misc$cytetype_results` (see [CyteTypeR()]).
+#' \item Results stored under another prefix, or fetched for the job stored
+#' in `obj`: a list with `annotations` (one list per annotated cluster
+#' with `clusterId`, the CyteType cluster ID, `annotation`,
+#' `ontologyTerm`, `ontologyTermID`, `granularAnnotation`, `cellState`,
+#' `justification`, `supportingMarkers`, `conflictingMarkers`,
+#' `missingExpression`, `unexpectedExpression`, `reviewerConfidence`,
+#' `isHeterogeneous` and `heterogeneityType`), `raw_annotations` (the
+#' server's per-cluster results, unchanged) and the server's
+#' `studyContext`, `summary`, `semanticOrder`, `clusterCategories` and
+#' `displayLevel`.
+#' \item `GetResults(job_id = ...)`: a data.frame with the same columns as
+#' `obj@misc$cytetype_results`, where `clusterId` is the CyteType cluster
+#' ID. Its attributes `"job_id"` and `"result"` hold the job ID and the
+#' list described above.
+#' \item `NULL`, with a message, when the job has not finished yet or is
+#' not found.
+#' }
+#' @details
+#' Fetching asks the server for the job's status and, when the job has
+#' completed, for its results: two requests, without waiting. A failed job
+#' stops with an error. When the status or the results cannot be fetched,
+#' `GetResults()` signals a [cytetype_api_error()] condition whose
+#' `error_code` holds the server's code when it sent one, such as
+#' `"REPORT_DELETED"`. Problems with the API key signal its subclass
+#' `cytetype_auth_error`.
+#'
+#' `reviewerConfidence` is `"High"`, `"Moderate"` or `"Low"` (`NULL` in the
+#' list and `NA` in the table when missing), `isHeterogeneous` is `TRUE` or
+#' `FALSE` (or missing), and `heterogeneityType` names the kind of
+#' heterogeneity the reviewer found. In the list, `supportingMarkers` and
+#' `conflictingMarkers` are lists of gene names.
+#'
+#' Fetched results are not added to `obj`; R does not modify the object you
+#' pass in.
+#' @examples
+#' \dontrun{
+#' # Results stored in the object by CyteTypeR()
+#' results <- GetResults(annotated_seurat)
+#'
+#' # Results of a job by its ID, without saving the JSON file
+#' results <- GetResults(job_id = "", save_json = FALSE)
+#' }
#' @seealso [CyteTypeR()] for job submission
#' @importFrom jsonlite write_json
#' @export
@@ -459,7 +731,8 @@ GetResults <- function(obj = NULL,
job_id = NULL,
results_prefix = "cytetype",
auth_token = NULL,
- api_url = NULL) {
+ api_url = NULL,
+ save_json = TRUE) {
if (!is.null(obj) && !is.null(results_prefix)) {
results_key <- paste0(results_prefix, "_results")
job_details_key <- paste0(results_prefix, "_jobDetails")
@@ -470,7 +743,8 @@ GetResults <- function(obj = NULL,
!is.data.frame(stored_results) &&
all(c("job_id", "result") %in% names(stored_results))
) {
- return(stored_results$result)
+ # Results stored by earlier versions gain the keys added since.
+ return(.normalize_results(stored_results$result))
}
return(stored_results)
}
@@ -500,24 +774,11 @@ GetResults <- function(obj = NULL,
}
token <- .resolve_auth_token(job_api_url, auth_token)
status_resp <- .make_results_request(job_id, job_api_url, token)
- if (status_resp$status == "completed" && !is.null(status_resp$result)) {
- result <- .normalize_result_annotations(status_resp$result)
- if (!is.null(details$group_key) && !is.null(details$cluster_labels))
- obj <- .store_annotations_seurat(obj, result, job_id, results_prefix, details$group_key, details$cluster_labels)
- if (is.null(obj@misc)) obj@misc <- list()
- obj@misc[[results_key]] <- list(job_id = job_id, result = result)
- return(result)
- }
- if (status_resp$status == "failed") {
- stop(status_resp$message %||% paste("Job", job_id, "failed."), call. = FALSE)
+ result <- .completed_result_or_null(status_resp, job_id, job_api_url)
+ if (is.null(result)) {
+ return(NULL)
}
- if (status_resp$status == "error") {
- stop(
- status_resp$message %||% paste("Could not retrieve job", job_id),
- call. = FALSE
- )
- }
- return(NULL)
+ return(.normalize_results(result))
}
}
if (is.null(job_id)) {
@@ -526,58 +787,88 @@ GetResults <- function(obj = NULL,
}
api_url <- .resolve_api_url(api_url)
auth_token <- .resolve_auth_token(api_url, auth_token)
- response <- .api_response_helper(job_id, api_url, "results", auth_token)
- write_json(response$data,
- path = paste0("cytetypeR_results_", job_id, ".json"),
- auto_unbox = TRUE,
- pretty = TRUE)
- if (!is.null(response$data)) {
- transformed_results <- .transform_results_seurat(response$data)
- return(transformed_results)
- }
- return(response$data)
+ status_resp <- .make_results_request(job_id, api_url, auth_token)
+ data <- .completed_result_or_null(status_resp, job_id, api_url)
+ if (is.null(data)) {
+ return(NULL)
+ }
+ if (isTRUE(save_json)) {
+ json_path <- paste0("cytetypeR_results_", job_id, ".json")
+ write_json(data, path = json_path, auto_unbox = TRUE, pretty = TRUE)
+ log_info("Saved the server's response to {json_path}.")
+ }
+ result <- .normalize_results(data)
+ .results_table_with_attributes(result, job_id)
+}
+
+# The results of a completed job; NULL with a message while the job is still
+# running or cannot be found; an error when the job failed, and a
+# cytetype_api_error when its status or results could not be fetched.
+.completed_result_or_null <- function(status_resp, job_id, api_url) {
+ status <- status_resp[["status"]] %||% "error"
+ if (identical(status, "completed") && !is.null(status_resp[["result"]])) {
+ return(status_resp[["result"]])
+ }
+ condition <- status_resp[["condition"]]
+ if (inherits(condition, "cytetype_api_error")) {
+ stop(condition)
+ }
+ if (identical(status, "failed")) {
+ stop(status_resp[["message"]] %||% paste("Job", job_id, "failed."), call. = FALSE)
+ }
+ if (identical(status, "error")) {
+ stop(cytetype_api_error(
+ message = status_resp[["message"]] %||% paste("Could not retrieve job", job_id),
+ call = status_resp[["error_type"]] %||% "api"
+ ))
+ }
+ report_url <- .url_path(api_url, "report", job_id)
+ if (status %in% c("pending", "processing")) {
+ message(
+ "Job ", job_id, " is still ", status, "; its results are not available yet. ",
+ "Follow it at ", report_url, " and run ", .results_hint(job_id), " again once it has finished."
+ )
+ } else if (identical(status, "not_found")) {
+ message(
+ "Job ", job_id, " was not found on ", api_url, ". ",
+ "Check the job ID and the API URL, or try again shortly after submitting a job."
+ )
+ } else {
+ message("Job ", job_id, " has status '", status, "'; no results are available.")
+ }
+ NULL
}
#' Clean Up Artifacts
#'
#' @description
-#' Cleans up the artifact files after the run.
+#' Deletes the artifact files (`vars.h5` and `obs.duckdb`) that
+#' [PrepareCyteTypeR()] wrote, once [CyteTypeR()] has uploaded them.
#'
#' @param prepped_data Named list containing prepared data from `PrepareCyteTypeR()`.
+#' @return Invisibly, `TRUE` when the artifact files had been built and are now
+#' removed, and `FALSE` when they were never built (nothing is deleted).
+#' @examples
+#' \dontrun{
+#' prepped_data <- PrepareCyteTypeR(pbmc, pbmc.markers)
+#' pbmc <- CyteTypeR(pbmc, prepped_data, study_context = "Human PBMCs")
+#' CleanUpArtifacts(prepped_data)
+#' }
#' @importFrom logger log_info log_warn
#' @export
CleanUpArtifacts <- function(prepped_data) {
- if (isTRUE(prepped_data$build_succeeded)) {
- log_info("Cleaning up artifact files...")
- tryCatch(file.remove(prepped_data$vars_h5_path), error = function(e) NULL)
- log_info("Removed vars.h5 file.")
- tryCatch(file.remove(prepped_data$obs_duckdb_path), error = function(e) NULL)
- log_info("Removed obs.duckdb file.")
- log_info("Artifact files cleaned up successfully.")
- } else {
+ if (!isTRUE(prepped_data$build_succeeded)) {
log_warn("Artifact files not built. No cleanup performed.")
+ return(invisible(FALSE))
+ }
+ log_info("Cleaning up artifact files...")
+ for (path in c(prepped_data$vars_h5_path, prepped_data$obs_duckdb_path)) {
+ if (is.character(path) && length(path) == 1L && file.exists(path)) {
+ unlink(path, force = TRUE)
+ log_info("Removed {path}.")
+ }
}
+ log_info("Artifact files cleaned up successfully.")
+ invisible(TRUE)
}
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/R/errors.R b/R/errors.R
index f16f9e2..0729d12 100644
--- a/R/errors.R
+++ b/R/errors.R
@@ -1,12 +1,49 @@
#' Custom API Error
#'
-#' @param message Error message
-#' @param call Call that generated the error
-#' @return An error object of class cytetype_api_error
+#' @description
+#' Creates the condition that CyteTypeR signals when the status or the results
+#' of a job cannot be fetched: by [GetResults()], and by [CyteTypeR()] when it
+#' stops waiting for a job because of such errors. Errors about the API key are
+#' signalled as `cytetype_auth_error`, a subclass.
+#'
+#' @param message Error message.
+#' @param call Where the error came from: `"network"` when the server could not
+#' be reached, `"api"` for other errors. Default is `NULL`.
+#' @param error_code The error code the server sent, such as
+#' `"REPORT_DELETED"`, or `NULL` when there is none. Default is `NULL`.
+#' @param status_code The HTTP status of the server's response, such as `503`,
+#' or `NULL` when there is none, for example when the server could not be
+#' reached. Default is `NULL`.
+#' @return An error condition of class `cytetype_api_error`, with the elements
+#' `message`, `call`, `error_code` and `status_code`. Printing it shows
+#' `CyteType API Error: `.
+#' @examples
+#' error <- cytetype_api_error(
+#' paste(
+#' "Error while checking job status: HTTP 410 [REPORT_DELETED]",
+#' "This report has been deleted by the owner"
+#' ),
+#' call = "api",
+#' error_code = "REPORT_DELETED",
+#' status_code = 410L
+#' )
+#' print(error)
+#'
+#' # Handle the condition by its class and read the server's code.
+#' tryCatch(
+#' stop(error),
+#' cytetype_api_error = function(e) e$error_code
+#' )
#' @export
-cytetype_api_error <- function(message, call = NULL) {
+cytetype_api_error <- function(message, call = NULL, error_code = NULL,
+ status_code = NULL) {
structure(
- list(message = message, call = call),
+ list(
+ message = message,
+ call = call,
+ error_code = error_code,
+ status_code = status_code
+ ),
class = c("cytetype_api_error", "error", "condition")
)
}
@@ -16,33 +53,99 @@ print.cytetype_api_error <- function(x, ...) {
cat("CyteType API Error: ", x$message, "\n")
}
+# `call` holds "network" or "api", not a call, so report the error as
+# "Error: " rather than "Error in "api": ".
+#' @export
+conditionCall.cytetype_api_error <- function(c) {
+ NULL
+}
+
+# One FastAPI validation error, such as
+# {"loc": ["body", "visibility"], "msg": "Input should be 'private', ..."}.
+.validation_error_text <- function(item) {
+ if (.is_nonblank_string(item)) {
+ return(item)
+ }
+ message <- .json_get(item, "msg")
+ if (!.is_nonblank_string(message)) {
+ return(NULL)
+ }
+ location <- .json_get(item, "loc")
+ parts <- if (is.list(location)) {
+ unlist(Filter(function(part) is.atomic(part) && length(part) == 1L && !is.na(part), location))
+ } else {
+ NULL
+ }
+ if (length(parts) == 0L) {
+ return(message)
+ }
+ paste0(paste(as.character(parts), collapse = "."), ": ", message)
+}
+
+# The error code and message of an error response, or NULL. The server sends
+# {"detail": {"error_code": ..., "message": ...}} for its own errors, including
+# plain HTTP errors raised inside its routes. FastAPI sends {"detail": "..."}
+# for HTTP errors raised elsewhere and, for invalid requests (HTTP 422),
+# {"detail": [{"loc": [...], "msg": ...}, ...]}. error_code is NULL when the
+# server sent none.
.parse_server_error <- function(resp) {
body <- tryCatch(httr2::resp_body_json(resp), error = function(e) NULL)
- if (is.null(body)) return(NULL)
- if ("detail" %in% names(body) && is.list(body$detail)) body <- body$detail
- if (!is.null(body$error_code) && !is.null(body$message)) {
- return(list(error_code = body$error_code, message = body$message))
+ if (is.null(body)) {
+ return(NULL)
+ }
+ detail <- if (.is_json_object(body) && "detail" %in% names(body)) body$detail else body
+ if (.is_json_object(detail)) {
+ message <- .json_get(detail, "message")
+ if (!.is_nonblank_string(message)) {
+ return(NULL)
+ }
+ error_code <- .json_get(detail, "error_code")
+ return(list(
+ error_code = if (.is_nonblank_string(error_code)) error_code else NULL,
+ message = message
+ ))
+ }
+ if (.is_nonblank_string(detail)) {
+ return(list(error_code = NULL, message = detail))
+ }
+ if (.is_json_array(detail)) {
+ messages <- unlist(lapply(detail, .validation_error_text))
+ if (length(messages) > 0L) {
+ return(list(error_code = NULL, message = paste(messages, collapse = "; ")))
+ }
}
NULL
}
+# "[ERROR_CODE] message", or the message alone when there is no code.
+.format_parsed_error <- function(parsed) {
+ if (is.null(parsed$error_code)) {
+ parsed$message
+ } else {
+ paste0("[", parsed$error_code, "] ", parsed$message)
+ }
+}
+
.format_server_error <- function(e) {
if (!inherits(e, "httr2_http") || is.null(e$resp)) return(NULL)
parsed <- .parse_server_error(e$resp)
if (is.null(parsed)) return(NULL)
- paste0("[", parsed$error_code, "] ", parsed$message)
+ .format_parsed_error(parsed)
+}
+
+.rate_limit_message <- function(server_message) {
+ paste0(
+ server_message,
+ "\nThe limits apply to every job, including jobs that use your own LLM ",
+ "through llm_configs. Wait for the limit to reset before retrying."
+ )
}
.stop_if_rate_limited <- function(e) {
if (inherits(e, "httr2_http") && !is.null(e$resp)) {
parsed <- .parse_server_error(e$resp)
- if (!is.null(parsed) && parsed$error_code == "RATE_LIMIT_EXCEEDED") {
- stop(
- parsed$message,
- "\nUse your own LLM API key via llm_configs to bypass free-tier limits, ",
- "or wait before retrying.",
- call. = FALSE
- )
+ if (!is.null(parsed) && identical(parsed$error_code, "RATE_LIMIT_EXCEEDED")) {
+ stop(.rate_limit_message(parsed$message), call. = FALSE)
}
}
}
diff --git a/R/normalization.R b/R/normalization.R
new file mode 100644
index 0000000..084c560
--- /dev/null
+++ b/R/normalization.R
@@ -0,0 +1,472 @@
+# Normalization of per-cluster annotation results.
+#
+# The CyteType server (read-time fill in GET /results), the Python SDK
+# (cytetype/api/normalization.py) and this package apply the same rules, so
+# change all three together:
+#
+# - Jobs since 2026-01-25 store the legacy evidence fields (justification,
+# supportingMarkers, ...) empty and keep the evidence in
+# latest.annotation.fullOutput.cellType. A blank legacy field is filled from
+# there; a non-blank value is never overwritten, so the fill is idempotent.
+# - A result is filled only when fullOutput.cellType is a JSON object (gen-2 and
+# V2 results), never because its legacy fields look empty.
+# - reviewerConfidence, isHeterogeneous and heterogeneityType are added from
+# latest.review. The server does not add these keys; both SDKs do.
+#
+# Results are parsed with simplifyVector = FALSE, so JSON objects are named
+# lists and JSON arrays are unnamed lists. Stored results may be partial or
+# malformed, so every access is type-checked.
+
+.REVIEWER_CONFIDENCE_LEVELS <- c("High", "Moderate", "Low")
+
+.LEGACY_EVIDENCE_FIELDS <- c(
+ "justification",
+ "supportingMarkers",
+ "conflictingMarkers",
+ "missingExpression",
+ "unexpectedExpression"
+)
+
+.SDK_RESULT_KEYS <- c("reviewerConfidence", "isHeterogeneous", "heterogeneityType")
+
+# Columns of obj@misc$cytetype_results. The first eleven are the 0.5.x table;
+# new columns are only ever appended.
+.RESULTS_TABLE_COLUMNS <- c(
+ "clusterId",
+ "annotation",
+ "ontologyTerm",
+ "ontologyTermID",
+ "granularAnnotation",
+ "cellState",
+ .LEGACY_EVIDENCE_FIELDS,
+ .SDK_RESULT_KEYS
+)
+
+# Python's str.strip() removes Unicode whitespace; [\h\v] is the PCRE match.
+.WHITESPACE_PATTERN <- "[\\h\\v]"
+
+.is_json_object <- function(value) {
+ is.list(value) && !is.data.frame(value) && !is.null(names(value))
+}
+
+.is_json_array <- function(value) {
+ is.list(value) && !is.data.frame(value) && is.null(names(value))
+}
+
+.as_json_object <- function(value) {
+ if (.is_json_object(value)) value else stats::setNames(list(), character(0))
+}
+
+# value[[key]] for a JSON object, NULL when the key is absent (dict.get).
+.json_get <- function(value, key) {
+ if (.is_json_object(value) && key %in% names(value)) value[[key]] else NULL
+}
+
+# dict.get(key, default): the default only when the key is absent, so a key
+# stored as null stays NULL.
+.json_get_or <- function(value, key, default) {
+ if (.is_json_object(value) && key %in% names(value)) value[[key]] else default
+}
+
+.is_string <- function(value) {
+ is.character(value) && length(value) == 1L && !is.na(value)
+}
+
+.is_nonblank_string <- function(value) {
+ .is_string(value) &&
+ nzchar(trimws(value, whitespace = .WHITESPACE_PATTERN))
+}
+
+# Blank: NULL (None), an empty or whitespace-only string, or an empty array.
+.is_blank <- function(value) {
+ if (is.null(value)) {
+ return(TRUE)
+ }
+ if (is.character(value) && length(value) == 1L) {
+ return(is.na(value) || !nzchar(trimws(value, whitespace = .WHITESPACE_PATTERN)))
+ }
+ if (.is_json_array(value) || (is.atomic(value) && length(value) == 0L)) {
+ return(length(value) == 0L)
+ }
+ is.atomic(value) && length(value) == 1L && is.na(value)
+}
+
+# The non-blank string items of a JSON array, kept as stored; NULL when the
+# value is not an array.
+.gene_list <- function(value) {
+ if (!.is_json_array(value)) {
+ return(NULL)
+ }
+ Filter(.is_nonblank_string, value)
+}
+
+.gene_text <- function(reasoning, genes) {
+ if (.is_nonblank_string(reasoning)) {
+ return(reasoning)
+ }
+ gene_list <- .gene_list(genes)
+ if (is.null(gene_list)) {
+ return(NULL)
+ }
+ paste(unlist(gene_list, use.names = FALSE), collapse = ", ")
+}
+
+# Each legacy field's value from fullOutput.cellType; NULL means no source.
+.legacy_field_sources <- function(cell_type) {
+ conclusion <- .json_get(cell_type, "conclusion")
+ list(
+ justification = if (.is_string(conclusion)) conclusion else NULL,
+ supportingMarkers = .gene_list(.json_get(cell_type, "keySupportingGenes")),
+ conflictingMarkers = .gene_list(.json_get(cell_type, "unexpectedGenes")),
+ missingExpression = .gene_text(
+ .json_get(cell_type, "missingGenesReasoning"),
+ .json_get(cell_type, "missingGenes")
+ ),
+ unexpectedExpression = .gene_text(
+ .json_get(cell_type, "unexpectedGenesReasoning"),
+ .json_get(cell_type, "unexpectedGenes")
+ )
+ )
+}
+
+.review_fields <- function(latest) {
+ review <- .as_json_object(.json_get(latest, "review"))
+ confidence <- .json_get(review, "confidence")
+ is_heterogeneous <- .json_get(review, "isHeterogeneous")
+ assessment <- .as_json_object(
+ .json_get(.as_json_object(.json_get(review, "fullOutput")), "heterogeneityAssessment")
+ )
+ heterogeneity_type <- .json_get(assessment, "heterogeneityType")
+ list(
+ reviewerConfidence = if (
+ .is_string(confidence) && confidence %in% .REVIEWER_CONFIDENCE_LEVELS
+ ) {
+ confidence
+ } else {
+ NULL
+ },
+ isHeterogeneous = if (
+ is.logical(is_heterogeneous) && length(is_heterogeneous) == 1L &&
+ !is.na(is_heterogeneous)
+ ) {
+ is_heterogeneous
+ } else {
+ NULL
+ },
+ heterogeneityType = if (.is_nonblank_string(heterogeneity_type)) {
+ heterogeneity_type
+ } else {
+ NULL
+ }
+ )
+}
+
+# Fill-only normalization of one annotations entry (fill_cluster_annotation in
+# the Python SDK). `cluster_data` is the cluster's raw result
+# (list(latest = ..., history = ...)) or NULL.
+.fill_cluster_annotation <- function(entry, cluster_data) {
+ normalized <- if (is.list(entry)) entry else list()
+ latest <- .as_json_object(.json_get(.as_json_object(cluster_data), "latest"))
+ annotation <- .as_json_object(.json_get(latest, "annotation"))
+ cell_type <- .json_get(.as_json_object(.json_get(annotation, "fullOutput")), "cellType")
+ # A structured cellType marks gen-2 and V2 results; legacy results have none.
+ if (.is_json_object(cell_type)) {
+ sources <- .legacy_field_sources(cell_type)
+ for (field in names(sources)) {
+ value <- sources[[field]]
+ if (!is.null(value) && .is_blank(.json_get(normalized, field))) {
+ normalized[field] <- list(value)
+ }
+ }
+ }
+ review <- .review_fields(latest)
+ for (key in names(review)) {
+ if (is.null(.json_get(normalized, key))) {
+ normalized[key] <- list(review[[key]])
+ }
+ }
+ normalized
+}
+
+# The normalized annotations entry for one raw cluster result, or NULL when the
+# cluster has no annotation (normalize_cluster_annotation in the Python SDK).
+.normalize_cluster_annotation <- function(cluster_id, cluster_data) {
+ latest <- .as_json_object(.json_get(.as_json_object(cluster_data), "latest"))
+ annotation <- .json_get(latest, "annotation")
+ if (!.is_json_object(annotation)) {
+ return(NULL)
+ }
+ get <- function(key, default) .json_get_or(annotation, key, default)
+ entry <- list(
+ # As in CyteTypeR 0.5.x, a missing cluster ID or term name falls back to
+ # the cluster's key and the term ID, so the existing columns keep their
+ # values. The Python SDK uses the key or "Unknown" only when the key is
+ # absent; stored results always have both fields.
+ clusterId = .json_get(annotation, "clusterId") %||% cluster_id,
+ annotation = get("annotation", "Unknown"),
+ ontologyTerm = .json_get(annotation, "cellOntologyTermName") %||%
+ .json_get(annotation, "cellOntologyTerm") %||% "Unknown",
+ ontologyTermID = get("cellOntologyTerm", "Unknown"),
+ granularAnnotation = get("granularAnnotation", ""),
+ cellState = get("cellState", ""),
+ justification = get("justification", ""),
+ supportingMarkers = get("supportingMarkers", list()),
+ conflictingMarkers = get("conflictingMarkers", list()),
+ missingExpression = get("missingExpression", ""),
+ unexpectedExpression = get("unexpectedExpression", "")
+ )
+ .fill_cluster_annotation(entry, cluster_data)
+}
+
+# How an element of `annotations` is normalized: "raw" is a cluster result from
+# the API (list(latest = ..., history = ...)), "flat" an entry that was already
+# normalized, and "other" anything else, which is kept as is.
+.annotation_element_kind <- function(element, in_object) {
+ if (.is_json_object(element)) {
+ keys <- names(element)
+ if (any(c("latest", "history") %in% keys)) {
+ return("raw")
+ }
+ if (any(c("clusterId", "annotation") %in% keys)) {
+ return("flat")
+ }
+ return(if (in_object) "raw" else "flat")
+ }
+ if (in_object) "raw" else "other"
+}
+
+# Raw cluster results with an annotation, queued by the entry's cluster ID in
+# raw order, so entries with a duplicated clusterId pair with their own result.
+.queue_raw_results <- function(raw_annotations) {
+ queue <- list()
+ raw_ids <- names(raw_annotations)
+ for (index in seq_along(raw_annotations)) {
+ cluster_data <- raw_annotations[[index]]
+ latest <- .as_json_object(.json_get(.as_json_object(cluster_data), "latest"))
+ annotation <- .json_get(latest, "annotation")
+ if (!.is_json_object(annotation)) {
+ next
+ }
+ entry_id <- .json_get_or(annotation, "clusterId", raw_ids[[index]])
+ if (.is_string(entry_id)) {
+ key <- paste0("id:", entry_id)
+ queue[[key]] <- c(queue[[key]], list(cluster_data))
+ }
+ }
+ queue
+}
+
+#' Normalize CyteType results
+#'
+#' Turns the `annotations` of a results response into a list of normalized
+#' entries. Raw cluster results (the API's
+#' `annotations = {cluster_id: {latest, history}}`) become one entry per cluster
+#' that has an annotation, and the raw results are kept unchanged as
+#' `raw_annotations`. Entries that are already normalized (results stored by
+#' earlier versions) are filled from `raw_annotations` when available. Every
+#' entry gets the `reviewerConfidence`, `isHeterogeneous` and
+#' `heterogeneityType` keys.
+#' @noRd
+.normalize_results <- function(result) {
+ if (!.is_json_object(result)) {
+ return(result)
+ }
+ annotations <- .json_get(result, "annotations")
+ if (!is.list(annotations) || is.data.frame(annotations)) {
+ return(result)
+ }
+ in_object <- !is.null(names(annotations))
+ kinds <- vapply(
+ annotations,
+ .annotation_element_kind,
+ character(1),
+ in_object = in_object,
+ USE.NAMES = FALSE
+ )
+ raw_annotations <- .json_get(result, "raw_annotations")
+ if (!.is_json_object(raw_annotations)) {
+ raw_annotations <- if (any(kinds == "raw") && in_object) annotations else NULL
+ }
+ queue <- .queue_raw_results(raw_annotations)
+ ids <- names(annotations)
+
+ normalized <- list()
+ for (index in seq_along(annotations)) {
+ element <- annotations[[index]]
+ key <- if (in_object && !is.na(ids[[index]])) ids[[index]] else ""
+ entry <- switch(
+ kinds[[index]],
+ raw = .normalize_cluster_annotation(key, element),
+ flat = {
+ cluster_id <- .json_get(element, "clusterId")
+ cluster_data <- NULL
+ if (.is_string(cluster_id)) {
+ queue_key <- paste0("id:", cluster_id)
+ matches <- queue[[queue_key]]
+ if (length(matches) > 0L) {
+ cluster_data <- matches[[1L]]
+ queue[[queue_key]] <- matches[-1L]
+ } else {
+ cluster_data <- .json_get(raw_annotations, cluster_id)
+ }
+ }
+ filled <- .fill_cluster_annotation(element, cluster_data)
+ if (is.null(.json_get(filled, "clusterId")) && nzchar(key)) {
+ filled <- c(list(clusterId = key), filled)
+ }
+ filled
+ },
+ element
+ )
+ if (!is.null(entry)) {
+ normalized[[length(normalized) + 1L]] <- entry
+ }
+ }
+
+ result["annotations"] <- list(normalized)
+ if (!is.null(raw_annotations)) {
+ result["raw_annotations"] <- list(raw_annotations)
+ }
+ result
+}
+
+# A scalar text value for a table cell or meta.data column.
+.scalar_text <- function(value, default) {
+ if (is.null(value)) {
+ return(default)
+ }
+ if (is.list(value)) {
+ value <- unlist(
+ Filter(function(item) is.atomic(item) && length(item) == 1L, value),
+ use.names = FALSE
+ )
+ }
+ if (!is.atomic(value)) {
+ return(default)
+ }
+ value <- value[!is.na(value)]
+ if (length(value) == 0L) {
+ return(default)
+ }
+ paste(as.character(value), collapse = ", ")
+}
+
+# A gene list (JSON array, or a string stored by older jobs) as "A; B; C".
+.marker_text <- function(value) {
+ if (is.null(value)) {
+ return("")
+ }
+ items <- if (is.list(value)) value else as.list(value)
+ items <- Filter(
+ function(item) is.atomic(item) && length(item) == 1L && !is.na(item),
+ items
+ )
+ paste(vapply(items, as.character, character(1)), collapse = "; ")
+}
+
+.reviewer_confidence_label <- function(entry) {
+ confidence <- .json_get(entry, "reviewerConfidence")
+ if (.is_string(confidence) && confidence %in% .REVIEWER_CONFIDENCE_LEVELS) {
+ confidence
+ } else {
+ "Unknown"
+ }
+}
+
+# Map CyteType cluster IDs to the user's labels; unmapped IDs are kept.
+.map_cluster_labels <- function(cluster_ids, cluster_map) {
+ map_names <- names(cluster_map)
+ if (is.null(cluster_map) || is.null(map_names) || length(cluster_ids) == 0L) {
+ return(cluster_ids)
+ }
+ vapply(
+ cluster_ids,
+ function(cluster_id) {
+ if (cluster_id %in% map_names) {
+ .scalar_text(cluster_map[[cluster_id]], cluster_id)
+ } else {
+ cluster_id
+ }
+ },
+ character(1),
+ USE.NAMES = FALSE
+ )
+}
+
+.normalized_entries <- function(result) {
+ annotations <- .json_get(result, "annotations")
+ if (!is.list(annotations) || is.data.frame(annotations)) {
+ return(list())
+ }
+ Filter(.is_json_object, annotations)
+}
+
+# Transform CyteType results into the per-cluster table stored in
+# obj@misc$cytetype_results: one row per annotated cluster. `cluster_map` maps
+# CyteType cluster IDs to the user's cluster labels.
+.transform_results_seurat <- function(raw_results = NULL, cluster_map = NULL) {
+ entries <- .normalized_entries(.normalize_results(raw_results))
+ text <- function(key, default) {
+ vapply(
+ entries,
+ function(entry) .scalar_text(.json_get(entry, key), default),
+ character(1),
+ USE.NAMES = FALSE
+ )
+ }
+ markers <- function(key) {
+ vapply(
+ entries,
+ function(entry) .marker_text(.json_get(entry, key)),
+ character(1),
+ USE.NAMES = FALSE
+ )
+ }
+ optional <- function(key, check, missing) {
+ vapply(
+ entries,
+ function(entry) {
+ value <- .json_get(entry, key)
+ if (check(value)) value else missing
+ },
+ missing,
+ USE.NAMES = FALSE
+ )
+ }
+
+ table <- data.frame(
+ clusterId = .map_cluster_labels(text("clusterId", ""), cluster_map),
+ annotation = text("annotation", "Unknown"),
+ ontologyTerm = text("ontologyTerm", "Unknown"),
+ ontologyTermID = text("ontologyTermID", "Unknown"),
+ granularAnnotation = text("granularAnnotation", ""),
+ cellState = text("cellState", ""),
+ justification = text("justification", ""),
+ supportingMarkers = markers("supportingMarkers"),
+ conflictingMarkers = markers("conflictingMarkers"),
+ missingExpression = text("missingExpression", ""),
+ unexpectedExpression = text("unexpectedExpression", ""),
+ reviewerConfidence = optional(
+ "reviewerConfidence",
+ function(value) .is_string(value) && value %in% .REVIEWER_CONFIDENCE_LEVELS,
+ NA_character_
+ ),
+ isHeterogeneous = optional(
+ "isHeterogeneous",
+ function(value) is.logical(value) && length(value) == 1L,
+ NA
+ ),
+ heterogeneityType = optional(
+ "heterogeneityType",
+ .is_nonblank_string,
+ NA_character_
+ ),
+ stringsAsFactors = FALSE
+ )
+
+ ids <- table$clusterId
+ if (length(ids) > 0L && all(nzchar(ids)) && !anyDuplicated(ids)) {
+ rownames(table) <- ids
+ }
+ table
+}
diff --git a/R/schema.R b/R/schema.R
index fdcf8c2..8601d89 100644
--- a/R/schema.R
+++ b/R/schema.R
@@ -1,13 +1,16 @@
# Valid LLM Provider Names
LLM_PROVIDERS <- c("anthropic",
"bedrock",
+ "deepseek",
"fireworks",
"google",
"groq",
"huggingface",
"mistral",
+ "nebius",
"openai",
"openrouter",
+ "together",
"vertex",
"xai"
)
diff --git a/R/seurat_helpers.R b/R/seurat_helpers.R
index d20c085..15a5e81 100644
--- a/R/seurat_helpers.R
+++ b/R/seurat_helpers.R
@@ -1,11 +1,6 @@
-
-#'
-#'
-#'
-#' @importFrom purrr list_rbind map_dfr
-#' @importFrom tibble tibble
#' @importFrom Matrix rowSums
-#'
+NULL
+
# Resolve/validate Seurat RNA assay for RNA-seq workflows (strict).
.resolve_seurat_assay_rna <- function(seurat_obj) {
assays <- tryCatch(names(seurat_obj@assays), error = function(e) character(0))
@@ -29,64 +24,165 @@
"RNA"
}
+# Layers of a Seurat v5 assay whose names start with `layer`, such as
+# "data" or the split layers "data.batch1" and "data.batch2".
+.assay5_layers <- function(assay_obj, layer) {
+ found <- suppressWarnings(SeuratObject::Layers(assay_obj, search = layer))
+ if (is.null(found)) character(0) else found
+}
+
+# One layer ("data" or "counts") of an assay as a features x cells matrix in
+# the object's cell order, or NULL when the assay has no such layer. Split
+# Seurat v5 layers are joined on a local copy; the object itself is unchanged.
+.get_rna_layer <- function(obj, layer = c("data", "counts"), assay = "RNA") {
+ layer <- match.arg(layer)
+ assay_obj <- obj[[assay]]
+ if (methods::is(assay_obj, "Assay")) {
+ # Seurat v3/v4 assays (also in SeuratObject 5) store each layer in a slot.
+ mat <- methods::slot(assay_obj, layer)
+ } else if (methods::is(assay_obj, "StdAssay")) {
+ found <- .assay5_layers(assay_obj, layer)
+ if (length(found) == 0L) {
+ return(NULL)
+ }
+ if (length(found) > 1L || !identical(found, layer)) {
+ assay_obj <- SeuratObject::JoinLayers(assay_obj, layers = layer)
+ }
+ mat <- SeuratObject::LayerData(assay_obj, layer = layer)
+ } else {
+ stop(
+ "Unsupported assay class for '", assay, "': ",
+ paste(class(assay_obj), collapse = "/"),
+ call. = FALSE
+ )
+ }
+ if (is.null(mat) || nrow(mat) == 0L || ncol(mat) == 0L) {
+ return(NULL)
+ }
+ cells <- colnames(obj)
+ if (!identical(colnames(mat), cells)) {
+ if (!is.null(colnames(mat)) && setequal(colnames(mat), cells) &&
+ length(cells) == ncol(mat)) {
+ mat <- mat[, cells, drop = FALSE]
+ } else {
+ stop(
+ "The '", layer, "' layer of the ", assay,
+ " assay does not contain the same cells as the object.",
+ call. = FALSE
+ )
+ }
+ }
+ mat
+}
+
+# Feature metadata of an assay, with feature names as row names.
+.assay_feature_metadata <- function(obj, assay = "RNA") {
+ assay_obj <- obj[[assay]]
+ feature_df <- tryCatch(
+ as.data.frame(assay_obj[[]]),
+ error = function(e) tryCatch(
+ as.data.frame(methods::slot(assay_obj, "meta.features")),
+ error = function(e2) tryCatch(
+ as.data.frame(methods::slot(assay_obj, "meta.data")),
+ error = function(e3) NULL
+ )
+ )
+ )
+ if (is.null(feature_df)) {
+ return(NULL)
+ }
+ features <- rownames(assay_obj)
+ if (.row_names_info(feature_df) < 0L && nrow(feature_df) == length(features)) {
+ rownames(feature_df) <- features
+ }
+ feature_df
+}
+
+# TRUE when every value of a count matrix is a finite whole number. Checked in
+# chunks so a large matrix is not copied at once.
+.is_integer_valued <- function(mat, chunk_size = 1e7) {
+ if (is.null(mat)) {
+ return(FALSE)
+ }
+ if (methods::is(mat, "Matrix")) {
+ if (!methods::.hasSlot(mat, "x")) {
+ return(TRUE)
+ }
+ values <- mat@x
+ } else if (is.matrix(mat)) {
+ values <- mat
+ } else {
+ return(FALSE)
+ }
+ if (is.integer(values) || is.logical(values)) {
+ return(!anyNA(values))
+ }
+ if (!is.numeric(values)) {
+ return(FALSE)
+ }
+ n <- length(values)
+ start <- 1
+ while (start <= n) {
+ end <- min(n, start + chunk_size - 1)
+ chunk <- values[start:end]
+ if (!all(is.finite(chunk)) || any(chunk != floor(chunk))) {
+ return(FALSE)
+ }
+ start <- end + 1
+ }
+ TRUE
+}
+
# Calculate Expression Percentages by Cluster
.calculate_pcent <- function(
seurat_obj,
group_key,
cluster_map,
- batch_size = 2000
+ batch_size = 2000,
+ expr = NULL
){
- gene_names <- rownames(seurat_obj)
- assay <- .resolve_seurat_assay_rna(seurat_obj)
- clusters <- seurat_obj[[group_key]][[group_key]]
+ if (is.null(expr)) {
+ expr <- .get_rna_layer(seurat_obj, "data")
+ }
+ if (is.null(expr)) {
+ stop("The RNA assay has no normalized 'data' layer. Run NormalizeData() first.", call. = FALSE)
+ }
+ gene_names <- rownames(expr)
+ clusters <- as.character(seurat_obj[[group_key, drop = TRUE]])
unique_clusters <- unique(clusters)
+ cluster_ids <- vapply(
+ unique_clusters,
+ function(cluster) as.character(cluster_map[[cluster]]),
+ character(1),
+ USE.NAMES = FALSE
+ )
+ cells_by_cluster <- lapply(unique_clusters, function(cluster) which(clusters == cluster))
- pcent <- list()
- n_genes <- dim(seurat_obj)[1]
+ n_genes <- nrow(expr)
+ batch_size <- max(1L, as.integer(batch_size))
n_batches <- ceiling(n_genes / batch_size)
+ pcent <- matrix(0, nrow = n_genes, ncol = length(unique_clusters))
- # Initialize results list
- results_list <- list()
-
-
- for (batch_idx in 1:n_batches) {
+ for (batch_idx in seq_len(n_batches)) {
start_idx <- (batch_idx - 1) * batch_size + 1
end_idx <- min(batch_idx * batch_size, n_genes)
-
-
- batch_genes <- gene_names[start_idx:end_idx]
- batch_expr_full <- tryCatch(
- Seurat::GetAssayData(seurat_obj, assay = assay, layer = "data"),
- error = function(e) Seurat::GetAssayData(seurat_obj, assay = assay, slot = "data")
- )
- batch_expr_matrix <- batch_expr_full[batch_genes, , drop = FALSE]
-
-
- for (cluster in unique_clusters) {
- cluster_cells <- which(clusters == cluster)
- cluster_matrix <- batch_expr_matrix[, cluster_cells, drop = FALSE]
-
- # Calculate percentage of cluster cells expressing a gene (> 0)
- batch_percentages <- rowSums(cluster_matrix > 0) / ncol(cluster_matrix) * 100
- cluster_idx <- cluster_map[[cluster]]
-
- for (gene in batch_genes){
- if (is.null(results_list[[gene]])) {
- results_list[[gene]] <- list()
- }
- results_list[[gene]][cluster_idx] <- round(batch_percentages, 2)[[gene]]
- }
- }
- # Optional progress reporting
- if (requireNamespace("logger", quietly = TRUE)) {
- logger::log_info("Processed batch {batch_idx}/{n_batches} ({length(batch_genes)} genes)")
+ batch_expr <- expr[start_idx:end_idx, , drop = FALSE]
+ for (k in seq_along(unique_clusters)) {
+ cells <- cells_by_cluster[[k]]
+ expressing <- Matrix::rowSums(batch_expr[, cells, drop = FALSE] > 0)
+ # Percentage of the cluster's cells expressing each gene (> 0).
+ pcent[start_idx:end_idx, k] <- expressing / length(cells) * 100
}
+ logger::log_info("Processed batch {batch_idx}/{n_batches} ({end_idx - start_idx + 1} genes)")
}
- if (requireNamespace("logger", quietly = TRUE)) {
- logger::log_info("Processed {n_batches} batches and a total of {end_idx} genes")
- }
+ logger::log_info("Processed {n_batches} batches and a total of {n_genes} genes")
- return(results_list)
+ pcent <- round(pcent, 2)
+ results_list <- lapply(seq_len(n_genes), function(i) {
+ stats::setNames(as.list(pcent[i, ]), cluster_ids)
+ })
+ names(results_list) <- gene_names
+ results_list
}
# Aggregate Metadata by Cluster
@@ -150,78 +246,193 @@
return(result)
}
+# The reduction used for the report's visualization: `coordinates_key`, then
+# "umap", "tsne" and "pca" (case-insensitive), the first with one row per cell
+# and at least two dimensions. NULL when none qualifies.
+.resolve_coordinates_key <- function(obj, coordinates_key = "umap") {
+ available <- names(obj@reductions)
+ candidates <- unique(c(coordinates_key, "umap", "tsne", "pca"))
+ candidates <- candidates[!is.na(candidates) & nzchar(candidates)]
+ n_cells <- ncol(obj)
+ for (candidate in candidates) {
+ matched <- available[tolower(available) == tolower(candidate)]
+ if (length(matched) == 0L) {
+ next
+ }
+ key <- matched[[1L]]
+ coords <- tryCatch(SeuratObject::Embeddings(obj, reduction = key), error = function(e) NULL)
+ if (is.null(coords)) {
+ next
+ }
+ if (nrow(coords) != n_cells) {
+ log_warn("Coordinates in '{key}' have {nrow(coords)} rows, expected {n_cells}.")
+ next
+ }
+ if (ncol(coords) < 2L) {
+ log_warn("Coordinates in '{key}' have {ncol(coords)} dimension, need at least 2.")
+ next
+ }
+ if (!identical(key, coordinates_key)) {
+ log_info("Using coordinates from '{key}' for visualization (coordinates_key was '{coordinates_key}').")
+ } else {
+ log_info("Using coordinates from '{key}' for visualization.")
+ }
+ return(key)
+ }
+ log_warn(paste0(
+ "No suitable 2D coordinates found in the object's reductions. Looked for: ",
+ paste(candidates, collapse = ", "),
+ " (case-insensitive). Available reductions: ",
+ if (length(available)) paste(available, collapse = ", ") else "none",
+ ". Visualization will be disabled."
+ ))
+ NULL
+}
+
+# Embedding of a reduction (first two dimensions) in the object's cell order.
+.reduction_coordinates <- function(obj, coordinates_key) {
+ coords <- SeuratObject::Embeddings(obj, reduction = coordinates_key)
+ cells <- colnames(obj)
+ if (!is.null(rownames(coords)) && !identical(rownames(coords), cells) &&
+ all(cells %in% rownames(coords))) {
+ coords <- coords[cells, , drop = FALSE]
+ }
+ coords[, seq_len(min(2L, ncol(coords))), drop = FALSE]
+}
+
# Sample visualization coordinates per group (mirrors Python max_cells_per_group).
+# The fixed seed keeps the sample reproducible without changing the caller's
+# random number stream.
.sample_visualization_data <- function(obj, group_key, coordinates_key, cluster_map, max_cells_per_group = 1000) {
- coords <- Embeddings(obj, reduction = coordinates_key)
- if (ncol(coords) > 2) coords <- coords[, 1:2]
- groups <- obj[[group_key]][[group_key]]
- idx_by_group <- split(seq_len(nrow(coords)), as.character(groups))
- set.seed(42)
- sampled_idx <- unlist(lapply(idx_by_group, function(ii) {
- n <- min(max_cells_per_group, length(ii))
- sample(ii, n)
- }), use.names = FALSE)
+ coords <- .reduction_coordinates(obj, coordinates_key)
+ groups <- as.character(obj[[group_key, drop = TRUE]])
+ idx_by_group <- split(seq_len(nrow(coords)), groups)
+ sampled_idx <- withr::with_seed(42, {
+ unlist(lapply(idx_by_group, function(ii) {
+ n <- min(max_cells_per_group, length(ii))
+ # Index with sample.int: sample(ii, n) samples 1:ii when ii is one number.
+ ii[sample.int(length(ii), n)]
+ }), use.names = FALSE)
+ })
coords_sampled <- coords[sampled_idx, , drop = FALSE]
- clusters_sampled <- as.character(groups[sampled_idx])
+ clusters_sampled <- groups[sampled_idx]
cluster_ids <- as.character(cluster_map[clusters_sampled])
coordinates_list <- lapply(seq_len(nrow(coords_sampled)), function(i) as.numeric(coords_sampled[i, ]))
list(coordinates = coordinates_list, clusters = cluster_ids)
}
-# Validate Gene Symbols in Seurat Object
-.validate_gene_symbols <- function(seurat_obj, gene_symbols){
- gene_values <- tryCatch({
+# TRUE for values that look like gene identifiers rather than gene symbols
+# (mirrors _is_gene_id_like in the Python SDK): Ensembl gene IDs with an
+# optional version suffix, RefSeq accessions, numeric (Entrez) IDs, and long
+# dotted or underscored IDs.
+.is_gene_id_like <- function(values) {
+ values <- trimws(as.character(values), whitespace = .WHITESPACE_PATTERN)
+ valid <- !is.na(values) & nzchar(values)
+ values[!valid] <- ""
+ ensembl <- grepl("^ENS[A-Z]*G[0-9]{11}(\\.[0-9]+)?$", values, ignore.case = TRUE, perl = TRUE)
+ refseq <- grepl("^[NX][MR]_[0-9]+$", values, perl = TRUE)
+ numeric_id <- grepl("^[0-9]+(\\.0)?$", values, perl = TRUE)
+ long_id <- grepl("^[A-Z0-9]+[._][A-Z0-9._]+$", values, perl = TRUE) & nchar(values) > 10L
+ valid & (ensembl | refseq | numeric_id | long_id)
+}
- assay_name <- .resolve_seurat_assay_rna(seurat_obj)
- assay_obj <- tryCatch(seurat_obj[[assay_name]], error = function(e) NULL)
- meta_features <- tryCatch(
- assay_obj@meta.features,
- error = function(e) tryCatch(assay_obj@meta.data, error = function(e2) NULL)
- )
+# Percentage of values that look like gene IDs (100 for no values, as in the
+# Python SDK). Unlike the Python SDK, every value is checked, not a sample.
+.id_like_percentage <- function(values) {
+ values <- as.character(values)
+ if (length(values) == 0L) {
+ return(100)
+ }
+ 100 * mean(.is_gene_id_like(values))
+}
+
+.id_like_examples <- function(values, n = 3L) {
+ values <- as.character(values)
+ values <- values[!is.na(values)]
+ examples <- utils::head(values[.is_gene_id_like(values)], n)
+ paste0("'", examples, "'", collapse = ", ")
+}
+
+# Validate Gene Symbols in Seurat Object (warns only).
+.validate_gene_symbols <- function(seurat_obj, gene_symbols, assay = "RNA"){
+ gene_values <- tryCatch({
+ meta_features <- .assay_feature_metadata(seurat_obj, assay)
if (is.null(meta_features)) stop("No feature metadata found on assay")
symbols <- meta_features[[gene_symbols]]
- if (is.null(symbols) || all(is.na(symbols)) || length(symbols) == 0) {
+ if (is.null(symbols) || length(symbols) == 0 || all(is.na(symbols))) {
stop("No valid gene symbols found in meta.features")
}
- return(symbols)
+ symbols
}, error = function(e) {
- # Fallback to rownames
+ # Fallback to the RNA assay's feature names
message("Gene symbols not found in meta.features, using rownames")
- return(rownames(seurat_obj))
+ rownames(seurat_obj[[assay]])
})
- if (length(gene_values) == 0){
+ gene_values <- as.character(gene_values)
+ gene_values <- gene_values[!is.na(gene_values)]
+ if (length(gene_values) == 0L) {
log_warn("Gene values not found or are NA values")
+ return(invisible(NULL))
}
-
- id_pattern <- "ENS[A-Z]*G[0-9]{11}$|^[NX][MR]_[0-9]+$"
- matching_genes <- gene_values[grepl(id_pattern, gene_values)]
-
- if (length(matching_genes)/length(gene_values) > 0.5){
- log_warn("More than half of the gene values appears to be gene ids. The annotation might not be accurate. Consider using a column that contains human-readable gene symbols (e.g., 'TSPAN6', 'DPM1', 'SCYL3') instead of database identifiers.")
+ pct <- .id_like_percentage(gene_values)
+
+ if (pct > 50) {
+ log_warn(paste0(
+ "More than half of the gene values (", format(round(pct, 1), nsmall = 1),
+ "%) appear to be gene IDs (e.g., ", .id_like_examples(gene_values), "). ",
+ "The annotation might not be accurate. Consider using a column that contains ",
+ "human-readable gene symbols (e.g., 'TSPAN6', 'DPM1', 'SCYL3') instead of database identifiers."
+ ))
+ } else if (pct > 20) {
+ log_warn(paste0(
+ format(round(pct, 1), nsmall = 1), "% of the gene values look like gene IDs. ",
+ "Please verify that they are gene symbols rather than gene identifiers."
+ ))
}
+ invisible(NULL)
+}
+# Stop early when cells have no cluster label.
+.check_group_labels <- function(groups, group_key) {
+ n_na <- sum(is.na(groups))
+ if (n_na == 0L) {
+ return(invisible(TRUE))
+ }
+ n_cells <- length(groups)
+ if (n_na == n_cells) {
+ stop(
+ "All ", n_cells, " cells have NA values in '", group_key,
+ "'. Cannot prepare the data for annotation.",
+ call. = FALSE
+ )
+ }
+ stop(
+ n_na, " cells (", format(round(100 * n_na / n_cells, 1), nsmall = 1),
+ "%) have NA values in '", group_key, "'. Assign these cells to a cluster, ",
+ "or remove them (for example with subset()), before calling PrepareCyteTypeR().",
+ call. = FALSE
+ )
}
# Validate Seurat Object Structure
-.validate_seurat <- function(seurat_obj, group_key, gene_symbols, coordinates_key){
+.validate_seurat <- function(seurat_obj, group_key, gene_symbols, coordinates_key = NULL){
if (!inherits(seurat_obj, "Seurat")){
stop("Please provide a Seurat Object")
}
- .validate_gene_symbols(seurat_obj,gene_symbols)
+ .resolve_seurat_assay_rna(seurat_obj)
if (!(group_key %in% names(seurat_obj@meta.data))){
stop("Please provide a valid group key that exists in the Seurat object's meta.data.")
}
+ .check_group_labels(seurat_obj@meta.data[[group_key]], group_key)
- if (!(coordinates_key %in% names(seurat_obj@reductions))){
- log_info("Coordinates key {coordinates_key} not found in reductions.")
- }
+ .validate_gene_symbols(seurat_obj, gene_symbols)
}
@@ -243,17 +454,23 @@
}
else{log_info("cluster column not found in marker table, rename your column to 'cluster' if its name is different" )}
- # gene symbol column exist?
- # has gene symbols?
+ # Gene symbols rather than gene IDs? Warn only.
if ("gene" %in% table_cols){
- gene_sym_pattern <- "^[A-Z]([A-Z0-9-]+|[a-z0-9-]+)$"
- if (is.null(grepl(gene_sym_pattern,marker_table$gene))){
- log_warn("Not gene symbols?")
+ genes <- as.character(marker_table$gene)
+ genes <- genes[!is.na(genes)]
+ pct <- if (length(genes) > 0L) .id_like_percentage(genes) else 0
+ if (pct > 50) {
+ log_warn(paste0(
+ format(round(pct, 1), nsmall = 1), "% of the genes in the marker table look like gene IDs (e.g., ",
+ .id_like_examples(genes), "). CyteType expects gene symbols such as 'TSPAN6' or 'DPM1', ",
+ "so the annotation might not be accurate."
+ ))
+ } else {
+ log_info(paste("Found gene symbols", cli::symbol$tick))
}
- else {log_info(paste("Found gene symbols", cli::symbol$tick))}
}
# cluster labels == seurat obj labels?
- if (setequal(sorted_clusters, as.vector(marker_table$cluster))){
+ if (setequal(as.character(sorted_clusters), as.character(marker_table$cluster))){
log_info(paste("Correct cluster labels", cli::symbol$tick))
}
else{
@@ -263,111 +480,130 @@
}
# Store job details in Seurat object misc (no auth_token in stored list).
-.store_job_details_seurat <- function(obj, job_id, api_url, results_prefix, group_key = NULL, cluster_labels = NULL) {
+.store_job_details_seurat <- function(obj, job_id, api_url, results_prefix, group_key = NULL,
+ cluster_labels = NULL, visibility = NULL) {
api_url <- .validate_api_url(api_url)
if (is.null(obj@misc)) obj@misc <- list()
- obj@misc[[paste0(results_prefix, "_jobDetails")]] <- list(
+ job_details <- list(
job_id = job_id,
report_url = .url_path(api_url, "report", job_id),
api_url = api_url,
group_key = group_key,
cluster_labels = cluster_labels
)
+ if (!is.null(visibility)) {
+ job_details$visibility <- visibility
+ }
+ obj@misc[[paste0(results_prefix, "_jobDetails")]] <- job_details
obj
}
-# Normalize API result annotations to a flat list (handles dict or list format).
+# Normalize API result annotations (kept for callers of the 0.5.x helper).
.normalize_result_annotations <- function(result) {
- raw <- result$annotations
- if (is.null(raw) || !is.list(raw)) return(result)
- items <- if (length(names(raw)) > 0L && !identical(names(raw), as.character(seq_along(raw)))) {
- lapply(seq_along(raw), function(i) {
- x <- raw[[i]]
- ann <- if (is.list(x$latest) && is.list(x$latest$annotation)) x$latest$annotation else x
- list(
- clusterId = ann$clusterId %||% names(raw)[i] %||% "",
- annotation = ann$annotation %||% "Unknown",
- ontologyTerm = ann$cellOntologyTermName %||% ann$cellOntologyTerm %||% "Unknown",
- ontologyTermID = ann$cellOntologyTerm %||% "Unknown",
- cellState = ann$cellState %||% "",
- granularAnnotation = ann$granularAnnotation %||% ""
- )
- })
- } else {
- lapply(raw, function(x) {
- ann <- if (is.list(x$latest) && is.list(x$latest$annotation)) x$latest$annotation else x
- list(
- clusterId = ann$clusterId %||% "",
- annotation = ann$annotation %||% "Unknown",
- ontologyTerm = ann$cellOntologyTermName %||% ann$cellOntologyTerm %||% ann$ontologyTerm %||% "Unknown",
- ontologyTermID = ann$cellOntologyTerm %||% ann$ontologyTermID %||% "Unknown",
- cellState = ann$cellState %||% "",
- granularAnnotation = ann$granularAnnotation %||% ""
- )
- })
- }
- result$annotations <- items
- result
+ .normalize_results(result)
+}
+
+# The per-cluster results table with the job ID and the normalized results
+# attached as attributes.
+.results_table_with_attributes <- function(result, job_id, cluster_map = NULL) {
+ table <- .transform_results_seurat(result, cluster_map = cluster_map)
+ attr(table, "job_id") <- job_id
+ attr(table, "result") <- result
+ table
}
-# Add annotation columns to obj@meta.data and store full result in obj@misc.
-.store_annotations_seurat <- function(obj, result, job_id, results_prefix, group_key, cluster_labels) {
- ann_list <- result$annotations
- if (is.null(ann_list) || length(ann_list) == 0L) return(obj)
- orig_to_id <- setNames(names(cluster_labels), as.character(cluster_labels))
+# Add the annotation columns to obj@meta.data and store the results in obj@misc.
+# `result` holds normalized annotations (see .normalize_results()).
+#
+# With the default prefix, obj@misc$cytetype_results is the per-cluster table
+# (a data.frame) with the job ID and the full results as the attributes
+# "job_id" and "result". Other prefixes store list(job_id, result) in
+# obj@misc[[paste0(prefix, "_results")]]; obj@misc$cytetype_results is then
+# left as it is.
+.store_annotations_seurat <- function(obj, result, job_id, results_prefix, group_key, cluster_labels,
+ results_table = NULL) {
+ entries <- .normalized_entries(result)
+ label_ids <- names(cluster_labels)
+ label_values <- vapply(
+ cluster_labels,
+ function(label) .scalar_text(label, NA_character_),
+ character(1),
+ USE.NAMES = FALSE
+ )
+ orig_to_id <- stats::setNames(label_ids, label_values)
cells_group <- as.character(obj[[group_key, drop = TRUE]])
- clusters_per_cell <- as.character(orig_to_id[cells_group])
- .add_col <- function(field_key, col_name, default = "") {
- field_map <- setNames(
- vapply(ann_list, function(a) as.character(a[[field_key]] %||% default), character(1)),
- vapply(ann_list, function(a) as.character(a$clusterId %||% ""), character(1))
+ cell_ids <- unname(orig_to_id[cells_group])
+
+ entry_ids <- vapply(
+ entries,
+ function(entry) .scalar_text(.json_get(entry, "clusterId"), ""),
+ character(1),
+ USE.NAMES = FALSE
+ )
+ # As in the Python SDK, the last entry for a cluster ID wins.
+ keep <- !duplicated(entry_ids, fromLast = TRUE)
+ per_cell <- function(values, default) {
+ lookup <- stats::setNames(values[keep], entry_ids[keep])
+ out <- unname(lookup[cell_ids])
+ out[is.na(out)] <- default
+ out
+ }
+ text <- function(key, default) {
+ vapply(
+ entries,
+ function(entry) .scalar_text(.json_get(entry, key), default),
+ character(1),
+ USE.NAMES = FALSE
)
- vals <- as.character(field_map[clusters_per_cell])
- vals[is.na(vals)] <- default
- obj@meta.data[[col_name]] <<- factor(vals)
- NULL
}
+
prefix <- results_prefix
gk <- group_key
- .add_col("annotation", paste0(prefix, "_annotation_", gk), "Unknown")
- .add_col("ontologyTerm", paste0(prefix, "_cellOntologyTerm_", gk), "Unknown")
- .add_col("ontologyTermID", paste0(prefix, "_cellOntologyTermID_", gk), "Unknown")
- .add_col("cellState", paste0(prefix, "_cellState_", gk), "")
+ obj@meta.data[[paste0(prefix, "_annotation_", gk)]] <-
+ factor(per_cell(text("annotation", "Unknown"), "Unknown"))
+ obj@meta.data[[paste0(prefix, "_cellOntologyTerm_", gk)]] <-
+ factor(per_cell(text("ontologyTerm", "Unknown"), "Unknown"))
+ obj@meta.data[[paste0(prefix, "_cellOntologyTermID_", gk)]] <-
+ factor(per_cell(text("ontologyTermID", "Unknown"), "Unknown"))
+ obj@meta.data[[paste0(prefix, "_cellState_", gk)]] <-
+ factor(per_cell(text("cellState", ""), ""))
+ confidence <- per_cell(
+ vapply(entries, .reviewer_confidence_label, character(1), USE.NAMES = FALSE),
+ "Unknown"
+ )
+ # Ordered High, Moderate, Low, Unknown; only levels that occur are kept.
+ obj@meta.data[[paste0(prefix, "_reviewerConfidence_", gk)]] <- factor(
+ confidence,
+ levels = intersect(c(.REVIEWER_CONFIDENCE_LEVELS, "Unknown"), confidence)
+ )
+
if (is.null(obj@misc)) obj@misc <- list()
- obj@misc[[paste0(results_prefix, "_results")]] <- list(job_id = job_id, result = result)
+ if (identical(results_prefix, "cytetype")) {
+ if (is.null(results_table)) {
+ results_table <- .transform_results_seurat(result, cluster_map = cluster_labels)
+ }
+ attr(results_table, "job_id") <- job_id
+ attr(results_table, "result") <- result
+ obj@misc[["cytetype_results"]] <- results_table
+ } else {
+ obj@misc[[paste0(results_prefix, "_results")]] <- list(job_id = job_id, result = result)
+ }
obj
}
-# Transform CyteType Results for Seurat Integration (handles raw or normalized annotations).
-.transform_results_seurat <- function(raw_results = NULL, job_id = NULL, filename = NULL, cluster_map = NULL){
- raw_annotations <- raw_results$annotations
-
- df <- map_dfr(raw_annotations, ~ {
- ann <- if (is.character(.x$annotation %||% NULL)) .x else .x$latest$annotation
- if (!is.list(ann)) ann <- list()
- data.frame(
- clusterId = as.character(cluster_map[ann$clusterId] %||% ann$clusterId %||% ""),
- annotation = as.character(ann$annotation %||% 'Unknown'),
- ontologyTerm = as.character(ann$cellOntologyTermName %||% ann$cellOntologyTerm %||% ann$ontologyTerm %||% 'Unknown'),
- ontologyTermID = as.character(ann$cellOntologyTerm %||% ann$ontologyTermID %||% 'Unknown'),
- granularAnnotation = as.character(ann$granularAnnotation %||% ''),
- cellState = as.character(ann$cellState %||% ''),
- justification = as.character(ann$justification %||% ''),
- supportingMarkers = paste(as.character(ann$supportingMarkers %||% ''), collapse = "; "),
- conflictingMarkers = paste(as.character(ann$conflictingMarkers %||% ''), collapse = "; "),
- missingExpression = as.character(ann$missingExpression %||% ''),
- unexpectedExpression = as.character(ann$unexpectedExpression %||% ''),
- stringsAsFactors = FALSE
- )
- })
-
- rownames(df) <- df$clusterId
-
- #cluster categories
- raw_cats <- raw_results$clusterCategories
-
- # df$clusterCategories
-
- return(df)
+# The three columns kept under the names used before 0.4.0. They hold the
+# label, the Cell Ontology term and its ID of each cell's cluster, and NA for
+# cells in clusters without a result.
+.add_legacy_annotation_columns <- function(obj, results_table, results_prefix, group_key) {
+ ann_colname <- paste(results_prefix, group_key, sep = "_")
+ onto_colname <- paste(results_prefix, "ontologyTerm", group_key, sep = "_")
+ onto_id_colname <- paste(results_prefix, "ontologyID", group_key, sep = "_")
+ cluster_ann_map <- stats::setNames(results_table$annotation, results_table$clusterId)
+ cluster_onto_map <- stats::setNames(results_table$ontologyTerm, results_table$clusterId)
+ cluster_onto_id_map <- stats::setNames(results_table$ontologyTermID, results_table$clusterId)
+ cells_group <- as.character(as.vector(obj@meta.data[[group_key]]))
+ obj@meta.data[[ann_colname]] <- factor(unname(cluster_ann_map[cells_group]))
+ obj@meta.data[[onto_colname]] <- factor(unname(cluster_onto_map[cells_group]))
+ obj@meta.data[[onto_id_colname]] <- factor(unname(cluster_onto_id_map[cells_group]))
+ obj
}
-
diff --git a/README.md b/README.md
index e0ce5ab..34c17b8 100644
--- a/README.md
+++ b/README.md
@@ -5,9 +5,9 @@
- 
+ 
- 
+ 
@@ -18,7 +18,7 @@ For AnnData workflows, use [CyteType](https://github.com/NygenAnalytics/CyteType
> [!IMPORTANT]
> Already installed CyteTypeR? Open R and run `devtools::install_github("NygenAnalytics/CyteTypeR", force = TRUE)` to update to the latest version before you start.
>
-> CyteType requires an API key. API use is free for academic and non-commercial research. Commercial API use requires a [license](#license).
+> CyteType requires an API key. Use is free for academic and non-commercial research. Commercial use requires a [license](#license).
## Why CyteTypeR?
@@ -33,6 +33,8 @@ install.packages("devtools")
devtools::install_github("NygenAnalytics/CyteTypeR")
```
+CyteTypeR needs R 4.2 or newer. See [Installation](https://docs.nygen.io/CyteType/getting-started/installation/) for the dependencies and for updating.
+
### 2. Set up your API key
```R
@@ -48,6 +50,8 @@ Already have an API key? Save and validate it locally once:
LoginCyteTypeR()
```
+See [Sign in and API keys](https://docs.nygen.io/CyteType/getting-started/sign-in/) for remote servers and automation.
+
### 2.1. (Optional) Install and use the CLI
Install the `cytetyper` command into the active R environment:
@@ -60,11 +64,14 @@ Then authenticate directly from the terminal:
```sh
cytetyper setup
+cytetyper login # save an existing key; it can also be piped in
cytetyper dashboard
cytetyper view
cytetyper logout
```
+See the [command-line reference](https://docs.nygen.io/CyteType/reference/cli/).
+
### 3. Annotate with Seurat
```R
@@ -90,7 +97,9 @@ annotated_seurat <- CyteTypeR(
)
```
-[Read the complete Seurat workflow](docs/get-started.md).
+Every cell gets its cluster's label, Cell Ontology term, cell state and reviewer confidence as columns of `annotated_seurat@meta.data`, and `annotated_seurat@misc$cytetype_results` has one row per cluster with the evidence behind each label.
+
+[Read the complete Seurat workflow](https://docs.nygen.io/CyteType/getting-started/quickstart-r/).
## What You Get
@@ -122,8 +131,13 @@ Methods and full results are in the [preprint](https://www.biorxiv.org/content/1
## Resources
-- 📖 [Get Started](docs/get-started.md): Prepare a Seurat object and run an annotation.
-- ⚙️ [Configuration](docs/configurations.md): Configure API access, LLM providers, and runtime settings.
+- 📖 [Documentation](https://docs.nygen.io/CyteType/): Guides and references for the R and Python clients.
+- 🚀 [Quickstart (R)](https://docs.nygen.io/CyteType/getting-started/quickstart-r/): Prepare a Seurat object and run an annotation.
+- 🧪 [Prepare your data](https://docs.nygen.io/CyteType/guides/prepare-data/): What CyteTypeR needs from your Seurat object and marker table.
+- ⚙️ [Run, monitor and rerun jobs](https://docs.nygen.io/CyteType/guides/running-jobs/) and [use your own LLM](https://docs.nygen.io/CyteType/guides/llm-configuration/): Runtime settings and LLM providers.
+- 📋 [Results in AnnData and Seurat](https://docs.nygen.io/CyteType/results/results-in-your-data/): The columns and tables CyteTypeR adds to your object.
+- 📚 [R function reference](https://docs.nygen.io/CyteType/reference/r-api/): Every exported function and its arguments.
+- 🛠️ [Troubleshooting](https://docs.nygen.io/CyteType/support/troubleshooting/): Fixes for sign-in, data preparation, upload and job problems.
- 🧬 [Example Datasets and Reports](docs/examples.md): Browse atlas-scale analyses.
- 🐍 [Python client](https://github.com/NygenAnalytics/CyteType): Use CyteType with AnnData and Scanpy.
- 🎥 [Introduction video](https://vimeo.com/nygen/cytetype): Watch a quick overview of CyteType.
@@ -146,6 +160,13 @@ Methods and full results are in the [preprint](https://www.biorxiv.org/content/1
## License
-CyteTypeR package code is available under the [MIT License](LICENSE.md).
+The CyteTypeR package is open source software released under the [BSD 3-Clause License](LICENSE.md) and maintained by [Nygen](https://nygen.io).
+
+### CyteType service terms
+
+Annotation runs on the CyteType service, which requires an API key.
+
+- **Academic and non-commercial use** is free within the [usage limits](https://docs.nygen.io/CyteType/platform/limits/). Data generated under academic use is licensed under [CC BY-NC-SA 4.0](https://creativecommons.org/licenses/by-nc-sa/4.0/).
+- **Commercial use and higher limits** require a commercial license from Nygen Analytics AB, which includes commercial rights to the generated data.
-CyteType API access is free for academic and non-commercial research. Commercial API use and higher-rate access require a separate license from Nygen Analytics AB. Contact [contact@nygen.io](mailto:contact@nygen.io).
+For licensing, contact [contact@nygen.io](mailto:contact@nygen.io).
diff --git a/docs/configurations.md b/docs/configurations.md
index 4bd5566..0edf565 100644
--- a/docs/configurations.md
+++ b/docs/configurations.md
@@ -1,112 +1,8 @@
-## API configuration
+# Configuration
-CyteTypeR uses `https://cytetype.nygen.io` by default. An explicit `api_url` takes precedence over the `CYTETYPE_API_URL` environment variable and the package default.
-
-For normal production use, no URL configuration is required:
-
-```r
-SetupCyteTypeR()
-```
-
-### Development API
-
-Replace `` with the development URL supplied for your environment:
-
-```r
-SetupCyteTypeR(api_url = "")
-```
-
-```sh
-export CYTETYPE_API_URL=""
-cytetyper setup
-```
-
-You can also configure one command:
-
-```sh
-cytetyper setup --api-url ""
-```
-
-Remote API URLs must use HTTPS. Plain HTTP is accepted only for `localhost` and `127.0.0.1`.
-
-## Authentication
-
-`SetupCyteTypeR()` validates matching saved credentials or opens the browser-based email and one-time-code flow when none are available. If the saved key is invalid or inactive, use `SetupCyteTypeR(force = TRUE)` or `cytetyper setup --force` to authenticate with a new key. `LoginCyteTypeR()` validates and saves an existing API key through a hidden prompt.
-
-```r
-SetupCyteTypeR()
-LoginCyteTypeR()
-LogoutCyteTypeR()
-```
-
-```sh
-cytetyper setup
-cytetyper login
-cytetyper logout
-```
-
-CyteTypeR and the Python client share the same local credentials. The active credentials are tied to the API URL used during sign-in.
-
-## LLM configurations
-
-An external LLM key is optional. Without `llm_configs`, CyteType uses its managed default model.
-
-Store provider keys in environment variables instead of writing them directly in scripts:
-
-```r
-llm_configs <- list(
- provider = "openai",
- name = "gpt-4o-mini",
- apiKey = Sys.getenv("OPENAI_API_KEY"),
- baseUrl = "https://api.openai.com/v1",
- modelSettings = list(temperature = 0.0, max_tokens = 4096L)
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata,
- llm_configs = llm_configs,
- save_query = FALSE
-)
-```
-
-Set `save_query = FALSE` whenever `llm_configs` contains provider credentials. Current query-file output includes the complete LLM configuration.
-
-Supported provider names in this package version are:
-
-```r
-c(
- "anthropic", "bedrock", "fireworks", "google", "groq",
- "huggingface", "mistral", "openai", "openrouter", "vertex", "xai"
-)
-```
-
-### Multiple models
-
-Pass an unnamed list of model configuration lists:
-
-```r
-llm_configs <- list(
- list(
- provider = "openai",
- name = "gpt-4o-mini",
- apiKey = Sys.getenv("OPENAI_API_KEY")
- ),
- list(
- provider = "anthropic",
- name = "claude-sonnet-4-20250514",
- apiKey = Sys.getenv("ANTHROPIC_API_KEY"),
- allowFallback = TRUE
- )
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- llm_configs = llm_configs,
- save_query = FALSE
-)
-```
+This page has moved to the CyteType documentation, which covers the R and Python clients together:
+- [Sign in and API keys](https://docs.nygen.io/CyteType/getting-started/sign-in/): `SetupCyteTypeR()`, `LoginCyteTypeR()`, the `cytetyper` command and development servers (`api_url` and `CYTETYPE_API_URL`).
+- [Use your own LLM](https://docs.nygen.io/CyteType/guides/llm-configuration/): `llm_configs`, the supported providers and multiple models.
+- [Run, monitor and rerun jobs](https://docs.nygen.io/CyteType/guides/running-jobs/): polling, timeouts, visibility and retrieving results later.
+- [Command-line reference](https://docs.nygen.io/CyteType/reference/cli/) and [R function reference](https://docs.nygen.io/CyteType/reference/r-api/).
diff --git a/docs/get-started.md b/docs/get-started.md
index 327a9f6..6d216a4 100644
--- a/docs/get-started.md
+++ b/docs/get-started.md
@@ -1,184 +1,11 @@
# Get Started
-This guide demonstrates a basic CyteType job using a sample PBMC dataset from 10X Genomics.
-**For AnnData or the Python client, see [CyteType](https://github.com/NygenAnalytics/CyteType).**
+This guide has moved to the CyteType documentation, which covers the R and Python clients together:
-## Authentication
+- [Quickstart (R)](https://docs.nygen.io/CyteType/getting-started/quickstart-r/): preprocess a dataset with Seurat, run CyteTypeR and explore the results.
+- [Installation](https://docs.nygen.io/CyteType/getting-started/installation/) and [Sign in and API keys](https://docs.nygen.io/CyteType/getting-started/sign-in/).
+- [Prepare your data](https://docs.nygen.io/CyteType/guides/prepare-data/): what `PrepareCyteTypeR()` needs from the Seurat object and the marker table.
+- [Results in AnnData and Seurat](https://docs.nygen.io/CyteType/results/results-in-your-data/): the columns and tables that `CyteTypeR()` adds to the object.
+- [R function reference](https://docs.nygen.io/CyteType/reference/r-api/).
-Sign in once on each machine before submitting a job:
-
-```R
-library(CyteTypeR)
-SetupCyteTypeR()
-```
-
-The browser flow verifies your email with a one-time code and saves a personal API key locally. If you already have an API key, use `LoginCyteTypeR()` to enter it through a hidden prompt.
-
-To use CyteTypeR directly from the terminal, first install the launcher into the active R environment:
-
-```R
-InstallCyteTypeRCli()
-```
-
-```sh
-cytetyper setup
-cytetyper dashboard
-cytetyper view
-cytetyper logout
-```
-
-The R and Python clients share the same local CyteType credentials file.
-
-### Development environments
-
-Replace `` with the development URL supplied for your environment:
-
-```R
-SetupCyteTypeR(api_url = "")
-```
-
-```sh
-cytetyper setup --api-url ""
-```
-
-Alternatively, configure the current terminal session:
-
-```sh
-export CYTETYPE_API_URL=""
-cytetyper setup
-```
-
-## Quick Start Example
-``` R
-# Load package
-library(CyteTypeR)
-
-# Sign in if this machine is not configured
-SetupCyteTypeR()
-
-prepped_data <- PrepareCyteTypeR(
- pbmc,
- pbmc.markers,
- n_top_genes = 10,
- group_key = "seurat_clusters",
- aggregate_metadata = TRUE,
- coordinates_key = "umap"
-)
-
-metadata <- list(
- title = "My scRNA-seq analysis of human PBMCs",
- run_label = "initial_analysis",
- experiment_name = "pbmc_human_samples_study"
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata
-)
-```
-
-## Pre-processing
-
-CyteTypeR requires a Seurat object with normalized RNA expression, cluster assignments, marker genes, and optionally a dimensional reduction for report visualization.
-
-An example of the expected marker genes table can be found here: [marker-table-example.tsv](/inst/marker-table-example.tsv)
-
-``` R
-# Load libraries
-library(dplyr)
-library(patchwork)
-library(Matrix)
-library(Seurat)
-library(CyteTypeR)
-
-# Load an example dataset from MTX format files from 10X
-pbmc.data <- Read10X(data.dir = "./data/filtered_gene_bc_matrices/hg19/")
-
-# Initialize and normalize the Seurat object
-pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
-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)
-
-# Cluster the cells and run UMAP
-pbmc <- FindNeighbors(pbmc, dims = 1:10)
-pbmc <- FindClusters(pbmc, resolution = 0.5)
-pbmc <- RunUMAP(pbmc, dims = 1:10)
-
-# Find and filter markers for all clusters
-pbmc.markers <- FindAllMarkers(pbmc, only.pos = TRUE)
-pbmc.markers <- pbmc.markers %>%
- group_by(cluster) %>%
- dplyr::filter(avg_log2FC > 1)
-```
-
-## Running CyteTypeR
-
-CyteTypeR first prepares local artifacts, then submits the job and retrieves the result.
-
-``` R
-# Prepare data for submission
-prepped_data <- PrepareCyteTypeR(
- pbmc,
- pbmc.markers,
- n_top_genes = 10,
- group_key = "seurat_clusters",
- aggregate_metadata = TRUE,
- coordinates_key = "umap"
-)
-
-# Add metadata to the report
-metadata <- list(
- title = "My scRNA-seq analysis of human PBMCs",
- run_label = "initial_analysis",
- experiment_name = "pbmc_human_samples_study"
-)
-
-# Submit the job and add results to the Seurat object
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata
-)
-```
-
-## Open reports and retrieve results
-
-Successful submissions print a report URL under `https://cytetype.nygen.io`. Open the dashboard or a known job from R:
-
-```R
-OpenCyteTypeDashboard()
-ViewCyteTypeJob("")
-```
-### Results table
-CyteType results are saved under "misc" in the seurat object e.g.```seurat_obj@misc$cytetype_results```
-Example of the results table: [cytetypeR_table_export.tsv](/inst/cytetypeR_table_export.tsv)
-
-```
-## View results table
-> View(pbmc@misc[["cytetype_results"]])
-
-## Cluster annotation and result are stored in each row, use names() to check result table fields.
-> names(pbmc_small@misc[["cytetype_results"]])
- [1] "clusterId" "annotation" "ontologyTerm" "granularAnnotation" "cellState"
- [6] "justification" "supportingMarkers" "conflictingMarkers" "missingExpression" "unexpectedExpression"
-
-
-Using CLI:
-
-```sh
-cytetyper dashboard
-cytetyper view
-```
-
-Results from a completed run are stored in the returned Seurat object. With the default prefix, the transformed result table is available at:
-
-```R
-View(annotated_pbmc@misc[["cytetype_results"]])
-GetResults(annotated_pbmc)
-```
+In R, `?PrepareCyteTypeR`, `?CyteTypeR` and `?GetResults` open the help pages of the installed version.
diff --git a/inst/cytetypeR_table_export.tsv b/inst/cytetypeR_table_export.tsv
deleted file mode 100644
index 890d050..0000000
--- a/inst/cytetypeR_table_export.tsv
+++ /dev/null
@@ -1,4 +0,0 @@
-clusterId annotation ontologyTerm granularAnnotation cellState justification supportingMarkers conflictingMarkers missingExpression unexpectedExpression
-0 0 Natural Killer Cell (CD7+ GNLY+ cytotoxic with partial T-cell markers) CL_0000939 CD7-positive, GNLY-expressing cytotoxic NK cell with partial T cell marker expression and platelet marker contamination activated The cluster maintains strong NK cell characteristics with high expression of GNLY, CCL5, GZMA, and PRF1. Contrary to initial feedback, NKG7 (47.22%) and CST7 (47.22%) are actually expressed at levels higher than other clusters, confirming NK identity. The presence of CD3D/CD3E/CD247 likely represents technical artifacts or rare NK-T interactions rather than true T cell identity, as evidenced by complete absence of TRDC/TRGC1 (0%). FCGR3A (CD16) expression at 36.11% supports classical NK identity, though lower than expected. The platelet marker GP9 suggests potential platelet-NK doublets or platelet contamination. The cytotoxic profile combined with NKG7/CST7 expression outweighs the conflicting T cell markers, while the platelet markers likely represent technical artifacts rather than biological identity. CD7; GNLY; CCL5; GZMA; PRF1; NKG7; CST7 CD3D; CD3E; GP9 Higher FCGR3A (CD16) expression would be expected for classical NK cells Unexpected expression of T cell markers (CD3D/CD3E) and platelet marker GP9
-1 1 Classical Monocyte (S100A8/S100A9-high, inflammatory) CL_0002057 S100A8/S100A9-high, CD14/CD68-positive classical monocyte with inflammatory activation state Inflammatory activated The cluster maintains strong evidence for classical monocyte identity with high expression of monocyte markers (S100A8, S100A9, LYZ, CST3, CD14, CD68) and myeloid activation markers (TYROBP, IFITM3). The complete absence of CD11B (ITGAM) expression is unexpected but may reflect technical limitations or a specific activation state, as classical monocytes can downregulate CD11B during certain inflammatory conditions. The lack of neutrophil markers (ELANE, MPO) rules out neutrophil precursor contamination. While CD163 absence suggests these are not mature macrophages, this is consistent with classical monocytes that typically express lower CD163 levels. The inflammatory signature (S100A8/A9, IFITM3) and absence of alternative lineage markers strongly support an activated classical monocyte identity. The original label '1' likely reflects this being a major myeloid population in PBMC samples. S100A8; S100A9; LYZ; CST3; CD14; CD68; TYROBP; IFITM3 CD163; ITGAM CD163 and CD11B (ITGAM) expression typically seen in myeloid cells is absent Complete absence of CD11B (ITGAM) is unusual but may reflect activation state
-2 2 Doublet (B-T cell, HLA-DR-high) CL_0000960 B cell-T cell doublet with HLA-DR-high expression mixed The cluster shows conflicting marker expression patterns that cannot be explained by a single cell type. While there is strong expression of B cell markers (MS4A1 at 52.63%, CD79A at 47.37%, CD79B at 63.16%), the unexpectedly low CD19 expression (21.05%) and presence of T cell markers (CD3E at 42.11%, CD3D at 26.32%) suggest this is not a pure B cell population. The complete absence of CD20 expression contradicts the initial CD20-positive annotation. The HLA-DR-high expression could come from either activated B cells or T cells. The balanced distribution between groups and presence of both B and T cell markers strongly suggests this cluster represents technical doublets rather than a biologically meaningful cell state. The heterogeneity status further supports this interpretation. MS4A1; CD79A; CD79B; CD3E; CD3D; HLA-DPB1; HLA-DQB1; HLA-DRB1; HLA-DRA; HLA-DPA1 CD19; CD20; CD14 Expected higher CD19 expression for a pure B cell population and consistent CD20 expression if this were truly CD20-positive B cells Significant co-expression of B cell and T cell markers in the same cluster, which should be mutually exclusive in normal biology
diff --git a/man/CleanUpArtifacts.Rd b/man/CleanUpArtifacts.Rd
index d4a4939..55288c0 100644
--- a/man/CleanUpArtifacts.Rd
+++ b/man/CleanUpArtifacts.Rd
@@ -9,6 +9,18 @@ CleanUpArtifacts(prepped_data)
\arguments{
\item{prepped_data}{Named list containing prepared data from \code{PrepareCyteTypeR()}.}
}
+\value{
+Invisibly, \code{TRUE} when the artifact files had been built and are now
+removed, and \code{FALSE} when they were never built (nothing is deleted).
+}
\description{
-Cleans up the artifact files after the run.
+Deletes the artifact files (\code{vars.h5} and \code{obs.duckdb}) that
+\code{\link[=PrepareCyteTypeR]{PrepareCyteTypeR()}} wrote, once \code{\link[=CyteTypeR]{CyteTypeR()}} has uploaded them.
+}
+\examples{
+\dontrun{
+prepped_data <- PrepareCyteTypeR(pbmc, pbmc.markers)
+pbmc <- CyteTypeR(pbmc, prepped_data, study_context = "Human PBMCs")
+CleanUpArtifacts(prepped_data)
+}
}
diff --git a/man/CyteTypeR-package.Rd b/man/CyteTypeR-package.Rd
new file mode 100644
index 0000000..18aaa45
--- /dev/null
+++ b/man/CyteTypeR-package.Rd
@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/CyteTypeR-package.R
+\docType{package}
+\name{CyteTypeR-package}
+\alias{CyteTypeR-package}
+\title{CyteTypeR: CyteType for R}
+\description{
+CyteTypeR is the R client of CyteType, an agentic, evidence-based cell type
+annotation service for single-cell RNA-seq data. It prepares a clustered
+Seurat object and its marker genes, submits an annotation job to the
+CyteType API and adds the results to the object: a cell type label, a Cell
+Ontology term, a cell state and the reviewer's confidence for every
+cluster. Every job also produces an interactive report.
+}
+\section{Workflow}{
+
+\enumerate{
+\item Sign in once per computer with \code{\link[=SetupCyteTypeR]{SetupCyteTypeR()}}, or save an API key
+you already have with \code{\link[=LoginCyteTypeR]{LoginCyteTypeR()}}.
+\item Run \code{\link[=PrepareCyteTypeR]{PrepareCyteTypeR()}} on a normalized, clustered Seurat object and the
+marker table from \code{Seurat::FindAllMarkers()}.
+\item Run \code{\link[=CyteTypeR]{CyteTypeR()}} to upload the data, submit the job, wait for it and add
+the results to the object.
+\item Use \code{\link[=GetResults]{GetResults()}} to read the results again, or to fetch the results of
+a job by its ID, and \code{\link[=CleanUpArtifacts]{CleanUpArtifacts()}} to delete the uploaded files.
+}
+
+\code{\link[=OpenCyteTypeDashboard]{OpenCyteTypeDashboard()}} and \code{\link[=ViewCyteTypeJob]{ViewCyteTypeJob()}} open the dashboard and a
+job's report. \code{\link[=InstallCyteTypeRCli]{InstallCyteTypeRCli()}} installs the \code{cytetyper} terminal
+command, which signs in and opens reports from a shell.
+}
+
+\section{Documentation}{
+
+The CyteType documentation at \url{https://docs.nygen.io/CyteType/} covers both
+the R and the Python client: installation, sign-in, the R quickstart, the
+results, the report and the usage limits.
+}
+
+\section{License}{
+
+The package code is released under the BSD 3-Clause License. Annotation runs
+on the CyteType service, which requires an API key: academic and
+non-commercial use is free within the usage limits, and commercial use
+requires a license from Nygen Analytics AB (\href{mailto:contact@nygen.io}{contact@nygen.io}).
+}
+
+\seealso{
+Useful links:
+\itemize{
+ \item \url{https://docs.nygen.io/CyteType/}
+ \item \url{https://github.com/NygenAnalytics/CyteTypeR}
+ \item Report bugs at \url{https://github.com/NygenAnalytics/CyteTypeR/issues}
+}
+
+}
+\author{
+\strong{Maintainer}: Nygen Analytics AB \email{contact@nygen.io} [copyright holder]
+
+Authors:
+\itemize{
+ \item Nygen Analytics AB \email{contact@nygen.io} [copyright holder]
+}
+
+}
+\keyword{internal}
diff --git a/man/CyteTypeR.Rd b/man/CyteTypeR.Rd
index 4aedb0c..8979026 100644
--- a/man/CyteTypeR.Rd
+++ b/man/CyteTypeR.Rd
@@ -22,7 +22,8 @@ CyteTypeR(
upload_max_workers = 6L,
require_artifacts = TRUE,
show_progress = TRUE,
- override_existing_results = FALSE
+ override_existing_results = FALSE,
+ visibility = NULL
)
}
\arguments{
@@ -30,19 +31,31 @@ CyteTypeR(
\item{prepped_data}{Named list containing prepared data from \code{PrepareCyteTypeR()}.}
-\item{study_context}{Optional character. Biological context for the experimental setup (e.g. organisms, tissues, diseases, developmental stages, single_cell methods, experimental conditions). Default is \code{NULL}.}
+\item{study_context}{Optional character. Biological context for the experimental setup (e.g. organisms, tissues, diseases, developmental stages, single-cell methods, experimental conditions). Default is \code{NULL}.}
-\item{llm_configs}{Optional list of LLM configs. Each element must match the LLMModelConfig schema with required \code{provider} and \code{name}; either \code{apiKey} or all AWS credentials (\code{awsAccessKeyId}, \code{awsSecretAccessKey}, \code{awsDefaultRegion}) must be provided. Default is \code{NULL} (API default model).}
+\item{llm_configs}{Optional list of LLM configs. Each element must match the LLMModelConfig schema with required \code{provider} and \code{name}; either \code{apiKey} or all AWS credentials (\code{awsAccessKeyId}, \code{awsSecretAccessKey}, \code{awsDefaultRegion}) must be provided. \code{provider} is one of \code{"anthropic"}, \code{"bedrock"}, \code{"deepseek"}, \code{"fireworks"}, \code{"google"}, \code{"groq"}, \code{"huggingface"}, \code{"mistral"}, \code{"nebius"}, \code{"openai"}, \code{"openrouter"}, \code{"together"}, \code{"vertex"} or \code{"xai"}. Default is \code{NULL} (API default model).}
\item{metadata}{Optional named list. Custom metadata tags for the report header; URL-like values are made clickable in the report. Default is \code{NULL}.}
\item{n_parallel_clusters}{Integer. Number of parallel requests to the model (max 50). High values can trigger rate limits. Default is 2.}
-\item{results_prefix}{Character. Prefix for keys added to \code{obj@meta.data} and \code{obj@misc} storing results; the annotation column is \code{obj@meta.data[[paste(results_prefix, group_key, sep = "_")]]}. Default is \code{"cytetype"}.}
+\item{results_prefix}{Character. Prefix for the results added to \code{obj}. The
+factor columns \verb{_annotation_},
+\verb{_cellOntologyTerm_},
+\verb{_cellOntologyTermID_}, \verb{_cellState_}
+and \verb{_reviewerConfidence_} are added to \code{obj@meta.data},
+with three copies under older names: \verb{_} (label),
+\verb{_ontologyTerm_} and \verb{_ontologyID_}.
+The job details are stored in \code{obj@misc[[paste0(prefix, "_jobDetails")]]}
+and the results as described under Value. Default is \code{"cytetype"}.}
\item{poll_interval_seconds}{Integer. How often (seconds) to poll the API for results. Default from options (10).}
-\item{timeout_seconds}{Integer. Maximum time (seconds) to wait for results before erroring. Default from options (7200).}
+\item{timeout_seconds}{Integer. Maximum time (seconds) to wait for results.
+When it is reached, \code{CyteTypeR()} stops with an error of class
+\code{cytetype_timeout_error} that names the job ID; the job keeps running on
+the server and \code{\link[=GetResults]{GetResults()}} retrieves its results later. Default from
+options (7200).}
\item{api_url}{Optional character. CyteType API server origin. If \code{NULL},
uses \code{CYTETYPE_API_URL}, the configured R option, or
@@ -68,9 +81,41 @@ configuration.}
\item{show_progress}{Logical. Whether to show progress (spinner and cluster status). Set \code{FALSE} to disable. Default is \code{TRUE}.}
\item{override_existing_results}{Logical. If \code{TRUE}, allow overwriting existing results with the same \code{results_prefix}. If \code{FALSE} and results exist, an error is raised. Default is \code{FALSE}.}
+
+\item{visibility}{Optional character. Who can view the report: \code{"private"},
+\code{"org"} (your organization; needs an organization API key) or \code{"public"}
+(anyone with the link). Default is \code{NULL}, which uses the server default
+(\code{"private"}). With \code{"org"} and an API key that looks like a personal key
+(it starts with \code{cyt_p_}), a warning is logged before the files are
+uploaded and the run continues; the server checks the key when the job is
+submitted and rejects personal keys.}
}
\value{
-The input Seurat object with added annotation metadata (and artifact uploads when artifacts are built and uploaded).
+The Seurat object \code{obj} with the results added. Assign it, for
+example \code{obj <- CyteTypeR(obj, prepped_data)}; the object you pass in is
+not changed.
+\itemize{
+\item \code{obj@meta.data} gains the factor columns listed under
+\code{results_prefix}. Cells in clusters without a result get \code{"Unknown"}
+(\code{""} for the cell state) in the first five columns and \code{NA} in the
+three older ones. The reviewer confidence column holds \code{"High"},
+\code{"Moderate"}, \code{"Low"}, or \code{"Unknown"} when it is missing; its levels
+follow that order, and only the levels that occur are kept.
+\item \code{obj@misc[[paste0(prefix, "_jobDetails")]]} holds \code{job_id},
+\code{report_url}, \code{api_url}, \code{group_key}, \code{cluster_labels} and, when set,
+\code{visibility}.
+\item With the default prefix, \code{obj@misc$cytetype_results} is a
+data.frame with one row per annotated cluster and the columns
+\code{clusterId} (your cluster label), \code{annotation}, \code{ontologyTerm},
+\code{ontologyTermID}, \code{granularAnnotation}, \code{cellState}, \code{justification},
+\code{supportingMarkers}, \code{conflictingMarkers}, \code{missingExpression},
+\code{unexpectedExpression}, \code{reviewerConfidence}, \code{isHeterogeneous} and
+\code{heterogeneityType}. Its attributes \code{"job_id"} and \code{"result"} hold the
+job ID and the full results in the form returned by \code{\link[=GetResults]{GetResults()}}.
+\item With another prefix, \code{obj@misc[[paste0(prefix, "_results")]]} is a
+list with \code{job_id} and \code{result} (the full results), and
+\code{obj@misc$cytetype_results} is left as it is.
+}
}
\description{
Submits a prepared dataset to CyteType for automated cell type annotation
@@ -82,13 +127,26 @@ The function performs the following workflow:
\enumerate{
\item Constructs the analysis query from prepared data
\item Optionally saves the query to a JSON file
-\item Submits the job and records its details in the returned object
+\item Uploads the artifact files and submits the job
\item Polls for job completion with progress updates
\item Retrieves results and integrates annotations into the Seurat object
}
-Job details are stored in the returned Seurat object's \code{misc} slot for later
-retrieval with \code{\link[=GetResults]{GetResults()}}.
+The evidence columns of the results table (\code{justification},
+\code{supportingMarkers}, \code{conflictingMarkers}, \code{missingExpression} and
+\code{unexpectedExpression}) are filled from the structured output of current
+jobs when the stored fields are empty. \code{supportingMarkers} and
+\code{conflictingMarkers} list genes separated by \code{"; "}.
+
+While waiting, network errors are retried until \code{timeout_seconds} is
+reached. Other errors while checking the job stop the run after five in a
+row. When the results of a completed job cannot be fetched, the rate limit
+and server errors (HTTP 500, 502, 503 and 504) are retried in the same way,
+and other errors, such as a deleted report (HTTP 410), stop the run at once.
+These errors signal a \code{\link[=cytetype_api_error]{cytetype_api_error()}} condition. If the run stops or
+is interrupted, the job keeps running on the server: retrieve its results
+with \code{GetResults(job_id = "")}, using the job ID printed when the job
+was submitted.
}
\examples{
\dontrun{
@@ -109,7 +167,8 @@ annotated_seurat <- CyteTypeR(
"GEO_Accession" = "GSE123456"
),
timeout_seconds = 1800,
- poll_interval_seconds = 60
+ poll_interval_seconds = 60,
+ visibility = "public"
)
}
diff --git a/man/GetResults.Rd b/man/GetResults.Rd
index dafd882..652e081 100644
--- a/man/GetResults.Rd
+++ b/man/GetResults.Rd
@@ -9,7 +9,8 @@ GetResults(
job_id = NULL,
results_prefix = "cytetype",
auth_token = NULL,
- api_url = NULL
+ api_url = NULL,
+ save_json = TRUE
)
}
\arguments{
@@ -26,15 +27,66 @@ explicit token also requires a matching \code{api_url}.}
\item{api_url}{Optional CyteType server origin for standalone or legacy job
retrieval. When \code{NULL}, uses \code{CYTETYPE_API_URL} or
\verb{https://cytetype.nygen.io}.}
+
+\item{save_json}{Logical. When the results are fetched by \code{job_id}, whether
+to save the server's response as \verb{cytetypeR_results_.json} in the
+working directory. Default is \code{TRUE}.}
}
\value{
-Result list (annotations, summary, etc.), or transformed results when fetching by \code{job_id} only.
+Depends on where the results come from:
+\itemize{
+\item \code{GetResults(obj)} after a run with the default prefix: the
+data.frame in \code{obj@misc$cytetype_results} (see \code{\link[=CyteTypeR]{CyteTypeR()}}).
+\item Results stored under another prefix, or fetched for the job stored
+in \code{obj}: a list with \code{annotations} (one list per annotated cluster
+with \code{clusterId}, the CyteType cluster ID, \code{annotation},
+\code{ontologyTerm}, \code{ontologyTermID}, \code{granularAnnotation}, \code{cellState},
+\code{justification}, \code{supportingMarkers}, \code{conflictingMarkers},
+\code{missingExpression}, \code{unexpectedExpression}, \code{reviewerConfidence},
+\code{isHeterogeneous} and \code{heterogeneityType}), \code{raw_annotations} (the
+server's per-cluster results, unchanged) and the server's
+\code{studyContext}, \code{summary}, \code{semanticOrder}, \code{clusterCategories} and
+\code{displayLevel}.
+\item \code{GetResults(job_id = ...)}: a data.frame with the same columns as
+\code{obj@misc$cytetype_results}, where \code{clusterId} is the CyteType cluster
+ID. Its attributes \code{"job_id"} and \code{"result"} hold the job ID and the
+list described above.
+\item \code{NULL}, with a message, when the job has not finished yet or is
+not found.
+}
}
\description{
If \code{obj} and \code{results_prefix} are given, tries to load from
\code{obj@misc} first. If no local result exists but job details are
available, fetches the result from the API.
-If only \code{job_id} is given, fetches from the API and returns (saves JSON).
+If only \code{job_id} is given, fetches the result from the API.
+}
+\details{
+Fetching asks the server for the job's status and, when the job has
+completed, for its results: two requests, without waiting. A failed job
+stops with an error. When the status or the results cannot be fetched,
+\code{GetResults()} signals a \code{\link[=cytetype_api_error]{cytetype_api_error()}} condition whose
+\code{error_code} holds the server's code when it sent one, such as
+\code{"REPORT_DELETED"}. Problems with the API key signal its subclass
+\code{cytetype_auth_error}.
+
+\code{reviewerConfidence} is \code{"High"}, \code{"Moderate"} or \code{"Low"} (\code{NULL} in the
+list and \code{NA} in the table when missing), \code{isHeterogeneous} is \code{TRUE} or
+\code{FALSE} (or missing), and \code{heterogeneityType} names the kind of
+heterogeneity the reviewer found. In the list, \code{supportingMarkers} and
+\code{conflictingMarkers} are lists of gene names.
+
+Fetched results are not added to \code{obj}; R does not modify the object you
+pass in.
+}
+\examples{
+\dontrun{
+# Results stored in the object by CyteTypeR()
+results <- GetResults(annotated_seurat)
+
+# Results of a job by its ID, without saving the JSON file
+results <- GetResults(job_id = "", save_json = FALSE)
+}
}
\seealso{
\code{\link[=CyteTypeR]{CyteTypeR()}} for job submission
diff --git a/man/LoginCyteTypeR.Rd b/man/LoginCyteTypeR.Rd
index 5da4825..4546207 100644
--- a/man/LoginCyteTypeR.Rd
+++ b/man/LoginCyteTypeR.Rd
@@ -7,7 +7,11 @@
LoginCyteTypeR(api_token = NULL, api_url = NULL)
}
\arguments{
-\item{api_token}{Optional API key. When omitted, a hidden prompt is shown.}
+\item{api_token}{Optional API key. When omitted, a hidden prompt is shown
+in an interactive session. Otherwise the key is read from the first line
+of standard input, so \verb{cytetyper login} and scripts can pipe it in. Typed
+into a terminal, the key is hidden on Linux and macOS but shown on
+Windows.}
\item{api_url}{Optional CyteType server origin. When \code{NULL}, uses
\code{CYTETYPE_API_URL} or \verb{https://cytetype.nygen.io}.}
diff --git a/man/OpenCyteTypeDashboard.Rd b/man/OpenCyteTypeDashboard.Rd
index b3d68f1..e4ef290 100644
--- a/man/OpenCyteTypeDashboard.Rd
+++ b/man/OpenCyteTypeDashboard.Rd
@@ -14,7 +14,8 @@ Open the CyteType dashboard
}
\details{
Uses the dashboard associated with saved credentials. When credentials are
-absent, opens the production dashboard at \verb{https://cytetype.nygen.io}.
+absent, opens the production dashboard at
+\verb{https://cytetype.nygen.io/dashboard}.
}
\examples{
\dontrun{
diff --git a/man/PrepareCyteTypeR.Rd b/man/PrepareCyteTypeR.Rd
index 0cd382b..ab68420 100644
--- a/man/PrepareCyteTypeR.Rd
+++ b/man/PrepareCyteTypeR.Rd
@@ -21,16 +21,23 @@ PrepareCyteTypeR(
)
}
\arguments{
-\item{obj}{A Seurat object with normalized data and clustering results.}
+\item{obj}{A Seurat object with normalized data and clustering results. It
+needs an assay named \code{"RNA"} with a normalized \code{data} layer.}
-\item{marker_table}{Data frame containing marker genes with columns:
-'cluster', 'gene', and 'avg_log2FC'. Output from Seurat's
-\code{FindAllMarkers()} function.}
+\item{marker_table}{Data frame containing marker genes with the columns
+\code{cluster}, \code{gene} and \code{avg_log2FC}, such as the output of Seurat's
+\code{FindAllMarkers()}. Its clusters must be exactly the clusters in
+\code{group_key}, each with at least five marker genes.}
\item{group_key}{Character string specifying the metadata column containing
-cluster assignments. Default is "seurat_clusters".}
+cluster assignments. Every cell needs a cluster: \code{NA} values stop the
+preparation with an error. Default is \code{"seurat_clusters"}.}
-\item{gene_symbols}{Character string specifying the gene symbol field name. Default is 'gene_symbols'.}
+\item{gene_symbols}{Character string naming the column of the RNA assay's
+feature metadata that holds gene symbols. It is used only to check that
+the genes are symbols rather than database identifiers; when the column
+does not exist, the row names of the RNA assay are checked instead.
+Default is \code{"gene_symbols"}.}
\item{n_top_genes}{Integer specifying the maximum number of top marker genes
per cluster to include after ordering by \code{avg_log2FC}. Filter
@@ -50,8 +57,12 @@ exceeding this limit are silently skipped. Default is 500.}
\item{pcent_batch_size}{Integer specifying batch size for expression percentage
calculations. Default is 5000.}
-\item{coordinates_key}{Character string specifying which dimensional reduction
-to use for visualization coordinates (e.g., "umap", "tsne"). Default is "umap".}
+\item{coordinates_key}{Character string naming the dimensional reduction used
+for the report's visualization, such as \code{"umap"} or \code{"tsne"}. This
+reduction is tried first, then \code{"umap"}, \code{"tsne"} and \code{"pca"}, matched
+case-insensitively; the first one with a row for every cell and at least
+two dimensions is used. When none qualifies, the job runs without
+visualization. Default is \code{"umap"}.}
\item{max_cells_per_group}{Integer specifying maximum cells per cluster for
visualization subsampling. Default is 1000.}
@@ -63,39 +74,56 @@ generated vars.h5 artifact (feature expression). Default is \code{"vars.h5"}.}
generated obs.duckdb artifact (cell metadata). Default is \code{"obs.duckdb"}.}
}
\value{
-Named list containing formatted data for CyteType analysis:
+A named list to pass to \code{\link[=CyteTypeR]{CyteTypeR()}}:
\itemize{
-\item \code{clusterLabels}: List mapping numeric cluster IDs to original labels
+\item \code{clusterLabels}: List mapping the CyteType cluster IDs (\code{"1"},
+\code{"2"}, ...) to your cluster labels
\item \code{clusterMetadata}: Aggregated metadata by cluster (if enabled)
\item \code{markerGenes}: List of top marker genes per cluster
-\item \code{visualizationData}: Coordinates and cluster assignments for plotting
+\item \code{visualizationData}: Sampled coordinates and cluster assignments
+for plotting, or \code{NULL} when no coordinates were found
\item \code{expressionData}: Expression percentages by cluster
\item \code{group_key}: The metadata column name used for cluster assignments
\item \code{build_succeeded}: Logical indicating whether artifact files were built successfully
\item \code{vars_h5_path}: Path to the generated vars.h5 file
\item \code{obs_duckdb_path}: Path to the generated obs.duckdb file
+\item \code{coordinates_key}: The name of the reduction whose coordinates
+were used for the visualization, or \code{NULL} when none was used
}
}
\description{
Prepares a Seurat object and a gene marker table for CyteType API by extracting and formatting
cluster labels, metadata, marker genes, visualization coordinates, and
-expression data into the required data structure.
+expression data into the required data structure. It also writes the two
+files that \code{\link[=CyteTypeR]{CyteTypeR()}} uploads with the job: \code{vars.h5} (expression) and
+\code{obs.duckdb} (cell metadata and coordinates).
}
\details{
The function performs the following steps:
\enumerate{
-\item Validates the Seurat object structure
+\item Validates the Seurat object structure and the cluster labels
\item Creates a mapping from original cluster labels to sequential numeric IDs
\item Aggregates metadata across cells within clusters (optional)
\item Filters and selects top marker genes per cluster
\item Extracts dimensional reduction coordinates for visualization
\item Calculates expression percentages across clusters
-\item Builds a vars.h5 artifact from the normalized expression matrix
+\item Builds a vars.h5 artifact from the normalized expression matrix, with
+the raw counts when they are whole numbers
\item Builds an obs.duckdb artifact from the cell metadata
}
-Clusters are renumbered sequentially (1, 2, 3, ...) to ensure consistent
-formatting regardless of original cluster naming.
+Clusters are renumbered sequentially (1, 2, 3, ...) in the sorted order of
+your labels (level order for a factor) to ensure consistent formatting
+regardless of original cluster naming.
+
+Expression always comes from the \code{"RNA"} assay, whatever the default assay
+is, and Seurat v5 layers split by sample are joined on a copy (your object is
+not changed). The gene names come from the same assay. When the default
+assay is not \code{"RNA"}, a warning says that \code{"RNA"} is used.
+
+Errors while building the two files are logged and recorded as
+\code{build_succeeded = FALSE}; \code{\link[=CyteTypeR]{CyteTypeR()}} then stops unless
+\code{require_artifacts = FALSE}.
}
\examples{
\dontrun{
@@ -110,3 +138,7 @@ prepped_data <- PrepareCyteTypeR(
}
}
+\seealso{
+\code{\link[=CyteTypeR]{CyteTypeR()}} to submit the job, \code{\link[=CleanUpArtifacts]{CleanUpArtifacts()}} to delete the
+files afterwards.
+}
diff --git a/man/cytetype_api_error.Rd b/man/cytetype_api_error.Rd
index a0c31ed..dc75c31 100644
--- a/man/cytetype_api_error.Rd
+++ b/man/cytetype_api_error.Rd
@@ -4,16 +4,47 @@
\alias{cytetype_api_error}
\title{Custom API Error}
\usage{
-cytetype_api_error(message, call = NULL)
+cytetype_api_error(message, call = NULL, error_code = NULL, status_code = NULL)
}
\arguments{
-\item{message}{Error message}
+\item{message}{Error message.}
-\item{call}{Call that generated the error}
+\item{call}{Where the error came from: \code{"network"} when the server could not
+be reached, \code{"api"} for other errors. Default is \code{NULL}.}
+
+\item{error_code}{The error code the server sent, such as
+\code{"REPORT_DELETED"}, or \code{NULL} when there is none. Default is \code{NULL}.}
+
+\item{status_code}{The HTTP status of the server's response, such as \code{503},
+or \code{NULL} when there is none, for example when the server could not be
+reached. Default is \code{NULL}.}
}
\value{
-An error object of class cytetype_api_error
+An error condition of class \code{cytetype_api_error}, with the elements
+\code{message}, \code{call}, \code{error_code} and \code{status_code}. Printing it shows
+\verb{CyteType API Error: }.
}
\description{
-Custom API Error
+Creates the condition that CyteTypeR signals when the status or the results
+of a job cannot be fetched: by \code{\link[=GetResults]{GetResults()}}, and by \code{\link[=CyteTypeR]{CyteTypeR()}} when it
+stops waiting for a job because of such errors. Errors about the API key are
+signalled as \code{cytetype_auth_error}, a subclass.
+}
+\examples{
+error <- cytetype_api_error(
+ paste(
+ "Error while checking job status: HTTP 410 [REPORT_DELETED]",
+ "This report has been deleted by the owner"
+ ),
+ call = "api",
+ error_code = "REPORT_DELETED",
+ status_code = 410L
+)
+print(error)
+
+# Handle the condition by its class and read the server's code.
+tryCatch(
+ stop(error),
+ cytetype_api_error = function(e) e$error_code
+)
}
diff --git a/tests/testthat/helper-results.R b/tests/testthat/helper-results.R
new file mode 100644
index 0000000..f13c0af
--- /dev/null
+++ b/tests/testthat/helper-results.R
@@ -0,0 +1,316 @@
+# Result fixtures for the normalization tests. They mirror the shapes in the
+# Python SDK's tests/test_results_normalization.py, in the form httr2 parses
+# JSON (simplifyVector = FALSE): objects are named lists, arrays unnamed lists.
+
+LEGACY_FIELDS <- c(
+ "justification",
+ "supportingMarkers",
+ "conflictingMarkers",
+ "missingExpression",
+ "unexpectedExpression"
+)
+EXISTING_KEYS <- c(
+ "clusterId",
+ "annotation",
+ "ontologyTerm",
+ "ontologyTermID",
+ "granularAnnotation",
+ "cellState",
+ LEGACY_FIELDS
+)
+SDK_KEYS <- c("reviewerConfidence", "isHeterogeneous", "heterogeneityType")
+EXISTING_TABLE_COLUMNS <- c(
+ "clusterId",
+ "annotation",
+ "ontologyTerm",
+ "ontologyTermID",
+ "granularAnnotation",
+ "cellState",
+ "justification",
+ "supportingMarkers",
+ "conflictingMarkers",
+ "missingExpression",
+ "unexpectedExpression"
+)
+
+json_object <- function() stats::setNames(list(), character(0))
+
+EMPTY_LEGACY_FIELDS <- list(
+ justification = "",
+ supportingMarkers = list(),
+ conflictingMarkers = list(),
+ missingExpression = "",
+ unexpectedExpression = ""
+)
+CONCLUSION <- paste0(
+ "**CD8+ T cell**: `CD8A` and `CD8B` with cytotoxic `GZMK` support a\n",
+ "cytotoxic T cell identity. "
+)
+EXPECTED_FILL <- list(
+ justification = CONCLUSION,
+ supportingMarkers = list("CD8A", "CD8B", "GZMK"),
+ conflictingMarkers = list("MKI67"),
+ missingExpression = "`CCR7` and `SELL` mark naive cells.",
+ unexpectedExpression = "`MKI67` suggests a proliferating subset."
+)
+LEGACY_EVIDENCE <- list(
+ justification = "Strong GFAP and S100B expression.",
+ supportingMarkers = list("GFAP", "S100B", "AQP4"),
+ conflictingMarkers = list(),
+ missingExpression = "SOX9 lower than expected",
+ unexpectedExpression = ""
+)
+
+# Set or add fields, keeping NULL values (a JSON null) as entries.
+with_fields <- function(x, fields) {
+ for (name in names(fields)) {
+ x[name] <- list(fields[[name]])
+ }
+ x
+}
+
+# fullOutput.cellType as stored between January and August 2026.
+gen2_cell_type <- function(...) {
+ with_fields(
+ list(
+ label = "Cd8+ T Cell",
+ keySupportingGenes = list("CD8A", "CD8B", "GZMK"),
+ keySupportingGenesReasoning = "`CD8A` and `CD8B` are lineage markers.",
+ missingGenes = list("CCR7", "SELL"),
+ missingGenesReasoning = "`CCR7` and `SELL` mark naive cells.",
+ unexpectedGenes = list("MKI67"),
+ unexpectedGenesReasoning = "`MKI67` suggests a proliferating subset.",
+ pathwaysSupportingEvidence = list("T cell receptor signaling"),
+ pathwaysSupportingEvidenceReasoning = "TCR signaling is enriched.",
+ candidateComparison = list("NK cell: lacks `NCAM1`."),
+ tissueContextFit = "Expected in blood.",
+ clusterContextFit = "Present in all samples.",
+ conclusion = CONCLUSION,
+ citationExplanations = json_object()
+ ),
+ list(...)
+ )
+}
+
+# fullOutput.cellType as stored since August 2026.
+v2_cell_type <- function(...) {
+ cell_type <- gen2_cell_type(
+ catalogReferenceLabel = "CD8-positive, alpha-beta T cell",
+ classification = "catalogue",
+ whyNotDeeper = "",
+ annotationLevels = list(
+ L1 = list(label = "Immune cell"),
+ L2 = list(label = "T cell"),
+ L3 = list(label = "CD8+ T cell")
+ ),
+ candidateComparison = list(`NK cell` = list(verdict = "rejected"))
+ )
+ cell_type$citationExplanations <- NULL
+ with_fields(cell_type, list(...))
+}
+
+review_fixture <- function(confidence, is_heterogeneous, heterogeneity_type = NULL) {
+ list(
+ reviewComments = "",
+ confidence = confidence,
+ isHeterogeneous = is_heterogeneous,
+ feedback = "",
+ labelComparisonScore = NULL,
+ fullOutput = list(
+ confidenceAssessment = list(label = confidence, reasoning = ""),
+ heterogeneityAssessment = list(
+ label = if (isTRUE(is_heterogeneous)) "Heterogeneous" else "Homogeneous",
+ reasoning = "",
+ heterogeneityType = heterogeneity_type,
+ heterogeneityTypeReasoning = ""
+ )
+ )
+ )
+}
+
+# A latest entry written since January 2026: legacy fields stored empty.
+new_result <- function(cluster_id, cell_type, review = NULL, label = "CD8+ T Cell", ...) {
+ annotation <- with_fields(
+ c(
+ list(
+ clusterId = cluster_id,
+ annotation = label,
+ granularAnnotation = "GZMK+ CD8+ T cell",
+ cellState = "Cytotoxic",
+ cellOntologyTerm = "CL:0000625",
+ cellOntologyTermName = "CD8-positive, alpha-beta T cell"
+ ),
+ EMPTY_LEGACY_FIELDS
+ ),
+ list(...)
+ )
+ annotation$fullOutput <- list(
+ clusterId = cluster_id,
+ cellType = cell_type,
+ cellStateWithReasoning = list(label = "Cytotoxic", reasoning = "")
+ )
+ annotation$clusterContext <- json_object()
+ list(
+ context = "Cluster context",
+ annotation = annotation,
+ review = if (is.null(review)) review_fixture("High", FALSE) else review,
+ developmentalSimilarity = list(),
+ functionalSimilarity = list()
+ )
+}
+
+# A latest entry stored before January 2026: evidence in the legacy fields.
+legacy_result <- function(cluster_id, ...) {
+ annotation <- c(
+ list(
+ clusterId = cluster_id,
+ annotation = "Astrocyte",
+ granularAnnotation = "GFAP+ astrocyte",
+ cellState = "mature",
+ cellOntologyTerm = "CL:0000127",
+ cellOntologyTermName = "astrocyte"
+ ),
+ LEGACY_EVIDENCE,
+ list(fullOutput = NULL, clusterContext = NULL)
+ )
+ list(
+ context = "Cluster context",
+ annotation = with_fields(annotation, list(...)),
+ review = list(confidence = "High"),
+ developmentalSimilarity = list(),
+ functionalSimilarity = list()
+ )
+}
+
+# A GET /results response mixing every stored result generation, plus a
+# cluster without a result and an older test-fixture shape.
+results_response <- function() {
+ list(
+ studyContext = "Human PBMC",
+ annotations = list(
+ `1` = list(latest = legacy_result("1"), history = list()),
+ `2` = list(
+ latest = new_result("2", gen2_cell_type(), review_fixture("Moderate", FALSE)),
+ history = list()
+ ),
+ `3` = list(
+ latest = new_result("3", v2_cell_type(), review_fixture("Low", TRUE, "distinct_populations")),
+ history = list(legacy_result("3"))
+ ),
+ `4` = list(
+ latest = list(developmentalSimilarity = list(), functionalSimilarity = list()),
+ history = list()
+ ),
+ `5` = list(latest = list(annotation = "B cell"), history = list())
+ ),
+ summary = list(tissue = "blood"),
+ semanticOrder = list("1", "2", "3"),
+ clusterCategories = list(list(categoryName = "Lymphoid", clusterIds = list("2", "3"))),
+ displayLevel = ""
+ )
+}
+
+# What CyteTypeR before 0.6.0 and the Python SDK before the normalization
+# stored for `response`: six fields per cluster, the evidence left empty.
+old_sdk_result <- function(response) {
+ annotations <- list()
+ for (cluster_id in names(response$annotations)) {
+ annotation <- response$annotations[[cluster_id]]$latest$annotation
+ if (!is.list(annotation) || is.null(names(annotation))) {
+ next
+ }
+ get <- function(key, default) if (key %in% names(annotation)) annotation[[key]] else default
+ entry <- list(
+ clusterId = get("clusterId", cluster_id),
+ annotation = get("annotation", "Unknown"),
+ ontologyTerm = get("cellOntologyTermName", "Unknown"),
+ ontologyTermID = get("cellOntologyTerm", "Unknown"),
+ granularAnnotation = get("granularAnnotation", ""),
+ cellState = get("cellState", "")
+ )
+ for (field in names(EMPTY_LEGACY_FIELDS)) {
+ entry[field] <- list(get(field, EMPTY_LEGACY_FIELDS[[field]]))
+ }
+ annotations[[length(annotations) + 1L]] <- entry
+ }
+ list(
+ annotations = annotations,
+ summary = response$summary,
+ clusterCategories = response$clusterCategories,
+ studyContext = response$studyContext,
+ raw_annotations = response$annotations
+ )
+}
+
+# Round-trip through JSON as the API client does.
+as_api_json <- function(x) {
+ jsonlite::fromJSON(
+ jsonlite::toJSON(x, auto_unbox = TRUE, null = "null", digits = NA),
+ simplifyVector = FALSE
+ )
+}
+
+legacy_values <- function(entry) entry[LEGACY_FIELDS]
+
+sdk_values <- function(entry) {
+ stats::setNames(lapply(SDK_KEYS, function(key) entry[[key]]), SDK_KEYS)
+}
+
+by_cluster <- function(result) {
+ entries <- result$annotations
+ stats::setNames(entries, vapply(entries, function(entry) entry$clusterId, character(1)))
+}
+
+normalize_latest <- function(latest) {
+ entry <- CyteTypeR:::.normalize_cluster_annotation("1", list(latest = latest, history = list()))
+ testthat::expect_false(is.null(entry))
+ entry
+}
+
+# A small, real Seurat object: 60 genes x 90 cells in three clusters, with
+# integer counts, log-normalized data, a batch column and a 2D "umap".
+make_seurat_fixture <- function(n_genes = 60L, n_cells = 90L, seed = 7L) {
+ counts <- withr::with_seed(seed, {
+ Matrix::rsparsematrix(
+ n_genes, n_cells, density = 0.4,
+ rand.x = function(n) as.numeric(stats::rpois(n, 4) + 1)
+ )
+ })
+ dimnames(counts) <- list(
+ sprintf("GENE%02d", seq_len(n_genes)),
+ sprintf("cell%03d", seq_len(n_cells))
+ )
+ obj <- suppressWarnings(SeuratObject::CreateSeuratObject(counts = counts))
+ obj <- Seurat::NormalizeData(obj, verbose = FALSE)
+ clusters <- rep(c("0", "1", "2"), length.out = n_cells)
+ obj$seurat_clusters <- factor(clusters, levels = c("0", "1", "2"))
+ obj$batch <- rep(c("a", "b"), each = n_cells / 2)
+ obj$donor <- rep(c("d1", "d2", "d3"), times = n_cells / 3)
+ embedding <- withr::with_seed(seed, matrix(stats::rnorm(n_cells * 2), ncol = 2))
+ dimnames(embedding) <- list(colnames(obj), c("umap_1", "umap_2"))
+ obj[["umap"]] <- SeuratObject::CreateDimReducObject(
+ embeddings = embedding, key = "umap_", assay = "RNA"
+ )
+ obj
+}
+
+make_marker_table <- function(n_genes = 60L) {
+ genes <- sprintf("GENE%02d", seq_len(n_genes))
+ data.frame(
+ p_val = 0.001,
+ avg_log2FC = rep(seq(3, 0.1, length.out = 20), 3),
+ pct.1 = 0.9,
+ pct.2 = 0.1,
+ p_val_adj = 0.01,
+ cluster = factor(rep(c("0", "1", "2"), each = 20), levels = c("0", "1", "2")),
+ gene = genes[c(1:20, 21:40, 41:60)],
+ stringsAsFactors = FALSE
+ )
+}
+
+# Run code in a temporary working directory.
+local_temp_workdir <- function(env = parent.frame()) {
+ dir <- withr::local_tempdir(.local_envir = env)
+ withr::local_dir(dir, .local_envir = env)
+ dir
+}
diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R
index dd83b77..25d3e44 100644
--- a/tests/testthat/test-api.R
+++ b/tests/testthat/test-api.R
@@ -109,12 +109,52 @@ test_that(".api_response_helper preserves rate-limit guidance", {
conditionMessage(rate_limit_error),
paste0(
"Free-tier limit reached\n",
- "Use your own LLM API key via llm_configs to bypass free-tier limits, ",
- "or wait before retrying."
+ "The limits apply to every job, including jobs that use your own LLM ",
+ "through llm_configs. Wait for the limit to reset before retrying."
)
)
})
+test_that("the rate-limit message never says your own LLM bypasses the limits", {
+ httr2::local_mocked_responses(function(req) {
+ httr2::response(
+ status_code = 429L,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(paste0(
+ '{"detail":{"error_code":"RATE_LIMIT_EXCEEDED",',
+ '"message":"Daily limit reached (10/10). Resets in about 5 hours."}}'
+ ))
+ )
+ })
+
+ rate_limit_error <- tryCatch(
+ CyteTypeR:::.submit_job(list(input_data = list()), "https://api.example.com", "tok"),
+ error = identity
+ )
+
+ message <- conditionMessage(rate_limit_error)
+ expect_match(message, "Daily limit reached (10/10)", fixed = TRUE)
+ expect_match(message, "including jobs that use your own LLM", fixed = TRUE)
+ expect_false(grepl("bypass", message, ignore.case = TRUE))
+})
+
+test_that(".api_response_helper classifies connection failures as network errors", {
+ httr2::local_mocked_responses(function(req) {
+ stop(structure(
+ list(message = "Could not connect to server", call = NULL),
+ class = c("httr2_failure", "httr2_error", "error", "condition")
+ ))
+ })
+
+ error <- tryCatch(
+ CyteTypeR:::.api_response_helper("job-123", "https://api.example.com", "status"),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(error$call, "network")
+})
+
# --- .put_to_presigned_url ---
test_that(".put_to_presigned_url returns ETag on successful PUT", {
@@ -177,3 +217,181 @@ test_that(".put_to_presigned_url raises api error on HTTP 400", {
class = "cytetype_api_error"
)
})
+
+# --- Server error bodies, as FastAPI sends them for the CyteType server ---
+
+# 400 from a route wrapped by the server's capture_core_errors: a plain
+# HTTPException detail is turned into {"error_code": "HTTP_ERROR", ...}.
+ORG_VISIBILITY_WRAPPED <- paste0(
+ '{"detail": {"error_code": "HTTP_ERROR", ',
+ '"message": "Org visibility requires an organization license"}}'
+)
+# An HTTPException outside a wrapped route keeps its plain text detail.
+ORG_VISIBILITY_PLAIN <- '{"detail": "Org visibility requires an organization license"}'
+# FastAPI's request validation error (HTTP 422).
+VISIBILITY_422 <- paste0(
+ '{"detail": [{"type": "literal_error", "loc": ["body", "visibility"], ',
+ '"msg": "Input should be \'private\', \'org\' or \'public\'", "input": "shared", ',
+ '"ctx": {"expected": "\'private\', \'org\' or \'public\'"}}]}'
+)
+
+body_response <- function(status_code, body) {
+ httr2::response(
+ status_code = status_code,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(body)
+ )
+}
+
+test_that(".parse_server_error reads every error body the server sends", {
+ parse <- function(status_code, body) {
+ CyteTypeR:::.parse_server_error(body_response(status_code, body))
+ }
+
+ expect_identical(
+ parse(400L, ORG_VISIBILITY_WRAPPED),
+ list(error_code = "HTTP_ERROR", message = "Org visibility requires an organization license")
+ )
+ expect_identical(
+ parse(400L, ORG_VISIBILITY_PLAIN),
+ list(error_code = NULL, message = "Org visibility requires an organization license")
+ )
+ expect_identical(
+ parse(422L, VISIBILITY_422),
+ list(error_code = NULL, message = "body.visibility: Input should be 'private', 'org' or 'public'")
+ )
+ expect_null(parse(502L, '{"detail": []}'))
+ expect_null(CyteTypeR:::.parse_server_error(httr2::response(
+ status_code = 502L,
+ headers = list("Content-Type" = "text/html"),
+ body = charToRaw("Bad gateway")
+ )))
+})
+
+test_that("job submission errors show the server's explanation", {
+ cases <- list(
+ list(status = 400L, body = ORG_VISIBILITY_WRAPPED,
+ expected = "Job submission failed: [HTTP_ERROR] Org visibility requires an organization license"),
+ list(status = 400L, body = ORG_VISIBILITY_PLAIN,
+ expected = "Job submission failed: Org visibility requires an organization license"),
+ list(status = 422L, body = VISIBILITY_422,
+ expected = "Job submission failed: body.visibility: Input should be 'private', 'org' or 'public'")
+ )
+ for (case in cases) {
+ httr2::local_mocked_responses(function(req) body_response(case$status, case$body))
+
+ error <- tryCatch(
+ CyteTypeR:::.submit_job(list(input_data = list()), "https://api.example.com", "tok"),
+ error = identity
+ )
+
+ expect_identical(conditionMessage(error), case$expected)
+ }
+})
+
+test_that("upload errors show a plain text explanation", {
+ f <- tempfile(fileext = ".duckdb")
+ on.exit(unlink(f), add = TRUE)
+ writeBin(raw(16), f)
+ httr2::local_mocked_responses(function(req) {
+ body_response(403L, '{"detail": "User account is inactive"}')
+ })
+
+ expect_error(
+ CyteTypeR:::.upload_file_chunked("https://api.example.com", "tok", "obs_duckdb", f, 60L,
+ max_workers = 1L, show_progress = FALSE),
+ "^Upload initiate failed: User account is inactive$"
+ )
+})
+
+test_that("status errors with a plain text or 422 body keep the explanation", {
+ httr2::local_mocked_responses(function(req) body_response(400L, ORG_VISIBILITY_PLAIN))
+ error <- tryCatch(
+ CyteTypeR:::.api_response_helper("job-1", "https://api.example.com", "status"),
+ error = identity
+ )
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(
+ conditionMessage(error),
+ "Error while checking job status: HTTP 400 Org visibility requires an organization license"
+ )
+ expect_null(error$error_code)
+
+ httr2::local_mocked_responses(function(req) body_response(422L, VISIBILITY_422))
+ error <- tryCatch(
+ CyteTypeR:::.api_response_helper("job-1", "https://api.example.com", "results"),
+ error = identity
+ )
+ expect_identical(
+ conditionMessage(error),
+ "Error while fetching job results: HTTP 422 body.visibility: Input should be 'private', 'org' or 'public'"
+ )
+})
+
+test_that("cytetype_api_error carries an optional error code", {
+ error <- cytetype_api_error("boom", call = "api", error_code = "REPORT_DELETED")
+ expect_identical(error$error_code, "REPORT_DELETED")
+ expect_null(cytetype_api_error("boom")$error_code)
+ expect_null(conditionCall(error))
+ expect_identical(error$call, "api")
+})
+
+test_that(".api_response_helper records the HTTP status of error responses", {
+ status_error <- function(response, req_item = "results") {
+ httr2::local_mocked_responses(function(req) response)
+ tryCatch(
+ CyteTypeR:::.api_response_helper("job-1", "https://api.example.com", req_item, "tok"),
+ error = identity
+ )
+ }
+
+ unavailable <- status_error(body_response(
+ 503L, '{"detail": {"error_code": "HTTP_ERROR", "message": "Service unavailable"}}'
+ ))
+ expect_s3_class(unavailable, "cytetype_api_error")
+ expect_identical(unavailable$status_code, 503L)
+ expect_identical(unavailable$error_code, "HTTP_ERROR")
+
+ deleted <- status_error(body_response(
+ 410L, '{"detail": {"error_code": "REPORT_DELETED", "message": "This report has been deleted by the owner"}}'
+ ), req_item = "status")
+ expect_identical(deleted$status_code, 410L)
+ expect_identical(deleted$error_code, "REPORT_DELETED")
+
+ rate_limited <- status_error(body_response(
+ 429L, '{"detail": {"error_code": "RATE_LIMIT_EXCEEDED", "message": "Hourly limit reached (5/5)."}}'
+ ))
+ expect_identical(rate_limited$status_code, 429L)
+ expect_identical(rate_limited$error_code, "RATE_LIMIT_EXCEEDED")
+
+ gateway <- status_error(httr2::response(
+ status_code = 502L,
+ headers = list("Content-Type" = "text/html"),
+ body = charToRaw("Bad gateway")
+ ))
+ expect_identical(gateway$status_code, 502L)
+ expect_null(gateway$error_code)
+
+ for (code in c(401L, 403L)) {
+ auth <- status_error(body_response(code, '{"detail": "Invalid API token"}'))
+ expect_s3_class(auth, "cytetype_auth_error")
+ expect_identical(auth$status_code, code)
+ }
+})
+
+test_that("errors without a response have no HTTP status", {
+ httr2::local_mocked_responses(function(req) {
+ stop(structure(
+ list(message = "Could not connect to server", call = NULL),
+ class = c("httr2_failure", "httr2_error", "error", "condition")
+ ))
+ })
+
+ error <- tryCatch(
+ CyteTypeR:::.api_response_helper("job-1", "https://api.example.com", "results"),
+ error = identity
+ )
+
+ expect_identical(error$call, "network")
+ expect_null(error$status_code)
+})
diff --git a/tests/testthat/test-auth.R b/tests/testthat/test-auth.R
index 08d9f35..fd7dd30 100644
--- a/tests/testthat/test-auth.R
+++ b/tests/testthat/test-auth.R
@@ -1090,3 +1090,21 @@ test_that("GetResults supports locally transformed result tables", {
expect_identical(GetResults(obj), expected)
})
+
+test_that("the dashboard opens at /dashboard without saved credentials", {
+ .with_temp_config_home({
+ opened <- character()
+ testthat::local_mocked_bindings(
+ .open_browser_silently = function(url) {
+ opened <<- c(opened, url)
+ TRUE
+ },
+ .package = "CyteTypeR"
+ )
+
+ target <- suppressMessages(OpenCyteTypeDashboard())
+
+ expect_identical(target, "https://cytetype.nygen.io/dashboard")
+ expect_identical(opened, "https://cytetype.nygen.io/dashboard")
+ })
+})
diff --git a/tests/testthat/test-cleanup.R b/tests/testthat/test-cleanup.R
new file mode 100644
index 0000000..53e64e2
--- /dev/null
+++ b/tests/testthat/test-cleanup.R
@@ -0,0 +1,23 @@
+test_that("CleanUpArtifacts removes built files and reports it", {
+ local_temp_workdir()
+ writeLines("h5", "vars.h5")
+ writeLines("duckdb", "obs.duckdb")
+ prepped <- list(build_succeeded = TRUE, vars_h5_path = "vars.h5", obs_duckdb_path = "obs.duckdb")
+
+ expect_true(CleanUpArtifacts(prepped))
+ expect_false(file.exists("vars.h5"))
+ expect_false(file.exists("obs.duckdb"))
+ # Running it again is harmless.
+ expect_true(CleanUpArtifacts(prepped))
+})
+
+test_that("CleanUpArtifacts does nothing when the files were not built", {
+ local_temp_workdir()
+ writeLines("h5", "vars.h5")
+
+ result <- withVisible(CleanUpArtifacts(list(build_succeeded = FALSE, vars_h5_path = "vars.h5")))
+
+ expect_false(result$value)
+ expect_false(result$visible)
+ expect_true(file.exists("vars.h5"))
+})
diff --git a/tests/testthat/test-cli.R b/tests/testthat/test-cli.R
index ab78201..4a92fc0 100644
--- a/tests/testthat/test-cli.R
+++ b/tests/testthat/test-cli.R
@@ -218,3 +218,199 @@ test_that("CLI installer targets the active R environment bin", {
path
)
})
+
+local_config_home <- function(env = parent.frame()) {
+ config_home <- withr::local_tempdir(.local_envir = env)
+ withr::local_envvar(XDG_CONFIG_HOME = config_home, .local_envir = env)
+ config_home
+}
+
+credentials_response <- function(req) {
+ httr2::response(
+ status_code = 200L,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(jsonlite::toJSON(
+ list(
+ tokenId = "token-id",
+ userId = "user-id",
+ email = "researcher@example.com",
+ dashboardUrl = "https://api.example.com/dashboard"
+ ),
+ auto_unbox = TRUE
+ ))
+ )
+}
+
+test_that("cytetyper login reads the API key from stdin when R is not interactive", {
+ local_config_home()
+ authorization <- NULL
+ httr2::local_mocked_responses(function(req) {
+ authorization <<- httr2::req_get_headers(req, "reveal")$Authorization
+ credentials_response(req)
+ })
+ testthat::local_mocked_bindings(
+ .is_interactive = function() FALSE,
+ .stdin_is_terminal = function() FALSE,
+ .read_stdin_line = function() " cyt_p_from_stdin ",
+ .package = "CyteTypeR"
+ )
+
+ messages <- capture.output(
+ status <- CyteTypeR:::.cytetyper_cli_main(c("login", "--api-url=https://api.example.com")),
+ type = "message"
+ )
+
+ expect_identical(status, 0L)
+ expect_identical(CyteTypeR:::.load_credentials()$apiToken, "cyt_p_from_stdin")
+ expect_identical(authorization, "Bearer cyt_p_from_stdin")
+ expect_true(any(grepl("API key: ", messages, fixed = TRUE)))
+ expect_false(any(grepl("cyt_p_from_stdin", messages, fixed = TRUE)))
+})
+
+test_that("cytetyper login hides the key typed into a terminal", {
+ local_config_home()
+ httr2::local_mocked_responses(credentials_response)
+ echo <- logical()
+ testthat::local_mocked_bindings(
+ .is_interactive = function() FALSE,
+ .stdin_is_terminal = function() TRUE,
+ .set_terminal_echo = function(enabled) {
+ echo <<- c(echo, enabled)
+ TRUE
+ },
+ .read_stdin_line = function() "cyt_p_typed",
+ .package = "CyteTypeR"
+ )
+
+ capture.output(
+ status <- CyteTypeR:::.cytetyper_cli_main(c("login", "--api-url=https://api.example.com")),
+ type = "message"
+ )
+
+ expect_identical(status, 0L)
+ expect_identical(echo, c(FALSE, TRUE))
+ expect_identical(CyteTypeR:::.load_credentials()$apiToken, "cyt_p_typed")
+})
+
+test_that("cytetyper login fails clearly when stdin is empty", {
+ local_config_home()
+ testthat::local_mocked_bindings(
+ .is_interactive = function() FALSE,
+ .stdin_is_terminal = function() FALSE,
+ .read_stdin_line = function() character(0),
+ .package = "CyteTypeR"
+ )
+
+ messages <- capture.output(
+ status <- CyteTypeR:::.cytetyper_cli_main("login"),
+ type = "message"
+ )
+
+ expect_identical(status, 1L)
+ expect_true(any(grepl("Error: API key is required", messages, fixed = TRUE)))
+})
+
+test_that("an interactive login still uses the hidden askpass prompt", {
+ local_config_home()
+ httr2::local_mocked_responses(credentials_response)
+ testthat::local_mocked_bindings(
+ .is_interactive = function() TRUE,
+ .read_stdin_line = function() stop("stdin must not be read"),
+ .package = "CyteTypeR"
+ )
+ testthat::local_mocked_bindings(askpass = function(prompt) "cyt_p_prompted", .package = "askpass")
+
+ suppressMessages(LoginCyteTypeR(api_url = "https://api.example.com"))
+
+ expect_identical(CyteTypeR:::.load_credentials()$apiToken, "cyt_p_prompted")
+})
+
+test_that("the API key prompt reads piped stdin in a non-interactive R process", {
+ skip_on_os("windows")
+ functions <- c(".is_interactive", ".read_stdin_line", ".stdin_is_terminal", ".set_terminal_echo", ".prompt_api_key")
+ script <- tempfile(fileext = ".R")
+ on.exit(unlink(script), add = TRUE)
+ definitions <- vapply(
+ functions,
+ function(name) {
+ paste0("`", name, "` <- ", paste(deparse(get(name, envir = asNamespace("CyteTypeR"))), collapse = "\n"))
+ },
+ character(1)
+ )
+ writeLines(c(definitions, "cat(.prompt_api_key(\"API key: \"))"), script)
+ stderr_file <- tempfile()
+ on.exit(unlink(stderr_file), add = TRUE)
+
+ output <- system2(
+ file.path(R.home("bin"), "Rscript"),
+ c("--vanilla", shQuote(script)),
+ stdout = TRUE,
+ stderr = stderr_file,
+ input = "cyt_p_piped_key"
+ )
+
+ expect_identical(output, "cyt_p_piped_key")
+ expect_match(paste(readLines(stderr_file), collapse = "\n"), "API key: ", fixed = TRUE)
+})
+
+test_that("the installed cytetyper launcher saves a key piped to login", {
+ skip_on_os("windows")
+ skip_on_cran()
+ installed <- find.package("CyteTypeR", lib.loc = .libPaths(), quiet = TRUE)
+ skip_if(length(installed) == 0L, "CyteTypeR is not installed in a library")
+ launcher <- file.path(installed[[1L]], "exec", "cytetyper")
+ skip_if_not(file.exists(launcher), "The installed package has no launcher")
+
+ received <- new.env()
+ port <- httpuv::randomPort(host = "127.0.0.1")
+ api_url <- paste0("http://127.0.0.1:", port)
+ server <- httpuv::startServer("127.0.0.1", port, list(call = function(req) {
+ received$path <- req$PATH_INFO
+ received$authorization <- req$HTTP_AUTHORIZATION
+ list(
+ status = 200L,
+ headers = list("Content-Type" = "application/json"),
+ body = as.character(jsonlite::toJSON(
+ list(
+ tokenId = "token-id",
+ userId = "user-id",
+ email = "researcher@example.com",
+ dashboardUrl = paste0(api_url, "/dashboard")
+ ),
+ auto_unbox = TRUE
+ ))
+ )
+ }))
+ on.exit(httpuv::stopServer(server), add = TRUE)
+
+ bin <- withr::local_tempdir()
+ file.copy(launcher, file.path(bin, "cytetyper"))
+ Sys.chmod(file.path(bin, "cytetyper"), mode = "0755")
+ file.symlink(file.path(R.home("bin"), "Rscript"), file.path(bin, "Rscript"))
+ config_home <- local_config_home()
+ withr::local_envvar(
+ R_LIBS = paste(.libPaths(), collapse = .Platform$path.sep),
+ CYTETYPE_API_URL = NA
+ )
+ key_file <- withr::local_tempfile(lines = "cyt_p_launcher_key")
+ output_file <- withr::local_tempfile()
+
+ system2(
+ file.path(bin, "cytetyper"),
+ c("login", "--api-url", api_url),
+ stdin = key_file,
+ stdout = output_file,
+ stderr = output_file,
+ wait = FALSE
+ )
+ credentials_path <- file.path(config_home, "cytetype", "credentials.json")
+ deadline <- Sys.time() + 120
+ while (!file.exists(credentials_path) && Sys.time() < deadline) {
+ httpuv::service(100)
+ }
+
+ expect_true(file.exists(credentials_path))
+ expect_identical(received$path, "/auth/cli/credentials")
+ expect_identical(received$authorization, "Bearer cyt_p_launcher_key")
+ expect_identical(jsonlite::fromJSON(credentials_path)$apiToken, "cyt_p_launcher_key")
+})
diff --git a/tests/testthat/test-client.R b/tests/testthat/test-client.R
index b4da3f1..66bc2b5 100644
--- a/tests/testthat/test-client.R
+++ b/tests/testthat/test-client.R
@@ -220,7 +220,8 @@ test_that(".make_results_request returns 'failed' when results endpoint errors",
)
resp <- CyteTypeR:::.make_results_request("job1", "https://example.com")
expect_identical(resp$status, "failed")
- expect_true(grepl("results unavailable", resp$message))
+ expect_identical(resp$message, "Error while fetching job results: HTTP 409 error: job still processing")
+ expect_s3_class(resp$condition, "cytetype_api_error")
})
test_that(".make_results_request returns 'not_found' on 404 status", {
@@ -278,6 +279,7 @@ test_that("poll stops after consecutive 'error' statuses", {
raw_response = NULL)
},
.sleep_with_spinner = function(...) invisible(NULL),
+ .sleep = function(...) invisible(NULL),
.package = "CyteTypeR"
)
expect_error(
@@ -296,6 +298,7 @@ test_that("poll stops after consecutive 'not_found' statuses", {
raw_response = NULL)
},
.sleep_with_spinner = function(...) invisible(NULL),
+ .sleep = function(...) invisible(NULL),
.package = "CyteTypeR"
)
expect_error(
@@ -314,6 +317,7 @@ test_that("poll stops immediately on truly unknown status", {
raw_response = NULL)
},
.sleep_with_spinner = function(...) invisible(NULL),
+ .sleep = function(...) invisible(NULL),
.package = "CyteTypeR"
)
expect_error(
@@ -333,6 +337,7 @@ test_that("poll returns result on 'completed' status", {
raw_response = list(clusterStatus = list("1" = "completed")))
},
.sleep_with_spinner = function(...) invisible(NULL),
+ .sleep = function(...) invisible(NULL),
.package = "CyteTypeR"
)
result <- CyteTypeR:::.poll_for_results("job1", "https://example.com",
@@ -349,6 +354,7 @@ test_that("poll stops on 'failed' status with server message", {
raw_response = list(clusterStatus = list()))
},
.sleep_with_spinner = function(...) invisible(NULL),
+ .sleep = function(...) invisible(NULL),
.package = "CyteTypeR"
)
expect_error(
@@ -358,3 +364,466 @@ test_that("poll stops on 'failed' status with server message", {
"Server error.*Job failed"
)
})
+
+# --- timeout, retries and hints ---
+
+# A clock that advances `step` seconds on every call.
+fake_clock <- function(step) {
+ now <- as.POSIXct("2026-01-01 00:00:00", tz = "UTC")
+ function() {
+ current <- now
+ now <<- now + step
+ current
+ }
+}
+
+test_that("the polling timeout compares seconds, whatever the difftime units", {
+ # Each check advances two minutes. With automatic difftime units, 0.5.1 read
+ # this as 2, 4, 6, ... "minutes" and never reached a 600 second timeout.
+ calls <- 0L
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ calls <<- calls + 1L
+ if (calls > 50L) stop("the timeout never fired")
+ list(status = "processing", result = NULL, message = "Job is processing",
+ raw_response = list(clusterStatus = list()))
+ },
+ .now = fake_clock(120),
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ error <- tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_timeout_error")
+ expect_identical(error$job_id, "job1")
+ expect_match(conditionMessage(error), "Job job1 did not finish within 600 seconds")
+ expect_match(conditionMessage(error), 'GetResults(job_id = "job1")', fixed = TRUE)
+ expect_false(grepl("timeoutTimeout", conditionMessage(error)))
+ expect_lt(calls, 10L)
+})
+
+test_that("network errors are retried until the timeout", {
+ calls <- 0L
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ calls <<- calls + 1L
+ if (calls <= 8L) {
+ return(list(status = "error", result = NULL,
+ message = "Error checking job status: Could not connect to server",
+ raw_response = NULL, error_type = "network"))
+ }
+ list(status = "completed", result = list(annotations = list()),
+ message = "Job completed successfully", raw_response = list(clusterStatus = list()))
+ },
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ result <- CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE)
+
+ expect_identical(result, list(annotations = list()))
+ expect_identical(calls, 9L)
+})
+
+test_that("other errors stop after five in a row with a GetResults hint", {
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ list(status = "error", result = NULL,
+ message = "Error checking job status: HTTP 500 [INTERNAL_ERROR] boom",
+ raw_response = NULL, error_type = "api")
+ },
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ expect_error(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ 'Stopping after 5 consecutive errors.*GetResults\\(job_id = "job1"\\)'
+ )
+})
+
+test_that(".make_results_request marks connection failures as network errors", {
+ testthat::local_mocked_bindings(
+ .api_response_helper = function(...) {
+ stop(cytetype_api_error("Error while checking job status: Could not connect", call = "network"))
+ },
+ .package = "CyteTypeR"
+ )
+
+ response <- CyteTypeR:::.make_results_request("job1", "https://example.com")
+
+ expect_identical(response$status, "error")
+ expect_identical(response$error_type, "network")
+})
+
+test_that(".make_results_request reports HTTP 202 results as processing", {
+ testthat::local_mocked_bindings(
+ .api_response_helper = function(job_id, api_url, req_item, auth_token = NULL) {
+ if (req_item == "status") {
+ return(list(status_code = 200L, data = list(jobStatus = "completed")))
+ }
+ list(status_code = 202L, data = list(detail = list(error_code = "JOB_PROCESSING")))
+ },
+ .package = "CyteTypeR"
+ )
+
+ response <- CyteTypeR:::.make_results_request("job1", "https://example.com")
+
+ expect_identical(response$status, "processing")
+})
+
+test_that("the hint printed while polling names the job ID", {
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ list(status = "completed", result = list(annotations = list()),
+ message = "Job completed successfully", raw_response = list(clusterStatus = list()))
+ },
+ .sleep = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ output <- capture.output(
+ result <- CyteTypeR:::.poll_for_results("job-42", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ type = "message"
+ )
+
+ expect_true(any(grepl('GetResults(job_id = "job-42")', output, fixed = TRUE)))
+})
+
+test_that("repeated status errors stop the wait with a cytetype_api_error", {
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ condition <- cytetype_api_error(
+ "Error while checking job status: HTTP 503 [HTTP_ERROR] Service unavailable",
+ call = "api",
+ error_code = "HTTP_ERROR"
+ )
+ list(status = "error", result = NULL, message = conditionMessage(condition),
+ raw_response = NULL, error_type = "api", condition = condition)
+ },
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ error <- tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(error$error_code, "HTTP_ERROR")
+ expect_match(conditionMessage(error), "^Stopping after 5 consecutive errors: Error while checking job status: HTTP 503")
+ # The context appears once.
+ expect_identical(lengths(regmatches(conditionMessage(error), gregexpr("Error while checking job status", conditionMessage(error)))), 1L)
+})
+
+test_that("a results fetch failure stops the wait with the cytetype_api_error", {
+ testthat::local_mocked_bindings(
+ .api_response_helper = function(job_id, api_url, req_item, auth_token = NULL) {
+ if (req_item == "status") {
+ return(list(status_code = 200L, data = list(jobStatus = "completed", clusterStatus = list())))
+ }
+ stop(cytetype_api_error(
+ "Error while fetching job results: HTTP 410 [REPORT_DELETED] This report has been deleted by the owner",
+ call = "api",
+ error_code = "REPORT_DELETED"
+ ))
+ },
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ error <- tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(error$error_code, "REPORT_DELETED")
+ expect_identical(
+ conditionMessage(error),
+ "Error while fetching job results: HTTP 410 [REPORT_DELETED] This report has been deleted by the owner"
+ )
+})
+
+# --- Results of a completed job: transient errors are retried ---
+
+http_json <- function(status_code, body) {
+ httr2::response(
+ status_code = status_code,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(as.character(jsonlite::toJSON(body, auto_unbox = TRUE, null = "null")))
+ )
+}
+
+server_error <- function(status_code, error_code, message) {
+ http_json(status_code, list(detail = list(error_code = error_code, message = message)))
+}
+
+no_connection <- function() {
+ stop(structure(
+ list(message = "Could not connect to server", call = NULL),
+ class = c("httr2_failure", "httr2_error", "error", "condition")
+ ))
+}
+
+# The status endpoint reports a completed job. The results endpoint answers
+# with the elements of `results` in turn, repeating the last one; a function
+# is called instead, to fail without a response.
+mock_completed_job <- function(results, env = parent.frame()) {
+ calls <- new.env()
+ calls$results <- 0L
+ httr2::local_mocked_responses(function(req) {
+ if (grepl("/status/", req$url)) {
+ return(http_json(200L, list(jobStatus = "completed", clusterStatus = list())))
+ }
+ calls$results <- calls$results + 1L
+ answer <- results[[min(calls$results, length(results))]]
+ if (is.function(answer)) answer() else answer
+ }, env = env)
+ calls
+}
+
+test_that("only transient results fetch errors are retried while waiting", {
+ cases <- list(
+ list(answer = server_error(500L, "INTERNAL_ERROR", "boom"), status = "error"),
+ list(answer = http_json(502L, list(detail = "Bad gateway")), status = "error"),
+ list(answer = server_error(503L, "HTTP_ERROR", "Service unavailable"), status = "error"),
+ list(answer = http_json(504L, list(detail = "Gateway timeout")), status = "error"),
+ list(answer = server_error(429L, "RATE_LIMIT_EXCEEDED", "Hourly limit reached (5/5)."), status = "error"),
+ list(answer = no_connection, status = "error"),
+ list(answer = server_error(410L, "REPORT_DELETED", "This report has been deleted by the owner"), status = "failed"),
+ list(answer = http_json(400L, list(detail = "Bad request")), status = "failed"),
+ list(answer = httr2::response(status_code = 404L), status = "failed")
+ )
+ for (case in cases) {
+ mock_completed_job(list(case$answer))
+
+ response <- CyteTypeR:::.make_results_request("job1", "https://example.com")
+
+ label <- if (is.function(case$answer)) "no response" else as.character(httr2::resp_status(case$answer))
+ expect_identical(response$status, case$status, info = label)
+ }
+})
+
+test_that("a transient results error followed by success returns the results", {
+ calls <- mock_completed_job(list(
+ server_error(503L, "HTTP_ERROR", "Service unavailable"),
+ http_json(200L, list(annotations = list(list(clusterId = "1", annotation = "T cell"))))
+ ))
+ testthat::local_mocked_bindings(
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ result <- CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE)
+
+ expect_identical(result$annotations[[1]]$annotation, "T cell")
+ expect_identical(calls$results, 2L)
+})
+
+test_that("a deleted report stops the wait at the first results request", {
+ calls <- mock_completed_job(list(
+ server_error(410L, "REPORT_DELETED", "This report has been deleted by the owner")
+ ))
+ testthat::local_mocked_bindings(
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ error <- tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(error$error_code, "REPORT_DELETED")
+ expect_identical(error$status_code, 410L)
+ expect_identical(
+ conditionMessage(error),
+ "Error while fetching job results: HTTP 410 [REPORT_DELETED] This report has been deleted by the owner"
+ )
+ expect_identical(calls$results, 1L)
+})
+
+test_that("five transient results errors in a row stop the wait", {
+ calls <- mock_completed_job(list(
+ server_error(503L, "HTTP_ERROR", "Service unavailable")
+ ))
+ testthat::local_mocked_bindings(
+ .sleep = function(...) invisible(NULL),
+ .sleep_with_spinner = function(...) invisible(NULL),
+ .package = "CyteTypeR"
+ )
+
+ error <- tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = 0, timeout = 600,
+ show_progress = FALSE),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(
+ conditionMessage(error),
+ paste0(
+ "Stopping after 5 consecutive errors: Error while fetching job results: ",
+ "HTTP 503 [HTTP_ERROR] Service unavailable\n",
+ "The job may still be running; retrieve its results later with ",
+ 'GetResults(job_id = "job1").'
+ )
+ )
+ expect_identical(error$error_code, "HTTP_ERROR")
+ expect_identical(error$status_code, 503L)
+ expect_identical(calls$results, 5L)
+})
+
+# --- The deadline ---
+
+# A clock that moves only when the poll waits or a mocked request takes time.
+# It records every wait.
+fake_timeline <- function() {
+ start <- as.POSIXct("2026-01-01 00:00:00", tz = "UTC")
+ state <- new.env()
+ state$now <- start
+ state$waits <- numeric()
+ list(
+ now = function() state$now,
+ advance = function(seconds) state$now <- state$now + seconds,
+ wait = function(seconds, ...) {
+ state$waits <- c(state$waits, seconds)
+ state$now <- state$now + seconds
+ invisible(NULL)
+ },
+ waits = function() state$waits,
+ elapsed = function() as.numeric(difftime(state$now, start, units = "secs"))
+ )
+}
+
+# Poll with the clock, answering every request with `respond()`.
+poll_with_clock <- function(clock, respond, poll_interval, timeout) {
+ testthat::with_mocked_bindings(
+ tryCatch(
+ CyteTypeR:::.poll_for_results("job1", "https://example.com",
+ poll_interval = poll_interval,
+ timeout = timeout,
+ show_progress = FALSE),
+ error = identity
+ ),
+ .make_results_request = function(...) respond(),
+ .now = clock$now,
+ .sleep = clock$wait,
+ .sleep_with_spinner = clock$wait,
+ .package = "CyteTypeR"
+ )
+}
+
+test_that("no wait runs past the deadline", {
+ answer <- function(status, error_type = NULL) {
+ list(status = status, result = NULL, message = paste("Job is", status),
+ raw_response = list(clusterStatus = list()), error_type = error_type)
+ }
+ # timeout 12 s, poll interval 10 s: the 5 s initial wait, then waits cut to
+ # the 7 s left. Network errors are retried every 5 s.
+ cases <- list(
+ list(answer = answer("processing"), waits = c(5, 7)),
+ list(answer = answer("pending"), waits = c(5, 7)),
+ list(answer = answer("not_found"), waits = c(5, 7)),
+ list(answer = answer("error", "api"), waits = c(5, 7)),
+ list(answer = answer("error", "network"), waits = c(5, 5, 2))
+ )
+ for (case in cases) {
+ clock <- fake_timeline()
+ requests <- 0L
+
+ error <- poll_with_clock(clock, function() {
+ requests <<- requests + 1L
+ if (requests > 20L) stop("the timeout never fired")
+ case$answer
+ }, poll_interval = 10, timeout = 12)
+
+ label <- paste(case$answer$status, case$answer$error_type)
+ expect_s3_class(error, "cytetype_timeout_error")
+ expect_identical(clock$waits(), case$waits, info = label)
+ # The deadline is reached exactly, not overshot.
+ expect_identical(clock$elapsed(), 12, info = label)
+ expect_identical(requests, length(case$waits) - 1L, info = label)
+ }
+})
+
+test_that("a timeout shorter than the initial wait ends it", {
+ clock <- fake_timeline()
+ requests <- 0L
+
+ error <- poll_with_clock(clock, function() {
+ requests <<- requests + 1L
+ stop("no request is made after the deadline")
+ }, poll_interval = 10, timeout = 3)
+
+ expect_s3_class(error, "cytetype_timeout_error")
+ expect_identical(clock$waits(), 3)
+ expect_identical(requests, 0L)
+})
+
+test_that("results found by a request that ends after the deadline are returned", {
+ clock <- fake_timeline()
+ requests <- 0L
+
+ result <- poll_with_clock(clock, function() {
+ requests <<- requests + 1L
+ if (requests == 1L) {
+ return(list(status = "processing", result = NULL, message = "Job is processing",
+ raw_response = list(clusterStatus = list())))
+ }
+ # Starts at 15 s, before the 20 s deadline, and ends at 23 s.
+ clock$advance(8)
+ list(status = "completed", result = list(annotations = list()),
+ message = "Job completed successfully", raw_response = list(clusterStatus = list()))
+ }, poll_interval = 10, timeout = 20)
+
+ expect_identical(result, list(annotations = list()))
+ expect_identical(clock$waits(), c(5, 10))
+ expect_identical(clock$elapsed(), 23)
+})
+
+test_that("the spinner sleeps the whole wait, including a last partial step", {
+ waits <- numeric()
+ testthat::local_mocked_bindings(
+ .sleep = function(seconds) waits <<- c(waits, seconds),
+ .package = "CyteTypeR"
+ )
+
+ CyteTypeR:::.sleep_with_spinner(1.2, list(), show_progress = FALSE)
+ expect_equal(waits, c(0.5, 0.5, 0.2))
+
+ waits <- numeric()
+ CyteTypeR:::.sleep_with_spinner(0, list(), show_progress = FALSE)
+ expect_length(waits, 0L)
+})
diff --git a/tests/testthat/test-cytetype-api-error.R b/tests/testthat/test-cytetype-api-error.R
index 1a8b0e9..916c54a 100644
--- a/tests/testthat/test-cytetype-api-error.R
+++ b/tests/testthat/test-cytetype-api-error.R
@@ -9,3 +9,11 @@ test_that("print.cytetype_api_error shows message", {
e <- cytetype_api_error(message = "test message", call = NULL)
expect_output(print(e), "CyteType API Error:.*test message")
})
+
+test_that("cytetype_api_error carries an optional HTTP status", {
+ e <- cytetype_api_error("boom", call = "api", error_code = "HTTP_ERROR", status_code = 503L)
+ expect_identical(e$status_code, 503L)
+ expect_identical(e$error_code, "HTTP_ERROR")
+ expect_true("status_code" %in% names(cytetype_api_error("boom")))
+ expect_null(cytetype_api_error("boom")$status_code)
+})
diff --git a/tests/testthat/test-cytetype-build-upload.R b/tests/testthat/test-cytetype-build-upload.R
index 76c973c..4ef141a 100644
--- a/tests/testthat/test-cytetype-build-upload.R
+++ b/tests/testthat/test-cytetype-build-upload.R
@@ -222,3 +222,228 @@ test_that("completed workflow stores results that GetResults can return", {
out@misc$cytetype_results
)
})
+
+test_that("visibility is validated and sent as a top-level body key", {
+ captured <- NULL
+ testthat::local_mocked_bindings(
+ .submit_job = function(payload, api_url, auth_token = NULL) {
+ captured <<- payload
+ "job1"
+ },
+ .poll_for_results = function(...) NULL,
+ .package = "CyteTypeR"
+ )
+ x <- .local_seurat_and_prepped(build_succeeded = FALSE)
+
+ out <- CyteTypeR::CyteTypeR(
+ x$obj, x$prepped_data,
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ require_artifacts = FALSE,
+ visibility = "org"
+ )
+
+ expect_identical(captured$visibility, "org")
+ expect_false("visibility" %in% names(captured$input_data))
+ expect_identical(out@misc$cytetype_jobDetails$visibility, "org")
+ body <- jsonlite::fromJSON(
+ as.character(jsonlite::toJSON(captured, auto_unbox = TRUE, null = "null")),
+ simplifyVector = FALSE
+ )
+ expect_identical(body$visibility, "org")
+})
+
+test_that("visibility is omitted from the request by default", {
+ captured <- NULL
+ testthat::local_mocked_bindings(
+ .submit_job = function(payload, api_url, auth_token = NULL) {
+ captured <<- payload
+ "job1"
+ },
+ .poll_for_results = function(...) NULL,
+ .package = "CyteTypeR"
+ )
+ x <- .local_seurat_and_prepped(build_succeeded = FALSE)
+
+ out <- CyteTypeR::CyteTypeR(
+ x$obj, x$prepped_data,
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ require_artifacts = FALSE
+ )
+
+ expect_false("visibility" %in% names(captured))
+ expect_false("visibility" %in% names(out@misc$cytetype_jobDetails))
+})
+
+test_that("an invalid visibility stops before uploads or submission", {
+ testthat::local_mocked_bindings(
+ .upload_obs_duckdb = function(...) stop("unexpected upload"),
+ .submit_job = function(...) stop("unexpected submission"),
+ .package = "CyteTypeR"
+ )
+ x <- .local_seurat_and_prepped(build_succeeded = TRUE)
+
+ for (visibility in list("shared", c("private", "org"), NA_character_, 1)) {
+ expect_error(
+ CyteTypeR::CyteTypeR(
+ x$obj, x$prepped_data,
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ visibility = visibility
+ ),
+ "visibility must be"
+ )
+ }
+})
+
+ORG_VISIBILITY_WARNING <- paste0(
+ 'visibility = "org" needs an organization API key, and this key looks like ',
+ 'a personal key (cyt_p_...). If it is, the server rejects the job after the ',
+ 'upload. Use an organization key, or choose "private" or "public".'
+)
+
+# Uploads and submission that record what reached them.
+.local_recorded_job <- function(env = parent.frame()) {
+ calls <- new.env()
+ calls$uploads <- character()
+ calls$payload <- NULL
+ testthat::local_mocked_bindings(
+ .upload_obs_duckdb = function(...) {
+ calls$uploads <- c(calls$uploads, "obs_duckdb")
+ list(upload_id = "obs-1")
+ },
+ .upload_vars_h5 = function(...) {
+ calls$uploads <- c(calls$uploads, "vars_h5")
+ list(upload_id = "vars-1")
+ },
+ .submit_job = function(payload, api_url, auth_token = NULL) {
+ calls$payload <- payload
+ "job1"
+ },
+ .poll_for_results = function(...) NULL,
+ .package = "CyteTypeR",
+ .env = env
+ )
+ calls
+}
+
+# Run CyteTypeR() with the uploads of the prepared files; return the object
+# and the lines it logged to the console.
+.run_with_uploads <- function(...) {
+ x <- .local_seurat_and_prepped(build_succeeded = TRUE)
+ out <- NULL
+ log <- capture.output(
+ out <- CyteTypeR::CyteTypeR(
+ x$obj, x$prepped_data,
+ api_url = "https://example.com",
+ save_query = FALSE,
+ ...
+ ),
+ type = "message"
+ )
+ list(out = out, log = log)
+}
+
+.org_warnings <- function(log) which(grepl(ORG_VISIBILITY_WARNING, log, fixed = TRUE))
+
+test_that("org visibility with a personal-looking key warns once and continues", {
+ saved_credentials <- list(
+ apiUrl = "https://example.com",
+ dashboardUrl = "https://example.com/dashboard",
+ apiToken = "cyt_p_saved-secret",
+ tokenId = "token-id",
+ userId = "user-id",
+ email = "researcher@example.com"
+ )
+ testthat::local_mocked_bindings(
+ .load_credentials = function(api_url = NULL) saved_credentials,
+ .package = "CyteTypeR"
+ )
+
+ # An explicit key, and a key saved by SetupCyteTypeR() or LoginCyteTypeR().
+ for (auth_token in list("cyt_p_explicit-secret", NULL)) {
+ label <- if (is.null(auth_token)) "saved key" else "explicit key"
+ calls <- .local_recorded_job()
+
+ run <- .run_with_uploads(auth_token = auth_token, visibility = "org")
+
+ warned <- .org_warnings(run$log)
+ expect_length(warned, 1L)
+ # A WARN-level line; on GitHub Actions logger formats it as a
+ # "::warning title=WARN::" annotation instead of "WARN [...]".
+ expect_match(run$log[warned], "WARN", fixed = TRUE, info = label)
+ # Logged before the upload starts.
+ uploading <- which(grepl("Uploading obs.duckdb", run$log, fixed = TRUE))
+ expect_true(length(uploading) == 1L && warned < uploading, info = label)
+ expect_false(any(grepl("secret", run$log, fixed = TRUE)), info = label)
+ # The run continues.
+ expect_s4_class(run$out, "Seurat")
+ expect_identical(calls$uploads, c("obs_duckdb", "vars_h5"), info = label)
+ expect_identical(calls$payload$visibility, "org", info = label)
+ }
+})
+
+test_that("org visibility with an organization key does not warn", {
+ calls <- .local_recorded_job()
+
+ run <- .run_with_uploads(auth_token = "cyt_organization-secret", visibility = "org")
+
+ expect_length(.org_warnings(run$log), 0L)
+ expect_s4_class(run$out, "Seurat")
+ expect_identical(calls$uploads, c("obs_duckdb", "vars_h5"))
+ expect_identical(calls$payload$visibility, "org")
+})
+
+test_that("private, public and the default visibility do not warn", {
+ for (visibility in list("private", "public", NULL)) {
+ label <- if (is.null(visibility)) "NULL" else visibility
+ calls <- .local_recorded_job()
+
+ run <- .run_with_uploads(auth_token = "cyt_p_personal-secret", visibility = visibility)
+
+ expect_length(.org_warnings(run$log), 0L)
+ expect_identical(calls$uploads, c("obs_duckdb", "vars_h5"), info = label)
+ expect_identical(calls$payload$visibility, visibility, info = label)
+ }
+})
+
+test_that("visibility is the last argument of CyteTypeR()", {
+ formals_names <- names(formals(CyteTypeR::CyteTypeR))
+ expect_identical(formals_names[length(formals_names)], "visibility")
+ expect_null(formals(CyteTypeR::CyteTypeR)$visibility)
+})
+
+test_that("an interrupted run points to GetResults(job_id = ...)", {
+ testthat::local_mocked_bindings(
+ .submit_job = function(...) "job-77",
+ .poll_for_results = function(...) {
+ signalCondition(structure(
+ list(message = "", call = NULL),
+ class = c("interrupt", "condition")
+ ))
+ stop("not reached")
+ },
+ .package = "CyteTypeR"
+ )
+ x <- .local_seurat_and_prepped(build_succeeded = FALSE)
+
+ # The exiting handler stands in for R's top level, which ends the run.
+ expect_message(
+ outcome <- tryCatch(
+ CyteTypeR::CyteTypeR(
+ x$obj, x$prepped_data,
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ require_artifacts = FALSE
+ ),
+ interrupt = function(cnd) "interrupted"
+ ),
+ 'GetResults\\(job_id = "job-77"\\)'
+ )
+ expect_identical(outcome, "interrupted")
+})
diff --git a/tests/testthat/test-gene-symbols.R b/tests/testthat/test-gene-symbols.R
new file mode 100644
index 0000000..772f568
--- /dev/null
+++ b/tests/testthat/test-gene-symbols.R
@@ -0,0 +1,91 @@
+# Gene ID detection, ported from _is_gene_id_like in the Python SDK.
+
+test_that(".is_gene_id_like flags gene IDs", {
+ ids <- c(
+ "ENSG00000000003", "ENSG00000000003.14", "ENSMUSG00000000001", "ensg00000000003",
+ "NM_001301", "NR_046018", "XM_011541", "XR_001737",
+ "7157", "672", "11286", "0",
+ "7157.0", "672.0", "11286.0", "0.0",
+ "AFFY_HG_U133A.207163_S_AT", "ILLUMINA_HUMANHT_12_V4.ILMN_1762337",
+ " ENSG00000000003 "
+ )
+ expect_true(all(CyteTypeR:::.is_gene_id_like(ids)))
+})
+
+test_that(".is_gene_id_like does not flag gene symbols or blanks", {
+ values <- c("TSPAN6", "DPM1", "SCYL3", "TP53", "BRCA1", "CD8A", "MS4A1", "HLA-DRA",
+ "", " ", "7157.5", NA, "XENSG00000000003", "AC000061.1")
+ expect_false(any(CyteTypeR:::.is_gene_id_like(values)))
+})
+
+test_that(".id_like_percentage matches the Python SDK", {
+ pct <- CyteTypeR:::.id_like_percentage
+ expect_identical(pct(c("TSPAN6", "DPM1", "SCYL3", "TP53", "BRCA1")), 0)
+ expect_identical(pct(sprintf("ENSG%011d", 0:19)), 100)
+ expect_identical(pct(c("7157.0", "672.0", "3845.0", "11286.0", "9952.0")), 100)
+ expect_equal(pct(c("TSPAN6", "DPM1", "SCYL3", "7157.0", "672.0", "3845.0", "11286.0", "9952.0", "904.0", "405.0")), 70)
+ expect_identical(pct(character(0)), 100)
+})
+
+test_that("the marker table check warns when the genes are IDs", {
+ markers <- data.frame(
+ cluster = rep(c("0", "1"), each = 5),
+ gene = sprintf("ENSG%011d", 1:10),
+ avg_log2FC = 1
+ )
+
+ output <- capture.output(
+ CyteTypeR:::.validate_marker_table(markers, c("0", "1")),
+ type = "message"
+ )
+
+ expect_true(any(grepl("100.0% of the genes in the marker table look like gene IDs", output, fixed = TRUE)))
+})
+
+test_that("the marker table check accepts gene symbols", {
+ markers <- data.frame(
+ cluster = rep(c("0", "1"), each = 5),
+ gene = c("CD3E", "CD8A", "GZMK", "NKG7", "CCL5", "MS4A1", "CD79A", "CD19", "PAX5", "BANK1"),
+ avg_log2FC = 1
+ )
+
+ output <- capture.output(
+ CyteTypeR:::.validate_marker_table(markers, c("0", "1")),
+ type = "message"
+ )
+
+ expect_false(any(grepl("look like gene IDs", output, fixed = TRUE)))
+ expect_true(any(grepl("Found gene symbols", output, fixed = TRUE)))
+})
+
+test_that("the gene symbol check warns for versioned Ensembl row names", {
+ counts <- Matrix::sparseMatrix(
+ i = 1:6, j = 1:6, x = 1, dims = c(6L, 6L),
+ dimnames = list(sprintf("ENSG%011d.%d", 1:6, 2L), paste0("c", 1:6))
+ )
+ obj <- suppressWarnings(SeuratObject::CreateSeuratObject(counts = counts))
+
+ output <- capture.output(
+ suppressMessages(CyteTypeR:::.validate_gene_symbols(obj, "gene_symbols")),
+ type = "message"
+ )
+
+ expect_true(any(grepl("appear to be gene IDs", output, fixed = TRUE)))
+})
+
+test_that("the gene symbol check reads the named feature column", {
+ counts <- Matrix::sparseMatrix(
+ i = 1:4, j = 1:4, x = 1, dims = c(4L, 4L),
+ dimnames = list(sprintf("ENSG%011d", 1:4), paste0("c", 1:4))
+ )
+ obj <- suppressWarnings(SeuratObject::CreateSeuratObject(counts = counts))
+ symbols <- stats::setNames(c("CD3E", "CD8A", "MS4A1", "CD19"), rownames(obj))
+ obj[["RNA"]] <- SeuratObject::AddMetaData(obj[["RNA"]], symbols, col.name = "gene_symbols")
+
+ output <- capture.output(
+ expect_no_message(CyteTypeR:::.validate_gene_symbols(obj, "gene_symbols")),
+ type = "message"
+ )
+
+ expect_false(any(grepl("gene IDs", output, fixed = TRUE)))
+})
diff --git a/tests/testthat/test-get-results.R b/tests/testthat/test-get-results.R
new file mode 100644
index 0000000..c8b930a
--- /dev/null
+++ b/tests/testthat/test-get-results.R
@@ -0,0 +1,302 @@
+# GetResults() by job ID: status first, NULL while running, optional JSON file.
+
+mock_results_api <- function(status = "completed", results_status = 200L, results_body = results_response()) {
+ requests <- character()
+ httr2::local_mocked_responses(function(req) {
+ requests <<- c(requests, req$url)
+ json <- function(code, body) {
+ httr2::response(
+ status_code = code,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(as.character(jsonlite::toJSON(body, auto_unbox = TRUE, null = "null")))
+ )
+ }
+ if (grepl("/status/", req$url)) {
+ return(json(200L, list(jobStatus = status, clusterStatus = list(`1` = status))))
+ }
+ if (grepl("/results/", req$url)) {
+ if (results_status == 202L) {
+ return(json(202L, list(detail = list(
+ error_code = "JOB_PROCESSING",
+ message = "Job job-1 is still processing. Please check status endpoint for progress"
+ ))))
+ }
+ return(json(results_status, results_body))
+ }
+ httr2::response(status_code = 404L)
+ }, env = parent.frame())
+ environment()
+}
+
+test_that("GetResults(job_id) on a running job returns NULL with a message", {
+ local_temp_workdir()
+ api <- mock_results_api(status = "processing")
+
+ expect_message(
+ result <- GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ "still processing"
+ )
+
+ expect_null(result)
+ expect_false(file.exists("cytetypeR_results_job-1.json"))
+ # Only the status was requested.
+ expect_identical(api$requests, "https://api.example.com/status/job-1")
+})
+
+test_that("GetResults(job_id) treats HTTP 202 from the results endpoint as still running", {
+ local_temp_workdir()
+ mock_results_api(status = "completed", results_status = 202L)
+
+ expect_message(
+ result <- GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ "GetResults\\(job_id = \"job-1\"\\)"
+ )
+ expect_null(result)
+ expect_false(file.exists("cytetypeR_results_job-1.json"))
+})
+
+test_that("GetResults(job_id) returns the normalized table and can skip the JSON file", {
+ local_temp_workdir()
+ mock_results_api(status = "completed")
+
+ table <- GetResults(
+ job_id = "job-1",
+ api_url = "https://api.example.com",
+ auth_token = "tok",
+ save_json = FALSE
+ )
+
+ expect_s3_class(table, "data.frame")
+ expect_identical(names(table), c(EXISTING_TABLE_COLUMNS, SDK_KEYS))
+ # Without the object there is no label map, so clusterId is the CyteType ID.
+ expect_identical(table$clusterId, c("1", "2", "3"))
+ expect_identical(table$supportingMarkers[3], "CD8A; CD8B; GZMK")
+ expect_identical(table$reviewerConfidence, c("High", "Moderate", "Low"))
+ expect_identical(attr(table, "job_id"), "job-1")
+ expect_identical(names(attr(table, "result")$raw_annotations), as.character(1:5))
+ expect_length(list.files(), 0L)
+})
+
+test_that("GetResults(job_id) saves the server's response by default", {
+ local_temp_workdir()
+ mock_results_api(status = "completed")
+
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok")
+
+ expect_true(file.exists("cytetypeR_results_job-1.json"))
+ saved <- jsonlite::fromJSON("cytetypeR_results_job-1.json", simplifyVector = FALSE)
+ expect_identical(names(saved$annotations), as.character(1:5))
+})
+
+test_that("GetResults(job_id) stops when the job failed", {
+ local_temp_workdir()
+ mock_results_api(status = "failed")
+
+ expect_error(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ "Job failed"
+ )
+})
+
+test_that("GetResults(job_id) returns NULL with a message when the job is unknown", {
+ local_temp_workdir()
+ httr2::local_mocked_responses(function(req) {
+ httr2::response(status_code = 404L)
+ })
+
+ expect_message(
+ result <- GetResults(job_id = "missing", api_url = "https://api.example.com", auth_token = "tok"),
+ "was not found"
+ )
+ expect_null(result)
+})
+
+test_that("GetResults(obj) messages while the stored job is still running", {
+ obj <- SeuratObject::CreateSeuratObject(
+ Matrix::sparseMatrix(i = c(1L, 2L), j = c(1L, 2L), x = c(1, 1), dims = c(2L, 2L))
+ )
+ obj@misc$cytetype_jobDetails <- list(job_id = "job-1", api_url = "https://api.example.com")
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) list(status = "processing", result = NULL),
+ .package = "CyteTypeR"
+ )
+
+ expect_message(result <- GetResults(obj, auth_token = "tok", api_url = "https://api.example.com"), "still processing")
+ expect_null(result)
+})
+
+test_that("GetResults(obj) normalizes results fetched for the stored job", {
+ obj <- SeuratObject::CreateSeuratObject(
+ Matrix::sparseMatrix(i = c(1L, 2L), j = c(1L, 2L), x = c(1, 1), dims = c(2L, 2L))
+ )
+ obj@misc$cytetype_jobDetails <- list(job_id = "job-1", api_url = "https://api.example.com")
+ testthat::local_mocked_bindings(
+ .make_results_request = function(...) {
+ list(status = "completed", result = as_api_json(results_response()))
+ },
+ .package = "CyteTypeR"
+ )
+
+ result <- GetResults(obj, auth_token = "tok", api_url = "https://api.example.com")
+
+ expect_type(result, "list")
+ annotations <- by_cluster(result)
+ expect_identical(legacy_values(annotations[["3"]]), EXPECTED_FILL)
+ expect_identical(annotations[["3"]]$reviewerConfidence, "Low")
+ expect_identical(result$semanticOrder, list("1", "2", "3"))
+})
+
+# --- Errors while fetching the status or the results ---
+
+json_response <- function(code, body) {
+ httr2::response(
+ status_code = code,
+ headers = list("Content-Type" = "application/json"),
+ body = charToRaw(as.character(jsonlite::toJSON(body, auto_unbox = TRUE, null = "null")))
+ )
+}
+
+report_deleted <- function(req) {
+ json_response(410L, list(detail = list(
+ error_code = "REPORT_DELETED",
+ message = "This report has been deleted by the owner"
+ )))
+}
+
+test_that("GetResults(job_id) signals one clean cytetype_api_error for a deleted report", {
+ local_temp_workdir()
+ httr2::local_mocked_responses(report_deleted)
+
+ error <- tryCatch(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_false(inherits(error, "cytetype_auth_error"))
+ expect_identical(
+ conditionMessage(error),
+ "Error while checking job status: HTTP 410 [REPORT_DELETED] This report has been deleted by the owner"
+ )
+ expect_identical(error$error_code, "REPORT_DELETED")
+ expect_identical(error$call, "api")
+ # Printed as "Error: ", not 'Error in "api" : '.
+ expect_null(conditionCall(error))
+})
+
+test_that("GetResults(obj) signals the same condition for a stored job", {
+ obj <- SeuratObject::CreateSeuratObject(
+ Matrix::sparseMatrix(i = c(1L, 2L), j = c(1L, 2L), x = c(1, 1), dims = c(2L, 2L))
+ )
+ obj@misc$cytetype_jobDetails <- list(job_id = "job-1", api_url = "https://api.example.com")
+ httr2::local_mocked_responses(report_deleted)
+
+ expect_error(
+ GetResults(obj, auth_token = "tok", api_url = "https://api.example.com"),
+ "^Error while checking job status: HTTP 410 \\[REPORT_DELETED\\] This report has been deleted by the owner$",
+ class = "cytetype_api_error"
+ )
+})
+
+test_that("a failed results request is a cytetype_api_error with the server's code", {
+ local_temp_workdir()
+ httr2::local_mocked_responses(function(req) {
+ if (grepl("/status/", req$url)) {
+ return(json_response(200L, list(jobStatus = "completed")))
+ }
+ json_response(500L, list(detail = list(
+ error_code = "INTERNAL_ERROR",
+ message = "An unexpected error occurred: disk full"
+ )))
+ })
+
+ error <- tryCatch(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(
+ conditionMessage(error),
+ "Error while fetching job results: HTTP 500 [INTERNAL_ERROR] An unexpected error occurred: disk full"
+ )
+ expect_identical(error$error_code, "INTERNAL_ERROR")
+ expect_identical(error$status_code, 500L)
+ expect_false(file.exists("cytetypeR_results_job-1.json"))
+})
+
+test_that("GetResults(job_id) does not wait out a transient results error", {
+ local_temp_workdir()
+ requests <- character()
+ httr2::local_mocked_responses(function(req) {
+ requests <<- c(requests, req$url)
+ if (grepl("/status/", req$url)) {
+ return(json_response(200L, list(jobStatus = "completed")))
+ }
+ json_response(503L, list(detail = list(
+ error_code = "HTTP_ERROR",
+ message = "Service unavailable"
+ )))
+ })
+
+ expect_error(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ "^Error while fetching job results: HTTP 503 \\[HTTP_ERROR\\] Service unavailable$",
+ class = "cytetype_api_error"
+ )
+ # One status request and one results request, as before.
+ expect_identical(
+ requests,
+ c("https://api.example.com/status/job-1", "https://api.example.com/results/job-1")
+ )
+})
+
+test_that("a connection failure is a network cytetype_api_error with one prefix", {
+ httr2::local_mocked_responses(function(req) {
+ stop(structure(
+ list(message = "Could not connect to server", call = NULL),
+ class = c("httr2_failure", "httr2_error", "error", "condition")
+ ))
+ })
+
+ error <- tryCatch(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(conditionMessage(error), "Error while checking job status: Could not connect to server")
+ expect_identical(error$call, "network")
+ expect_null(error$error_code)
+})
+
+test_that("a rate-limited status check carries the code and the advice", {
+ httr2::local_mocked_responses(function(req) {
+ json_response(429L, list(detail = list(
+ error_code = "RATE_LIMIT_EXCEEDED",
+ message = "Daily limit reached (10/10). Resets in about 5 hours."
+ )))
+ })
+
+ error <- tryCatch(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ error = identity
+ )
+
+ expect_s3_class(error, "cytetype_api_error")
+ expect_identical(error$error_code, "RATE_LIMIT_EXCEEDED")
+ expect_match(conditionMessage(error), "^Daily limit reached \\(10/10\\)")
+ expect_match(conditionMessage(error), "including jobs that use your own LLM", fixed = TRUE)
+})
+
+test_that("authentication failures are still cytetype_auth_error", {
+ for (code in c(401L, 403L)) {
+ httr2::local_mocked_responses(function(req) {
+ json_response(code, list(detail = "Invalid API token"))
+ })
+ expect_error(
+ GetResults(job_id = "job-1", api_url = "https://api.example.com", auth_token = "tok"),
+ class = "cytetype_auth_error"
+ )
+ }
+})
diff --git a/tests/testthat/test-normalization.R b/tests/testthat/test-normalization.R
new file mode 100644
index 0000000..e5245c5
--- /dev/null
+++ b/tests/testthat/test-normalization.R
@@ -0,0 +1,433 @@
+# The results normalization rules shared with the CyteType server and the
+# Python SDK. These tests mirror tests/test_results_normalization.py.
+
+test_that("every stored result generation is normalized", {
+ response <- results_response()
+ before <- response
+
+ result <- CyteTypeR:::.normalize_results(response)
+ annotations <- by_cluster(result)
+
+ # Clusters without an annotation object are skipped.
+ expect_identical(names(annotations), c("1", "2", "3"))
+ expect_identical(legacy_values(annotations[["1"]]), LEGACY_EVIDENCE)
+ expect_identical(legacy_values(annotations[["2"]]), EXPECTED_FILL)
+ expect_identical(legacy_values(annotations[["3"]]), EXPECTED_FILL)
+ expect_identical(
+ sdk_values(annotations[["1"]]),
+ list(reviewerConfidence = "High", isHeterogeneous = NULL, heterogeneityType = NULL)
+ )
+ expect_identical(
+ sdk_values(annotations[["2"]]),
+ list(reviewerConfidence = "Moderate", isHeterogeneous = FALSE, heterogeneityType = NULL)
+ )
+ expect_identical(
+ sdk_values(annotations[["3"]]),
+ list(reviewerConfidence = "Low", isHeterogeneous = TRUE, heterogeneityType = "distinct_populations")
+ )
+
+ # Existing keys keep their names, order and values; the new keys come last.
+ expect_identical(names(annotations[["3"]]), c(EXISTING_KEYS, SDK_KEYS))
+ expect_identical(
+ annotations[["3"]][EXISTING_KEYS[1:6]],
+ list(
+ clusterId = "3",
+ annotation = "CD8+ T Cell",
+ ontologyTerm = "CD8-positive, alpha-beta T cell",
+ ontologyTermID = "CL:0000625",
+ granularAnnotation = "GZMK+ CD8+ T cell",
+ cellState = "Cytotoxic"
+ )
+ )
+
+ # The raw API data is kept unchanged and the other keys are kept.
+ expect_identical(result$raw_annotations, before$annotations)
+ expect_identical(response, before)
+ expect_identical(result$summary, before$summary)
+ expect_identical(result$clusterCategories, before$clusterCategories)
+ expect_identical(result$studyContext, before$studyContext)
+ expect_identical(result$semanticOrder, before$semanticOrder)
+ expect_identical(result$displayLevel, before$displayLevel)
+})
+
+test_that("results parsed from JSON are normalized the same way", {
+ result <- CyteTypeR:::.normalize_results(as_api_json(results_response()))
+ annotations <- by_cluster(result)
+
+ expect_identical(names(annotations), c("1", "2", "3"))
+ expect_identical(legacy_values(annotations[["2"]]), EXPECTED_FILL)
+ expect_identical(legacy_values(annotations[["1"]]), LEGACY_EVIDENCE)
+ expect_identical(annotations[["3"]]$heterogeneityType, "distinct_populations")
+})
+
+test_that("non-blank fields are never overwritten", {
+ curated <- list(
+ justification = "Curated justification",
+ supportingMarkers = list("CD3E"),
+ conflictingMarkers = list("CD19"),
+ missingExpression = "Curated missing note",
+ unexpectedExpression = "Curated unexpected note"
+ )
+
+ entry <- normalize_latest(do.call(new_result, c(list("1", v2_cell_type()), curated)))
+
+ expect_identical(legacy_values(entry), curated)
+})
+
+test_that("only blank fields are filled", {
+ entry <- normalize_latest(new_result(
+ "1",
+ v2_cell_type(),
+ justification = "Curated justification",
+ supportingMarkers = NULL,
+ conflictingMarkers = list("CD19"),
+ missingExpression = " ",
+ unexpectedExpression = "\n"
+ ))
+
+ expect_identical(
+ legacy_values(entry),
+ list(
+ justification = "Curated justification",
+ supportingMarkers = list("CD8A", "CD8B", "GZMK"),
+ conflictingMarkers = list("CD19"),
+ missingExpression = "`CCR7` and `SELL` mark naive cells.",
+ unexpectedExpression = "`MKI67` suggests a proliferating subset."
+ )
+ )
+})
+
+test_that("missing legacy fields are filled when a source exists", {
+ latest <- new_result("1", gen2_cell_type())
+ for (field in LEGACY_FIELDS) {
+ latest$annotation[[field]] <- NULL
+ }
+
+ expect_identical(legacy_values(normalize_latest(latest)), EXPECTED_FILL)
+})
+
+test_that("text is copied as stored", {
+ reasoning <- " `CCR7` is *absent*.\n"
+
+ entry <- normalize_latest(new_result("1", v2_cell_type(missingGenesReasoning = reasoning)))
+
+ expect_identical(entry$justification, CONCLUSION)
+ expect_identical(entry$missingExpression, reasoning)
+})
+
+test_that("blank reasoning falls back to the joined gene list", {
+ for (reasoning in list("", " \n ", NULL, 7, list("CCR7"))) {
+ entry <- normalize_latest(new_result(
+ "1",
+ gen2_cell_type(missingGenesReasoning = reasoning, unexpectedGenesReasoning = reasoning)
+ ))
+
+ expect_identical(entry$missingExpression, "CCR7, SELL")
+ expect_identical(entry$unexpectedExpression, "MKI67")
+ }
+})
+
+test_that("gene lists keep only non-blank strings, as stored", {
+ noisy <- list(" CD8A", NULL, 5, "", " ", list(gene = "CD8B"), list("GZMK"), TRUE, "GZMK")
+
+ entry <- normalize_latest(new_result(
+ "1",
+ v2_cell_type(
+ keySupportingGenes = noisy,
+ unexpectedGenes = noisy,
+ unexpectedGenesReasoning = "",
+ missingGenes = noisy,
+ missingGenesReasoning = ""
+ )
+ ))
+
+ expect_identical(entry$supportingMarkers, list(" CD8A", "GZMK"))
+ expect_identical(entry$conflictingMarkers, list(" CD8A", "GZMK"))
+ expect_identical(entry$missingExpression, " CD8A, GZMK")
+ expect_identical(entry$unexpectedExpression, " CD8A, GZMK")
+})
+
+test_that("empty sources fill typed blank values and never NULL", {
+ entry <- normalize_latest(new_result(
+ "1",
+ v2_cell_type(
+ conclusion = "",
+ keySupportingGenes = list(NULL, ""),
+ unexpectedGenes = list(),
+ unexpectedGenesReasoning = "",
+ missingGenes = list(),
+ missingGenesReasoning = ""
+ ),
+ justification = NULL,
+ supportingMarkers = NULL,
+ conflictingMarkers = NULL,
+ missingExpression = NULL,
+ unexpectedExpression = NULL
+ ))
+
+ expect_identical(legacy_values(entry), EMPTY_LEGACY_FIELDS)
+})
+
+test_that("missing or wrongly typed sources leave the fields unchanged", {
+ cell_type <- list(
+ conclusion = list("not", "a", "string"),
+ keySupportingGenes = "CD8A, CD8B",
+ unexpectedGenes = list(MKI67 = 1),
+ missingGenesReasoning = " ",
+ unexpectedGenesReasoning = NULL
+ )
+
+ entry <- normalize_latest(new_result("1", cell_type, justification = NULL))
+
+ expected <- EMPTY_LEGACY_FIELDS
+ expected["justification"] <- list(NULL)
+ expect_identical(legacy_values(entry), expected)
+})
+
+test_that("results without a structured cellType keep their fields", {
+ full_outputs <- list(
+ NULL,
+ "not an object",
+ list(),
+ json_object(),
+ list(cellType = "T cell"),
+ list(cellType = list("T cell"))
+ )
+ for (full_output in full_outputs) {
+ latest <- legacy_result("1", justification = "")
+ latest$annotation["fullOutput"] <- list(full_output)
+
+ entry <- normalize_latest(latest)
+
+ expected <- LEGACY_EVIDENCE
+ expected$justification <- ""
+ expect_identical(legacy_values(entry), expected)
+ }
+})
+
+test_that("reviewer fields are type-checked", {
+ cases <- list(
+ list(review = list(confidence = "high", isHeterogeneous = "true"), expected = list(NULL, NULL, NULL)),
+ list(review = list(confidence = list("High"), isHeterogeneous = 1), expected = list(NULL, NULL, NULL)),
+ list(review = list(confidence = 0.9, isHeterogeneous = NULL), expected = list(NULL, NULL, NULL)),
+ list(review = review_fixture("Moderate", TRUE, " "), expected = list("Moderate", TRUE, NULL)),
+ list(review = review_fixture("Moderate", TRUE, 5), expected = list("Moderate", TRUE, NULL)),
+ list(review = review_fixture("High", FALSE, "mixed_lineage"), expected = list("High", FALSE, "mixed_lineage")),
+ list(review = list(confidence = "Low", fullOutput = "n/a"), expected = list("Low", NULL, NULL)),
+ list(review = "not a review", expected = list(NULL, NULL, NULL))
+ )
+ for (case in cases) {
+ latest <- new_result("1", v2_cell_type())
+ latest["review"] <- list(case$review)
+
+ expected <- stats::setNames(case$expected, SDK_KEYS)
+ expect_identical(sdk_values(normalize_latest(latest)), expected)
+ }
+})
+
+test_that("a missing review gives NULL values", {
+ latest <- new_result("1", v2_cell_type())
+ latest$review <- NULL
+
+ entry <- normalize_latest(latest)
+
+ expect_true(all(SDK_KEYS %in% names(entry)))
+ expect_identical(sdk_values(entry), stats::setNames(list(NULL, NULL, NULL), SDK_KEYS))
+})
+
+test_that("clusters without an annotation are skipped", {
+ cluster_data <- list(
+ json_object(),
+ list(latest = json_object()),
+ list(latest = list(developmentalSimilarity = list())),
+ list(latest = list(annotation = "T cell", confidence = 0.95)),
+ list(latest = list(annotation = NULL)),
+ list(latest = NULL),
+ "not a cluster"
+ )
+ for (data in cluster_data) {
+ expect_null(CyteTypeR:::.normalize_cluster_annotation("1", data))
+ }
+})
+
+test_that("normalization is idempotent and does not modify its inputs", {
+ latests <- list(
+ legacy_result("1"),
+ new_result("1", gen2_cell_type()),
+ new_result("1", v2_cell_type(), review_fixture("Low", TRUE, "doublet_artifact")),
+ new_result("1", v2_cell_type(missingGenesReasoning = "", conclusion = ""))
+ )
+ for (latest in latests) {
+ cluster_data <- list(latest = latest, history = list())
+ before <- cluster_data
+
+ entry <- CyteTypeR:::.normalize_cluster_annotation("1", cluster_data)
+ again <- CyteTypeR:::.fill_cluster_annotation(entry, cluster_data)
+
+ expect_identical(again, entry)
+ expect_identical(cluster_data, before)
+ }
+
+ result <- CyteTypeR:::.normalize_results(results_response())
+ expect_identical(CyteTypeR:::.normalize_results(result), result)
+})
+
+test_that("results stored by older versions are filled from raw_annotations", {
+ stored <- old_sdk_result(results_response())
+ before <- stored
+
+ result <- CyteTypeR:::.normalize_results(stored)
+ annotations <- by_cluster(result)
+
+ expect_identical(stored, before)
+ expect_identical(legacy_values(annotations[["1"]]), LEGACY_EVIDENCE)
+ expect_identical(legacy_values(annotations[["2"]]), EXPECTED_FILL)
+ expect_identical(legacy_values(annotations[["3"]]), EXPECTED_FILL)
+ expect_identical(
+ sdk_values(annotations[["3"]]),
+ list(reviewerConfidence = "Low", isHeterogeneous = TRUE, heterogeneityType = "distinct_populations")
+ )
+ expect_identical(result$raw_annotations, before$raw_annotations)
+ expect_identical(CyteTypeR:::.normalize_results(result), result)
+})
+
+test_that("stored values are kept and unmatched entries are handled", {
+ stored <- old_sdk_result(results_response())
+ stored$annotations[[2]]$justification <- "Kept as stored"
+ stored$annotations[[2]]$reviewerConfidence <- "High"
+ stored$annotations[[4]] <- list(clusterId = "99", annotation = "Orphan")
+ stored$annotations[[5]] <- "not an entry"
+
+ result <- CyteTypeR:::.normalize_results(stored)
+
+ expect_identical(result$annotations[[2]]$justification, "Kept as stored")
+ expect_identical(result$annotations[[2]]$reviewerConfidence, "High")
+ expect_identical(result$annotations[[2]]$supportingMarkers, list("CD8A", "CD8B", "GZMK"))
+ expect_identical(
+ result$annotations[[4]],
+ c(list(clusterId = "99", annotation = "Orphan"), stats::setNames(list(NULL, NULL, NULL), SDK_KEYS))
+ )
+ expect_identical(result$annotations[[5]], "not an entry")
+})
+
+test_that("results without raw_annotations gain empty review fields", {
+ stored <- list(annotations = list(
+ list(clusterId = "1", annotation = "T cell"),
+ list(clusterId = "2", annotation = "B cell", reviewerConfidence = "High"),
+ "not an entry"
+ ))
+ before <- stored
+
+ result <- CyteTypeR:::.normalize_results(stored)
+
+ expect_identical(
+ result$annotations,
+ list(
+ c(list(clusterId = "1", annotation = "T cell"), stats::setNames(list(NULL, NULL, NULL), SDK_KEYS)),
+ list(
+ clusterId = "2",
+ annotation = "B cell",
+ reviewerConfidence = "High",
+ isHeterogeneous = NULL,
+ heterogeneityType = NULL
+ ),
+ "not an entry"
+ )
+ )
+ expect_identical(stored, before)
+ expect_null(result$raw_annotations)
+})
+
+test_that("entries with duplicated cluster IDs pair with their own raw result", {
+ response <- list(
+ studyContext = "",
+ annotations = list(
+ a = list(
+ latest = new_result("X", v2_cell_type(keySupportingGenes = list("CD8A")), review_fixture("High", FALSE)),
+ history = list()
+ ),
+ `no-result` = list(latest = json_object(), history = list()),
+ b = list(
+ latest = new_result("X", v2_cell_type(keySupportingGenes = list("MS4A1")), review_fixture("Low", TRUE, "mixed_lineage")),
+ history = list()
+ )
+ ),
+ summary = json_object(),
+ clusterCategories = list()
+ )
+ stored <- old_sdk_result(response)
+ expect_identical(vapply(stored$annotations, function(entry) entry$clusterId, ""), c("X", "X"))
+
+ result <- CyteTypeR:::.normalize_results(stored)
+
+ expect_identical(
+ lapply(result$annotations, function(entry) entry$supportingMarkers),
+ list(list("CD8A"), list("MS4A1"))
+ )
+ expect_identical(
+ vapply(result$annotations, function(entry) entry$reviewerConfidence, ""),
+ c("High", "Low")
+ )
+ # The same entries as normalizing the response directly.
+ expect_identical(result$annotations, CyteTypeR:::.normalize_results(response)$annotations)
+})
+
+test_that("entries fall back to the raw cluster key", {
+ stored <- list(
+ annotations = list(list(clusterId = "x", annotation = "T cell")),
+ raw_annotations = list(
+ x = list(latest = list(annotation = "T cell", review = list(confidence = "Low")))
+ )
+ )
+
+ result <- CyteTypeR:::.normalize_results(stored)
+
+ expect_identical(result$annotations[[1]]$reviewerConfidence, "Low")
+})
+
+test_that("raw and flat elements are detected per element", {
+ # Cluster IDs 1..N are what CyteTypeR submits; a raw result without a
+ # clusterId falls back to its key, and a flat entry is kept as an entry.
+ annotation <- new_result("ignored", v2_cell_type())$annotation
+ annotation$clusterId <- NULL
+ response <- list(annotations = list(
+ `1` = list(latest = list(annotation = annotation), history = list()),
+ `2` = list(clusterId = "2", annotation = "B cell", ontologyTerm = "B cell"),
+ `3` = list(latest = json_object(), history = list())
+ ))
+
+ result <- CyteTypeR:::.normalize_results(response)
+
+ expect_length(result$annotations, 2L)
+ expect_identical(result$annotations[[1]]$clusterId, "1")
+ expect_identical(result$annotations[[1]]$supportingMarkers, list("CD8A", "CD8B", "GZMK"))
+ expect_identical(result$annotations[[2]]$clusterId, "2")
+ expect_identical(result$annotations[[2]]$ontologyTerm, "B cell")
+})
+
+test_that("blank detection matches the shared rules", {
+ is_blank <- CyteTypeR:::.is_blank
+ expect_true(is_blank(NULL))
+ expect_true(is_blank(""))
+ expect_true(is_blank(" \t\n"))
+ expect_true(is_blank("\u00a0"))
+ expect_true(is_blank(list()))
+ expect_true(is_blank(NA))
+ expect_false(is_blank("x"))
+ expect_false(is_blank(list("")))
+ expect_false(is_blank(json_object()))
+ expect_false(is_blank(0))
+ expect_false(is_blank(FALSE))
+})
+
+test_that("a missing term name falls back to the term ID, as in 0.5.x", {
+ latest <- new_result("1", v2_cell_type())
+ latest$annotation$cellOntologyTermName <- NULL
+ latest$annotation["clusterId"] <- list(NULL)
+
+ entry <- CyteTypeR:::.normalize_cluster_annotation("7", list(latest = latest, history = list()))
+
+ expect_identical(entry$ontologyTerm, "CL:0000625")
+ expect_identical(entry$ontologyTermID, "CL:0000625")
+ expect_identical(entry$clusterId, "7")
+})
diff --git a/tests/testthat/test-prepare.R b/tests/testthat/test-prepare.R
new file mode 100644
index 0000000..8d28e18
--- /dev/null
+++ b/tests/testthat/test-prepare.R
@@ -0,0 +1,298 @@
+# PrepareCyteTypeR() on small, real Seurat objects.
+
+prepare_quietly <- function(...) {
+ suppressMessages(PrepareCyteTypeR(...))
+}
+
+vars_h5_contents <- function(path) {
+ list(
+ vars_attrs = rhdf5::h5readAttributes(path, "vars"),
+ vars_data = as.numeric(rhdf5::h5read(path, "vars/data")),
+ vars_indices = as.integer(rhdf5::h5read(path, "vars/indices")),
+ raw_data = if ("raw" %in% rhdf5::h5ls(path)$name) as.integer(rhdf5::h5read(path, "raw/data")) else NULL,
+ var_names = as.character(rhdf5::h5read(path, "info/var/var_names"))
+ )
+}
+
+test_that("PrepareCyteTypeR() builds the payload and both files", {
+ skip_if_not_installed("rhdf5filters")
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+
+ prepped <- prepare_quietly(obj, make_marker_table())
+
+ expect_true(prepped$build_succeeded)
+ expect_identical(prepped$clusterLabels, list(`1` = "0", `2` = "1", `3` = "2"))
+ expect_identical(names(prepped$markerGenes), c("1", "2", "3"))
+ expect_identical(prepped$coordinates_key, "umap")
+ expect_length(prepped$visualizationData$coordinates, 90L)
+ expect_length(prepped$expressionData, 60L)
+ expect_setequal(names(prepped$expressionData[["GENE01"]]), c("1", "2", "3"))
+ expect_true(file.exists("vars.h5"))
+ expect_true(file.exists("obs.duckdb"))
+
+ contents <- vars_h5_contents("vars.h5")
+ expect_identical(as.integer(contents$vars_attrs$n_obs), 90L)
+ expect_identical(as.integer(contents$vars_attrs$n_vars), 60L)
+ expect_identical(contents$var_names, rownames(obj))
+ # The counts are whole numbers, so the raw group is written.
+ expect_false(is.null(contents$raw_data))
+})
+
+test_that("Seurat v5 split layers are joined on a copy", {
+ skip_if_not_installed("rhdf5filters")
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+ markers <- make_marker_table()
+ joined <- prepare_quietly(obj, markers, vars_h5_path = "joined.h5", obs_duckdb_path = "joined.duckdb")
+
+ split_obj <- obj
+ split_obj[["RNA"]] <- split(split_obj[["RNA"]], f = split_obj$batch)
+ layers_before <- SeuratObject::Layers(split_obj[["RNA"]])
+ expect_true(length(layers_before) > 2L)
+
+ prepped <- prepare_quietly(split_obj, markers, vars_h5_path = "split.h5", obs_duckdb_path = "split.duckdb")
+
+ expect_true(prepped$build_succeeded)
+ expect_identical(prepped$expressionData, joined$expressionData)
+ expect_identical(vars_h5_contents("split.h5"), vars_h5_contents("joined.h5"))
+ # The caller's object keeps its split layers.
+ expect_identical(SeuratObject::Layers(split_obj[["RNA"]]), layers_before)
+})
+
+test_that(".get_rna_layer returns the joined layer in the object's cell order", {
+ obj <- make_seurat_fixture()
+ expected <- SeuratObject::LayerData(obj, assay = "RNA", layer = "data")
+ obj[["RNA"]] <- split(obj[["RNA"]], f = obj$batch)
+
+ data <- CyteTypeR:::.get_rna_layer(obj, "data")
+ counts <- CyteTypeR:::.get_rna_layer(obj, "counts")
+
+ expect_identical(colnames(data), colnames(obj))
+ expect_equal(as.matrix(data), as.matrix(expected))
+ expect_identical(dim(counts), dim(expected))
+})
+
+test_that("a default assay other than RNA uses the RNA genes", {
+ skip_if_not_installed("rhdf5filters")
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+ adt <- Matrix::sparseMatrix(
+ i = rep(1:5, length.out = ncol(obj)), j = seq_len(ncol(obj)), x = 3,
+ dims = c(5L, ncol(obj)),
+ dimnames = list(paste0("ADT", 1:5), colnames(obj))
+ )
+ obj[["ADT"]] <- SeuratObject::CreateAssay5Object(counts = adt)
+ SeuratObject::DefaultAssay(obj) <- "ADT"
+
+ warnings <- character()
+ prepped <- withCallingHandlers(
+ prepare_quietly(obj, make_marker_table()),
+ warning = function(w) {
+ warnings <<- c(warnings, conditionMessage(w))
+ invokeRestart("muffleWarning")
+ }
+ )
+
+ expect_true(prepped$build_succeeded)
+ expect_identical(names(prepped$expressionData), rownames(obj[["RNA"]]))
+ expect_identical(vars_h5_contents("vars.h5")$var_names, rownames(obj[["RNA"]]))
+ # One warning that RNA is used, not one per step.
+ expect_identical(sum(grepl("Using assay='RNA'", warnings)), 1L)
+})
+
+test_that("NA cluster labels stop early with a clear error", {
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+ obj$seurat_clusters[c(3, 10)] <- NA
+
+ expect_error(
+ prepare_quietly(obj, make_marker_table()),
+ "2 cells \\(2.2%\\) have NA values in 'seurat_clusters'"
+ )
+ expect_false(file.exists("vars.h5"))
+
+ obj$seurat_clusters <- factor(rep(NA_character_, ncol(obj)))
+ expect_error(prepare_quietly(obj, make_marker_table()), "All 90 cells have NA values")
+})
+
+test_that("a missing duckdb stops before vars.h5 is written", {
+ local_temp_workdir()
+ testthat::local_mocked_bindings(
+ .has_namespace = function(package) !identical(package, "duckdb"),
+ .package = "CyteTypeR"
+ )
+
+ expect_error(prepare_quietly(make_seurat_fixture(), make_marker_table()), "Package 'duckdb' is required")
+ expect_false(file.exists("vars.h5"))
+})
+
+test_that("visualization sampling leaves the caller's random number stream alone", {
+ obj <- make_seurat_fixture()
+ cluster_map <- c(`0` = "1", `1` = "2", `2` = "3")
+ withr::local_seed(123)
+ before <- get(".Random.seed", envir = globalenv())
+
+ first <- CyteTypeR:::.sample_visualization_data(obj, "seurat_clusters", "umap", cluster_map, max_cells_per_group = 10)
+
+ expect_identical(get(".Random.seed", envir = globalenv()), before)
+ second <- CyteTypeR:::.sample_visualization_data(obj, "seurat_clusters", "umap", cluster_map, max_cells_per_group = 10)
+ expect_identical(first, second)
+ expect_length(first$coordinates, 30L)
+})
+
+test_that("visualization sampling creates no seed when the session has none", {
+ obj <- make_seurat_fixture()
+ cluster_map <- c(`0` = "1", `1` = "2", `2` = "3")
+ withr::local_preserve_seed()
+ if (exists(".Random.seed", envir = globalenv())) {
+ rm(".Random.seed", envir = globalenv())
+ }
+
+ CyteTypeR:::.sample_visualization_data(obj, "seurat_clusters", "umap", cluster_map, max_cells_per_group = 10)
+
+ expect_false(exists(".Random.seed", envir = globalenv()))
+})
+
+test_that("a cluster with a single cell keeps that cell", {
+ obj <- make_seurat_fixture()
+ clusters <- as.character(obj$seurat_clusters)
+ clusters[50] <- "3"
+ obj$seurat_clusters <- factor(clusters)
+ cluster_map <- c(`0` = "1", `1` = "2", `2` = "3", `3` = "4")
+
+ sampled <- CyteTypeR:::.sample_visualization_data(obj, "seurat_clusters", "umap", cluster_map, max_cells_per_group = 5)
+
+ single <- which(sampled$clusters == "4")
+ expect_length(single, 1L)
+ embedding <- SeuratObject::Embeddings(obj, "umap")
+ expect_equal(sampled$coordinates[[single]], as.numeric(embedding[50, ]))
+})
+
+test_that("coordinates fall back to umap, tsne and pca", {
+ obj <- make_seurat_fixture()
+ embedding <- SeuratObject::Embeddings(obj, "umap")
+ colnames(embedding) <- c("tSNE_1", "tSNE_2")
+ obj[["tsne"]] <- SeuratObject::CreateDimReducObject(embeddings = embedding, key = "tSNE_", assay = "RNA")
+
+ expect_identical(suppressMessages(CyteTypeR:::.resolve_coordinates_key(obj, "UMAP")), "umap")
+ expect_identical(CyteTypeR:::.resolve_coordinates_key(obj, "tsne"), "tsne")
+
+ obj[["umap"]] <- NULL
+ expect_identical(CyteTypeR:::.resolve_coordinates_key(obj, "umap"), "tsne")
+
+ obj[["tsne"]] <- NULL
+ one_dim <- embedding[, 1, drop = FALSE]
+ colnames(one_dim) <- "PC_1"
+ obj[["pca"]] <- SeuratObject::CreateDimReducObject(embeddings = one_dim, key = "PC_", assay = "RNA")
+ expect_null(CyteTypeR:::.resolve_coordinates_key(obj, "umap"))
+})
+
+test_that("PrepareCyteTypeR() runs without coordinates", {
+ skip_if_not_installed("rhdf5filters")
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+ obj[["umap"]] <- NULL
+
+ prepped <- prepare_quietly(obj, make_marker_table())
+
+ expect_null(prepped$visualizationData)
+ expect_true(prepped$build_succeeded)
+})
+
+test_that("factor clusters with unused levels map expression to the right IDs", {
+ obj <- make_seurat_fixture()
+ obj$seurat_clusters <- factor(as.character(obj$seurat_clusters), levels = c("0", "1", "unused", "2"))
+ cluster_map <- c(`0` = "1", `1` = "2", `2` = "3")
+ expr <- CyteTypeR:::.get_rna_layer(obj, "data")
+
+ pcent <- suppressMessages(CyteTypeR:::.calculate_pcent(obj, "seurat_clusters", cluster_map, 25, expr = expr))
+
+ cells_2 <- which(obj$seurat_clusters == "2")
+ expected <- round(sum(expr["GENE05", cells_2] > 0) / length(cells_2) * 100, 2)
+ expect_identical(pcent[["GENE05"]][["3"]], expected)
+})
+
+test_that("raw counts are written only when they are integer-valued", {
+ skip_if_not_installed("rhdf5filters")
+ mat <- Matrix::sparseMatrix(i = c(1L, 2L, 3L), j = c(1L, 2L, 3L), x = c(1, 2, 3), dims = c(4L, 3L))
+ fractional <- Matrix::sparseMatrix(i = c(1L, 2L, 3L), j = c(1L, 2L, 3L), x = c(1.5, 2, 3), dims = c(3L, 4L))
+ out <- tempfile(fileext = ".h5")
+ on.exit(unlink(out), add = TRUE)
+
+ CyteTypeR:::.save_vars_h5(out, mat, raw_mat = fractional)
+
+ expect_false("raw" %in% rhdf5::h5ls(out)$name)
+})
+
+test_that(".is_integer_valued checks every value", {
+ is_integer_valued <- CyteTypeR:::.is_integer_valued
+ whole <- Matrix::sparseMatrix(i = 1:3, j = 1:3, x = c(1, 2, 300))
+ expect_true(is_integer_valued(whole))
+ expect_true(is_integer_valued(matrix(1:4, 2)))
+ expect_false(is_integer_valued(Matrix::sparseMatrix(i = 1:3, j = 1:3, x = c(1, 2, 2.5))))
+ expect_false(is_integer_valued(Matrix::sparseMatrix(i = 1:2, j = 1:2, x = c(1, Inf))))
+ expect_false(is_integer_valued(NULL))
+ # Checked in chunks: a fraction in the last chunk is found.
+ x <- c(rep(1, 25), 0.5)
+ expect_false(is_integer_valued(Matrix::sparseMatrix(i = seq_along(x), j = seq_along(x), x = x), chunk_size = 10))
+})
+
+test_that("obs.duckdb spills to a private temporary directory", {
+ local_temp_workdir()
+ before <- list.files(tempdir(), pattern = "^cytetype-duckdb-")
+ obs <- data.frame(cluster = c("a", "b"), row.names = c("c1", "c2"))
+ coords <- matrix(c(1, 2, 3, 4), ncol = 2, dimnames = list(c("c2", "c1"), NULL))
+
+ CyteTypeR:::.save_obs_duckdb("obs.duckdb", obs, coordinates = coords, coordinates_key = "umap")
+
+ expect_true(file.exists("obs.duckdb"))
+ expect_false(dir.exists("tmp"))
+ expect_identical(list.files(tempdir(), pattern = "^cytetype-duckdb-"), before)
+ con <- duckdb::dbConnect(CyteTypeR:::.duckdb_driver(), "obs.duckdb", read_only = TRUE)
+ on.exit(duckdb::dbDisconnect(con, shutdown = TRUE), add = TRUE)
+ query <- duckdb::dbSendQuery(con, "SELECT * FROM obs")
+ table <- duckdb::dbFetch(query)
+ duckdb::dbClearResult(query)
+ # Coordinates are matched to the cells by name.
+ expect_identical(table$`__vis_coordinates_umap_1`, c(2, 1))
+})
+
+test_that(".get_rna_layer reads Seurat v3/v4 assays from their slots", {
+ withr::local_options(Seurat.object.assay.version = "v3")
+ counts <- Matrix::sparseMatrix(
+ i = c(1L, 2L, 3L), j = c(1L, 2L, 3L), x = c(2, 4, 6), dims = c(3L, 3L),
+ dimnames = list(c("CD3E", "MS4A1", "NKG7"), c("c1", "c2", "c3"))
+ )
+ obj <- suppressWarnings(SeuratObject::CreateSeuratObject(counts = counts))
+ obj <- Seurat::NormalizeData(obj, verbose = FALSE)
+ expect_true(methods::is(obj[["RNA"]], "Assay"))
+
+ expect_equal(as.matrix(CyteTypeR:::.get_rna_layer(obj, "counts")), as.matrix(counts))
+ data <- CyteTypeR:::.get_rna_layer(obj, "data")
+ expect_identical(dim(data), dim(counts))
+ expect_false(isTRUE(all.equal(as.matrix(data), as.matrix(counts))))
+
+ data_only <- suppressWarnings(SeuratObject::CreateSeuratObject(
+ SeuratObject::CreateAssayObject(data = log1p(counts))
+ ))
+ expect_null(CyteTypeR:::.get_rna_layer(data_only, "counts"))
+})
+
+test_that("coordinates_key is NULL when no reduction was used", {
+ skip_if_not_installed("rhdf5filters")
+ local_temp_workdir()
+ obj <- make_seurat_fixture()
+ obj[["umap"]] <- NULL
+
+ prepped <- prepare_quietly(obj, make_marker_table(), coordinates_key = "umap")
+
+ expect_true("coordinates_key" %in% names(prepped))
+ expect_null(prepped$coordinates_key)
+
+ embedding <- SeuratObject::Embeddings(make_seurat_fixture(), "umap")
+ colnames(embedding) <- c("tSNE_1", "tSNE_2")
+ obj[["tsne"]] <- SeuratObject::CreateDimReducObject(embeddings = embedding, key = "tSNE_", assay = "RNA")
+ prepped <- prepare_quietly(obj, make_marker_table(), coordinates_key = "umap")
+ expect_identical(prepped$coordinates_key, "tsne")
+})
diff --git a/tests/testthat/test-results-seurat.R b/tests/testthat/test-results-seurat.R
new file mode 100644
index 0000000..758ad18
--- /dev/null
+++ b/tests/testthat/test-results-seurat.R
@@ -0,0 +1,245 @@
+# How results end up in the per-cluster table and the Seurat object.
+
+small_seurat <- function(clusters = c("0", "0", "1", "1", "2", "3", "4", "2")) {
+ n <- length(clusters)
+ counts <- Matrix::sparseMatrix(
+ i = rep(1:2, length.out = n),
+ j = seq_len(n),
+ x = 1,
+ dims = c(2L, n),
+ dimnames = list(c("g1", "g2"), paste0("cell", seq_len(n)))
+ )
+ obj <- suppressWarnings(SeuratObject::CreateSeuratObject(counts = counts))
+ obj$leiden <- clusters
+ obj
+}
+
+# CyteType IDs "1".."5" for the labels "0".."4", as PrepareCyteTypeR() makes them.
+LEIDEN_LABELS <- list(`1` = "0", `2` = "1", `3` = "2", `4` = "3", `5` = "4")
+
+test_that("the results table keeps the 0.5.x columns first and appends the new ones", {
+ table <- CyteTypeR:::.transform_results_seurat(results_response(), cluster_map = LEIDEN_LABELS)
+
+ expect_s3_class(table, "data.frame")
+ expect_identical(names(table)[1:11], EXISTING_TABLE_COLUMNS)
+ expect_identical(names(table), c(EXISTING_TABLE_COLUMNS, SDK_KEYS))
+ # Clusters 4 and 5 have no result and get no row.
+ expect_identical(table$clusterId, c("0", "1", "2"))
+ expect_identical(rownames(table), c("0", "1", "2"))
+ expect_identical(table$annotation, c("Astrocyte", "CD8+ T Cell", "CD8+ T Cell"))
+ expect_identical(table$justification, c(LEGACY_EVIDENCE$justification, CONCLUSION, CONCLUSION))
+ expect_identical(table$supportingMarkers, c("GFAP; S100B; AQP4", "CD8A; CD8B; GZMK", "CD8A; CD8B; GZMK"))
+ expect_identical(table$conflictingMarkers, c("", "MKI67", "MKI67"))
+ expect_identical(table$missingExpression[2], "`CCR7` and `SELL` mark naive cells.")
+ expect_identical(table$unexpectedExpression[3], "`MKI67` suggests a proliferating subset.")
+ expect_identical(table$reviewerConfidence, c("High", "Moderate", "Low"))
+ expect_identical(table$isHeterogeneous, c(NA, FALSE, TRUE))
+ expect_identical(table$heterogeneityType, c(NA, NA, "distinct_populations"))
+ for (column in EXISTING_TABLE_COLUMNS) {
+ expect_type(table[[column]], "character")
+ }
+})
+
+test_that("failed clusters with an empty latest result do not break the table", {
+ # 0.5.1 mapped every failed cluster to the ID "NULL" and stopped on the
+ # duplicate row names at the end of CyteTypeR().
+ response <- list(annotations = list(
+ `1` = list(latest = new_result("1", v2_cell_type()), history = list()),
+ `2` = list(latest = json_object(), history = list()),
+ `3` = list(latest = json_object(), history = list()),
+ `4` = list(latest = json_object(), history = list())
+ ))
+
+ table <- CyteTypeR:::.transform_results_seurat(
+ as_api_json(response),
+ cluster_map = list(`1` = "T", `2` = "B", `3` = "NK", `4` = "Mono")
+ )
+
+ expect_identical(table$clusterId, "T")
+ expect_false(any(table$clusterId == "NULL"))
+})
+
+test_that("duplicate or missing cluster IDs keep default row names", {
+ stored <- list(annotations = list(
+ list(clusterId = "X", annotation = "T cell"),
+ list(clusterId = "X", annotation = "B cell"),
+ list(annotation = "NK cell")
+ ))
+
+ table <- CyteTypeR:::.transform_results_seurat(stored)
+
+ expect_identical(table$clusterId, c("X", "X", ""))
+ expect_identical(rownames(table), c("1", "2", "3"))
+})
+
+test_that("an empty result gives an empty table with all columns", {
+ table <- CyteTypeR:::.transform_results_seurat(list(annotations = json_object()))
+
+ expect_identical(nrow(table), 0L)
+ expect_identical(names(table), c(EXISTING_TABLE_COLUMNS, SDK_KEYS))
+})
+
+test_that("annotation columns include the reviewer confidence factor", {
+ obj <- small_seurat()
+ result <- CyteTypeR:::.normalize_results(results_response())
+
+ obj <- CyteTypeR:::.store_annotations_seurat(obj, result, "job-1", "cytetype", "leiden", LEIDEN_LABELS)
+
+ confidence <- obj$cytetype_reviewerConfidence_leiden
+ expect_s3_class(confidence, "factor")
+ expect_identical(levels(confidence), c("High", "Moderate", "Low", "Unknown"))
+ expect_identical(
+ as.character(confidence),
+ c("High", "High", "Moderate", "Moderate", "Low", "Unknown", "Unknown", "Low")
+ )
+ # The four existing columns keep their names and values.
+ expect_identical(
+ as.character(obj$cytetype_annotation_leiden),
+ c("Astrocyte", "Astrocyte", "CD8+ T Cell", "CD8+ T Cell", "CD8+ T Cell", "Unknown", "Unknown", "CD8+ T Cell")
+ )
+ expect_identical(
+ as.character(obj$cytetype_cellOntologyTerm_leiden)[1:3],
+ c("astrocyte", "astrocyte", "CD8-positive, alpha-beta T cell")
+ )
+ expect_identical(
+ as.character(obj$cytetype_cellOntologyTermID_leiden)[6:8],
+ c("Unknown", "Unknown", "CL:0000625")
+ )
+ expect_identical(as.character(obj$cytetype_cellState_leiden)[5:6], c("Cytotoxic", ""))
+ new_columns <- grep("^cytetype_", names(obj@meta.data), value = TRUE)
+ expect_setequal(
+ new_columns,
+ paste0("cytetype_", c("annotation", "cellOntologyTerm", "cellOntologyTermID", "cellState", "reviewerConfidence"), "_leiden")
+ )
+})
+
+test_that("the reviewer confidence column keeps only the levels that occur", {
+ obj <- small_seurat(c("1", "2", "3"))
+ result <- list(annotations = list(
+ list(clusterId = "1", annotation = "T cell", reviewerConfidence = "Low"),
+ list(clusterId = "2", annotation = "B cell", reviewerConfidence = "bogus"),
+ list(clusterId = "3", annotation = "NK cell")
+ ))
+
+ obj <- CyteTypeR:::.store_annotations_seurat(
+ obj, result, "job-1", "cytetype", "leiden", list(`1` = "1", `2` = "2", `3` = "3")
+ )
+
+ confidence <- obj$cytetype_reviewerConfidence_leiden
+ expect_identical(levels(confidence), c("Low", "Unknown"))
+ expect_identical(as.character(confidence), c("Low", "Unknown", "Unknown"))
+})
+
+test_that("the default prefix stores the table with the job and full results attached", {
+ obj <- small_seurat()
+ result <- CyteTypeR:::.normalize_results(results_response())
+
+ obj <- CyteTypeR:::.store_annotations_seurat(obj, result, "job-1", "cytetype", "leiden", LEIDEN_LABELS)
+
+ stored <- obj@misc$cytetype_results
+ expect_s3_class(stored, "data.frame")
+ expect_identical(names(stored)[1:11], EXISTING_TABLE_COLUMNS)
+ expect_identical(attr(stored, "job_id"), "job-1")
+ expect_identical(attr(stored, "result"), result)
+ expect_identical(GetResults(obj), stored)
+})
+
+test_that("another prefix does not overwrite cytetype_results", {
+ obj <- small_seurat()
+ first <- CyteTypeR:::.normalize_results(results_response())
+ obj <- CyteTypeR:::.store_annotations_seurat(obj, first, "job-1", "cytetype", "leiden", LEIDEN_LABELS)
+ default_table <- obj@misc$cytetype_results
+
+ second <- list(annotations = list(list(clusterId = "1", annotation = "Other label")))
+ obj <- CyteTypeR:::.store_annotations_seurat(obj, second, "job-2", "run2", "leiden", LEIDEN_LABELS)
+
+ expect_identical(obj@misc$cytetype_results, default_table)
+ expect_identical(obj@misc$run2_results$job_id, "job-2")
+ expect_identical(obj@misc$run2_results$result, second)
+ expect_identical(GetResults(obj), default_table)
+ run2 <- GetResults(obj, results_prefix = "run2")
+ expect_identical(run2$annotations[[1]]$annotation, "Other label")
+ expect_true(all(SDK_KEYS %in% names(run2$annotations[[1]])))
+})
+
+test_that("CyteTypeR() completes when some clusters have no result", {
+ testthat::local_mocked_bindings(
+ .submit_job = function(...) "job1",
+ .poll_for_results = function(...) as_api_json(results_response()),
+ .package = "CyteTypeR"
+ )
+ obj <- small_seurat()
+ prepped_data <- list(
+ clusterLabels = LEIDEN_LABELS,
+ clusterMetadata = list(),
+ markerGenes = list(),
+ visualizationData = NULL,
+ expressionData = list(),
+ group_key = "leiden",
+ build_succeeded = FALSE
+ )
+
+ out <- CyteTypeR::CyteTypeR(
+ obj,
+ prepped_data,
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ require_artifacts = FALSE,
+ show_progress = FALSE
+ )
+
+ expect_s4_class(out, "Seurat")
+ table <- out@misc$cytetype_results
+ expect_identical(table$clusterId, c("0", "1", "2"))
+ expect_identical(table$supportingMarkers[2], "CD8A; CD8B; GZMK")
+ expect_identical(attr(table, "job_id"), "job1")
+ expect_identical(names(attr(table, "result")$raw_annotations), c("1", "2", "3", "4", "5"))
+ expect_identical(
+ as.character(out$cytetype_reviewerConfidence_leiden),
+ c("High", "High", "Moderate", "Moderate", "Low", "Unknown", "Unknown", "Low")
+ )
+ # The three legacy columns keep their names; cells without a result are NA.
+ expect_identical(
+ as.character(out$cytetype_leiden),
+ c("Astrocyte", "Astrocyte", "CD8+ T Cell", "CD8+ T Cell", "CD8+ T Cell", NA, NA, "CD8+ T Cell")
+ )
+ expect_identical(as.character(out$cytetype_ontologyTerm_leiden)[1], "astrocyte")
+ expect_identical(as.character(out$cytetype_ontologyID_leiden)[8], "CL:0000625")
+ expect_identical(GetResults(out), table)
+})
+
+test_that("CyteTypeR() with another prefix leaves cytetype_results alone", {
+ testthat::local_mocked_bindings(
+ .submit_job = function(...) "job2",
+ .poll_for_results = function(...) as_api_json(results_response()),
+ .package = "CyteTypeR"
+ )
+ obj <- small_seurat()
+ obj@misc$cytetype_results <- data.frame(clusterId = "0", annotation = "earlier")
+ prepped_data <- list(
+ clusterLabels = LEIDEN_LABELS,
+ clusterMetadata = list(),
+ markerGenes = list(),
+ visualizationData = NULL,
+ expressionData = list(),
+ group_key = "leiden",
+ build_succeeded = FALSE
+ )
+
+ out <- CyteTypeR::CyteTypeR(
+ obj,
+ prepped_data,
+ results_prefix = "run2",
+ api_url = "https://example.com",
+ auth_token = "test-token",
+ save_query = FALSE,
+ require_artifacts = FALSE,
+ show_progress = FALSE
+ )
+
+ expect_identical(out@misc$cytetype_results, data.frame(clusterId = "0", annotation = "earlier"))
+ expect_identical(out@misc$run2_results$job_id, "job2")
+ expect_true("run2_reviewerConfidence_leiden" %in% names(out@meta.data))
+ expect_true("run2_leiden" %in% names(out@meta.data))
+})
diff --git a/tests/testthat/test-save-vars-h5.R b/tests/testthat/test-save-vars-h5.R
index 29447ec..7d05e02 100644
--- a/tests/testthat/test-save-vars-h5.R
+++ b/tests/testthat/test-save-vars-h5.R
@@ -193,8 +193,3 @@ test_that(".save_vars_h5 omits raw group when raw_mat is NULL", {
contents <- rhdf5::h5ls(out)
expect_false("raw" %in% contents$name)
})
-
-test_that(".save_vars_h5 fails gracefully when rhdf5filters is missing", {
- skip_if_not_installed("rhdf5")
- skip("Cannot mock base::requireNamespace; rhdf5filters guard is validated manually")
-})
diff --git a/tests/testthat/test-schema.R b/tests/testthat/test-schema.R
index 504beec..7bf9f43 100644
--- a/tests/testthat/test-schema.R
+++ b/tests/testthat/test-schema.R
@@ -88,3 +88,27 @@ test_that(".prepare_query_for_json preserves uploaded_files", {
out <- CyteTypeR:::.prepare_query_for_json(query_list)
expect_identical(out$uploaded_files, list(obs_duckdb = "id1", vars_h5 = "id2"))
})
+
+test_that("LLMModelConfig accepts the deepseek, nebius and together providers", {
+ for (provider in c("deepseek", "nebius", "together")) {
+ cfg <- CyteTypeR:::LLMModelConfig(provider = provider, name = "model", apiKey = "k")
+ expect_identical(cfg$provider, provider)
+ }
+})
+
+test_that("the provider list matches the Python SDK", {
+ expect_identical(
+ CyteTypeR:::LLM_PROVIDERS,
+ c(
+ "anthropic", "bedrock", "deepseek", "fireworks", "google", "groq",
+ "huggingface", "mistral", "nebius", "openai", "openrouter", "together",
+ "vertex", "xai"
+ )
+ )
+})
+
+test_that(".prepare_query_for_json keeps a top-level visibility", {
+ input_data <- list(studyInfo = "x", infoTags = list(), clusterLabels = list(), clusterMetadata = list(), markerGenes = list(), visualizationData = NULL, expressionData = list(), nParallelClusters = 2L)
+ out <- CyteTypeR:::.prepare_query_for_json(list(input_data = input_data, llm_configs = NULL, visibility = "public"))
+ expect_identical(out$visibility, "public")
+})
diff --git a/vignettes/configurations.Rmd b/vignettes/configurations.Rmd
deleted file mode 100644
index 4d11aa0..0000000
--- a/vignettes/configurations.Rmd
+++ /dev/null
@@ -1,128 +0,0 @@
----
-title: "Configurations"
-output: rmarkdown::html_vignette
-date: "`r Sys.Date()`"
-vignette: >
- %\VignetteIndexEntry{Configurations}
- %\VignetteEngine{knitr::rmarkdown}
- %\VignetteEncoding{UTF-8}
----
-
-## API configuration
-
-CyteTypeR uses `https://cytetype.nygen.io` by default. An explicit `api_url` takes precedence over the `CYTETYPE_API_URL` environment variable and the package default.
-
-For normal production use, no URL configuration is required:
-
-```{r eval=FALSE}
-SetupCyteTypeR()
-```
-
-### Development API
-
-Replace `` with the development URL supplied for your environment:
-
-```{r eval=FALSE}
-SetupCyteTypeR(api_url = "")
-```
-
-For a terminal session:
-
-```sh
-export CYTETYPE_API_URL=""
-cytetyper setup
-```
-
-You can also provide the URL for one command:
-
-```sh
-cytetyper setup --api-url ""
-```
-
-Remote API URLs must use HTTPS. Plain HTTP is accepted only for `localhost` and `127.0.0.1`.
-
-## Authentication
-
-`SetupCyteTypeR()` validates matching saved credentials or opens the browser-based email and one-time-code flow when none are available. If the saved key is invalid or inactive, use `SetupCyteTypeR(force = TRUE)` or `cytetyper setup --force` to authenticate with a new key. `LoginCyteTypeR()` validates and saves an existing API key through a hidden prompt.
-
-```{r eval=FALSE}
-SetupCyteTypeR()
-LoginCyteTypeR()
-LogoutCyteTypeR()
-```
-
-The equivalent terminal commands are:
-
-```sh
-cytetyper setup
-cytetyper login
-cytetyper logout
-```
-
-CyteTypeR and the Python client share the same local credentials. The active credentials are tied to the API URL used during sign-in.
-
-## LLM configurations
-
-An external LLM key is optional. Without `llm_configs`, CyteType uses its managed default model.
-
-Store provider keys in environment variables instead of writing them directly in scripts:
-
-```{r eval=FALSE}
-llm_configs <- list(
- provider = "openai",
- name = "gpt-4o-mini",
- apiKey = Sys.getenv("OPENAI_API_KEY"),
- baseUrl = "https://api.openai.com/v1",
- modelSettings = list(
- temperature = 0.0,
- max_tokens = 4096L
- )
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata,
- llm_configs = llm_configs,
- save_query = FALSE
-)
-```
-
-Set `save_query = FALSE` whenever `llm_configs` contains provider credentials. Current query-file output includes the complete LLM configuration.
-
-Supported provider names in this package version are:
-
-```{r eval=FALSE}
-c(
- "anthropic", "bedrock", "fireworks", "google", "groq",
- "huggingface", "mistral", "openai", "openrouter", "vertex", "xai"
-)
-```
-
-### Multiple models
-
-Pass an unnamed list of model configuration lists:
-
-```{r eval=FALSE}
-llm_configs <- list(
- list(
- provider = "openai",
- name = "gpt-4o-mini",
- apiKey = Sys.getenv("OPENAI_API_KEY")
- ),
- list(
- provider = "anthropic",
- name = "claude-sonnet-4-20250514",
- apiKey = Sys.getenv("ANTHROPIC_API_KEY"),
- allowFallback = TRUE
- )
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- llm_configs = llm_configs,
- save_query = FALSE
-)
-```
diff --git a/vignettes/get-started.Rmd b/vignettes/get-started.Rmd
index 7283062..0d3179f 100644
--- a/vignettes/get-started.Rmd
+++ b/vignettes/get-started.Rmd
@@ -1,209 +1,57 @@
---
title: "Getting Started"
-output:
- rmarkdown::html_vignette:
- toc: true
- toc_depth: 2
- df_print: paged
- html_document:
- toc: true
- toc_depth: 2
- toc_float: true
- df_print: paged
-date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Getting Started}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
-## Introduction
-
-CyteTypeR is the R client for [CyteType](https://github.com/NygenAnalytics/CyteType). It prepares clustered Seurat objects, submits annotation jobs to the CyteType API, and adds the returned annotations to the Seurat object.
-
-This vignette demonstrates a basic workflow using a PBMC dataset processed with the standard Seurat workflow.
-
-## Installation
-
-```{r eval=FALSE}
-# Using devtools
-install.packages("devtools")
-
-# Install from GitHub
-library(devtools)
-install_github("NygenAnalytics/CyteTypeR")
-```
-
-## Authentication
-
-### Sign in from R
-
-Sign in once on each machine. CyteType opens a browser, verifies your email with a one-time code, and saves a personal API key locally.
-
-```{r eval=FALSE}
-library(CyteTypeR)
-
-SetupCyteTypeR()
-```
-
-If you already have a CyteType API key, save it through a hidden prompt:
-
-```{r eval=FALSE}
-LoginCyteTypeR()
-```
-
-### Sign in from the terminal
-
-Install the `cytetyper` command into the active R environment:
-
-```{r eval=FALSE}
-InstallCyteTypeRCli()
-```
-
-Then use it directly from the terminal:
-
-```sh
-cytetyper setup
-cytetyper dashboard
-cytetyper view
-cytetyper logout
+```{r setup, include = FALSE}
+knitr::opts_chunk$set(eval = FALSE, collapse = TRUE, comment = "#>")
```
-The R and Python clients use the same local CyteType credentials file.
+CyteTypeR is the R client for [CyteType](https://github.com/NygenAnalytics/CyteType). It prepares a clustered Seurat object, submits an annotation job to the CyteType API and adds the returned annotations to the object.
-### Use a development environment
+The full documentation for the R and Python clients is at . Start with the [R quickstart](https://docs.nygen.io/CyteType/getting-started/quickstart-r/), which annotates the 10x Genomics PBMC 3k dataset step by step. The code on this page is not run when the vignette is built.
-Replace `` with the development URL supplied for your environment.
-
-```{r eval=FALSE}
-SetupCyteTypeR(api_url = "")
-```
-
-```sh
-cytetyper setup --api-url ""
-```
-
-Alternatively, configure the development URL for the current shell:
-
-```sh
-export CYTETYPE_API_URL=""
-cytetyper setup
-```
+## The workflow in brief
-## Quick Start
+Sign in once on each computer. This opens CyteType sign-in in your browser and saves an API key locally:
-```{r eval=FALSE}
-# Load package
+```{r}
library(CyteTypeR)
-
-# Sign in once if this machine is not configured
SetupCyteTypeR()
-
-prepped_data <- PrepareCyteTypeR(
- pbmc,
- pbmc.markers,
- n_top_genes = 10,
- group_key = "seurat_clusters",
- aggregate_metadata = TRUE,
- coordinates_key = "umap"
-)
-
-metadata <- list(
- title = "My scRNA-seq analysis of human PBMCs",
- run_label = "initial_analysis",
- experiment_name = "pbmc_human_samples_study"
-)
-
-annotated_pbmc <- CyteTypeR(
- obj = pbmc,
- prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata
-)
```
-## Pre-processing
-
-CyteTypeR requires a Seurat object with normalized RNA expression, cluster assignments, marker genes, and optionally a dimensional reduction for report visualization.
-
-``` {r eval=FALSE}
-# Load libraries
-library(dplyr)
-library(patchwork)
-library(Matrix)
-library(Seurat)
-
-# Load the dataset
-pbmc.data <- Read10X(data.dir = "./data/filtered_gene_bc_matrices/hg19/")
+Then prepare a normalized, clustered Seurat object and its marker table (from `Seurat::FindAllMarkers()`), and submit the job:
-# Initialize and normalize the Seurat object
-pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
-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)
-
-# Cluster the cells and run UMAP
-pbmc <- FindNeighbors(pbmc, dims = 1:10)
-pbmc <- FindClusters(pbmc, resolution = 0.5)
-pbmc <- RunUMAP(pbmc, dims = 1:10)
-
-# Find and filter markers for all clusters
-pbmc.markers <- FindAllMarkers(pbmc, only.pos = TRUE)
-pbmc.markers <- pbmc.markers %>%
- group_by(cluster) %>%
- dplyr::filter(avg_log2FC > 1)
-```
-
-## Run CyteTypeR
-
-``` {r eval=FALSE}
-# Prepare data for submission
+```{r}
prepped_data <- PrepareCyteTypeR(
- pbmc,
- pbmc.markers,
- n_top_genes = 10,
+ obj = pbmc,
+ marker_table = pbmc.markers,
group_key = "seurat_clusters",
- aggregate_metadata = TRUE,
coordinates_key = "umap"
)
-# Add metadata to the report
-metadata <- list(
- title = "My scRNA-seq analysis of human PBMCs",
- run_label = "initial_analysis",
- experiment_name = "pbmc_human_samples_study"
-)
-
-# Submit the job and add results to the Seurat object
-annotated_pbmc <- CyteTypeR(
+pbmc <- CyteTypeR(
obj = pbmc,
prepped_data = prepped_data,
- study_context = "PBMC blood samples from humans",
- metadata = metadata
+ study_context = "Peripheral blood mononuclear cells from a healthy human donor",
+ metadata = list(title = "PBMC 3k")
)
```
-## Open reports and retrieve results
+Every cell now has its cluster's label, Cell Ontology term, cell state and reviewer confidence in `pbmc@meta.data`, and `pbmc@misc$cytetype_results` has one row per cluster:
-Successful submissions print a report URL under `https://cytetype.nygen.io`. You can reopen the dashboard or a known job from R:
-
-```{r eval=FALSE}
-OpenCyteTypeDashboard()
-ViewCyteTypeJob("")
+```{r}
+head(pbmc@meta.data$cytetype_annotation_seurat_clusters)
+GetResults(pbmc)
```
-The same operations are available from the terminal:
+## More
-```sh
-cytetyper dashboard
-cytetyper view
-```
-
-Results from a completed run are stored in the returned Seurat object. With the default prefix, the transformed result table is available at:
-
-```{r eval=FALSE}
-View(annotated_pbmc@misc[["cytetype_results"]])
-GetResults(annotated_pbmc)
-```
+- [Installation](https://docs.nygen.io/CyteType/getting-started/installation/) and [Sign in and API keys](https://docs.nygen.io/CyteType/getting-started/sign-in/)
+- [Prepare your data](https://docs.nygen.io/CyteType/guides/prepare-data/) and [Run, monitor and rerun jobs](https://docs.nygen.io/CyteType/guides/running-jobs/)
+- [Results in AnnData and Seurat](https://docs.nygen.io/CyteType/results/results-in-your-data/)
+- [R function reference](https://docs.nygen.io/CyteType/reference/r-api/), also available in R with `?CyteTypeR` and the other help pages