diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index d9e66b1..cd2f438 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -38,7 +38,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck, any::urlchecker + extra-packages: any::rcmdcheck, any::urlchecker, any::pkgload needs: check cache-version: 2 @@ -57,6 +57,20 @@ jobs: } shell: Rscript {0} + # Source-tree lint. `R CMD check` runs the suite against an INSTALLED + # package, whose R/ contains omophub.rdb rather than any .R file, so this + # guard skips itself there. Running it here against the checkout keeps it + # gating every PR instead of only ever running on a developer's machine. + - name: Check roxygen @param order against signatures + if: matrix.r == 'release' + run: | + pkgload::load_all(quiet = TRUE) + testthat::test_file( + "tests/testthat/test-roxygen-param-order.R", + stop_on_failure = TRUE + ) + shell: Rscript {0} + - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true diff --git a/DESCRIPTION b/DESCRIPTION index ced9d29..91855ba 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: omophub Title: R Client for the 'OMOPHub' Medical Vocabulary API -Version: 1.8.1 +Version: 1.9.0 Authors@R: c( person("Alex", "Chen", email = "alex@omophub.com", role = c("aut", "cre", "cph")), person("Observational Health Data Science and Informatics", role = c("cph")) diff --git a/NEWS.md b/NEWS.md index 9fe4010..83e61eb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,44 @@ +# omophub 1.9.0 + +## New Features + +* **Mapping pagination** - `client$mappings$get()` accepts `page` and + `page_size`. `GET /v1/concepts/{id}/mappings` became paginated; + `page_size` defaults to 100, + matching the old cap, so an existing call returns exactly the page it + returned before. Pagination metadata is attached to the result as the + `pagination` attribute - read it with `attr(result, "pagination")`. + +* **`client$mappings$get_all()`** - walks every page and returns one tibble of + all mappings for a concept. Prefer it over `get()` when assembling a code + list; a partial code list is wrong in a way nothing in the result reveals. + Takes `max_pages` and `progress` like the other `*_all()` methods. + +* **`relationship_ids`** on `client$mappings$get()` and `get_all()` - a + character vector of relationship types. The server defaults to `"Maps to"`, + so a composite concept returns only half its decomposition unless + `"Maps to value"` is asked for too: "Allergy to penicillin G" maps to + "Allergy to drug" via `Maps to` and to "penicillin G" via `Maps to value`. + +## Bug Fixes + +* **`client$mappings$get()` returned a different shape once the API added + pagination.** `perform_get()` switches its return shape based on whether the + response carries `meta.pagination`. + +* **`include_invalid = FALSE` never reached the server** on + `client$mappings$get()` and `get_all()`. The parameter was only sent when + `TRUE`, and this endpoint defaults to *including* deprecated mappings, so + asking to exclude them did nothing. The default is now `NULL` (take the + server default); pass `FALSE` to exclude. Omitting it behaves exactly as + before, so only callers who explicitly passed `FALSE` - and were being + ignored - see a change. + # omophub 1.8.1 ## Changed -* **Canonical endpoint path** — `client$search$semantic()` and +* **Canonical endpoint path** - `client$search$semantic()` and `client$search$semantic_all()` now call `GET /v1/search/semantic` instead of `GET /v1/concepts/semantic-search`. The legacy path remains a permanent server-side alias (emits `Deprecation: true` + `Link: …rel="successor-version"` @@ -13,13 +49,13 @@ ## New Features -* **FHIR Value-as-Concept** — the `resolve_batch(as_tibble = TRUE)` tibble now +* **FHIR Value-as-Concept** - the `resolve_batch(as_tibble = TRUE)` tibble now includes `value_as_concept_id` and `value_as_concept_name` columns, populated when the resolver decomposes a composite concept via the `Maps to value` - relationship (HL7 FHIR-to-OMOP IG Value-as-Concept pattern — e.g. "Allergy to + relationship (HL7 FHIR-to-OMOP IG Value-as-Concept pattern - e.g. "Allergy to penicillin" yields a standard "Allergy to drug" plus a value "Penicillin G"). -* **`on_unmapped` for FHIR resolution** — `resolve()`, `resolve_batch()`, and +* **`on_unmapped` for FHIR resolution** - `resolve()`, `resolve_batch()`, and `resolve_codeable_concept()` gained an `on_unmapped` argument (`"error"` default / `"sentinel"`). With `"sentinel"` the resolver returns a `concept_id` 0 record instead of a 404 when nothing resolves, so ETL @@ -27,7 +63,7 @@ ## Behavior Changes -* **Unmapped rows in the batch tibble** — a coding that resolves to a source +* **Unmapped rows in the batch tibble** - a coding that resolves to a source concept but has no standard `Maps to` target now reports `status = "unmapped"` (with `standard_concept_id = 0`) instead of `"resolved"`, matching the OMOP / FHIR-to-OMOP IG convention that an unmapped concept is `concept_id 0`. Code diff --git a/R/mappings.R b/R/mappings.R index bcfc368..ff02170 100644 --- a/R/mappings.R +++ b/R/mappings.R @@ -15,38 +15,131 @@ MappingsResource <- R6::R6Class( }, #' @description - #' Get mappings for a concept. + #' Get one page of mappings for a concept. + #' + #' The endpoint is paginated and a concept can easily have more mappings + #' than one page holds, so a full page means "there is probably more", + #' not "this is everything". Read the `pagination` attribute on the + #' result, or use `get_all()` to walk every page. #' #' @param concept_id The concept ID. #' @param target_vocabulary Filter to a specific target vocabulary (e.g., "ICD10CM"). - #' @param include_invalid Include invalid/deprecated mappings. Default `FALSE`. + #' @param include_invalid Whether to return mappings whose relationship or + #' target concept is deprecated. Default `NULL` takes the server default, + #' which for this endpoint is to *include* them; pass `FALSE` to exclude + #' them. The source concept is never filtered, so a deprecated concept + #' still returns what it maps to. #' @param vocab_release Specific vocabulary release version (e.g., "2025.1"). Default `NULL`. + #' @param relationship_ids Character vector of relationship types to return. + #' Defaults server-side to `"Maps to"`. Pass `c("Maps to", "Maps to value")` + #' to also get the Value-as-Concept decomposition of composite concepts - + #' "Allergy to penicillin G" maps to "Allergy to drug" via `Maps to` and to + #' "penicillin G" via `Maps to value`, and the default returns only the + #' first of those. + #' @param page Page number. Default 1. + #' @param page_size Mappings per page. Default 100, maximum 200. #' - #' @returns Mappings for the concept. + #' @returns Mappings for the concept, with pagination metadata attached as + #' the `pagination` attribute. get = function(concept_id, target_vocabulary = NULL, - include_invalid = FALSE, - vocab_release = NULL) { + include_invalid = NULL, + vocab_release = NULL, + relationship_ids = NULL, + page = 1, + page_size = 100) { concept_id <- validate_concept_id(concept_id) + pag <- validate_pagination(page, page_size, max_page_size = 200) - params <- list() + params <- list( + page = pag$page, + page_size = pag$page_size + ) if (!is.null(target_vocabulary)) { checkmate::assert_string(target_vocabulary, min.chars = 1) params$target_vocabulary <- target_vocabulary } - if (isTRUE(include_invalid)) { - params$include_invalid <- "true" + if (!is.null(relationship_ids)) { + checkmate::assert_character( + relationship_ids, + min.len = 1, + any.missing = FALSE + ) + params$relationship_ids <- paste(relationship_ids, collapse = ",") + } + # Tri-state, not a flag. This endpoint defaults to *including* deprecated + # mappings, so omitting the parameter and sending "false" are different + # requests -- dropping a FALSE would silently return the rows the caller + # asked to exclude. + if (!is.null(include_invalid)) { + checkmate::assert_flag(include_invalid) + params$include_invalid <- if (include_invalid) "true" else "false" } if (!is.null(vocab_release)) { checkmate::assert_string(vocab_release, min.chars = 1) params$vocab_release <- vocab_release } - perform_get( + result <- perform_get( private$.base_req, paste0("concepts/", concept_id, "/mappings"), - query = if (length(params) > 0) params else NULL + query = params + ) + + private$.with_pagination(result) + }, + + #' @description + #' Get every mapping for a concept, walking all pages. + #' + #' Prefer this over `get()` when assembling a code list — `get()` returns + #' a single page, and a partial code list is wrong in a way nothing in + #' the result reveals. + #' + #' @param concept_id The concept ID. + #' @param target_vocabulary Filter to a specific target vocabulary (e.g., "ICD10CM"). + #' @param include_invalid Whether to return deprecated mappings. Same + #' semantics as `$get()`, including the include-by-default behaviour. + #' @param vocab_release Specific vocabulary release version (e.g., "2025.1"). Default `NULL`. + #' @param relationship_ids Relationship types to return. Same semantics as + #' `$get()` -- see there for the Value-as-Concept case. + #' @param page_size Mappings fetched per request. Default 100, maximum 200. + #' @param max_pages Maximum pages to fetch. Default `Inf`. + #' @param progress Show progress bar. Default `TRUE`. + #' + #' @returns A tibble of all mappings for the concept. + get_all = function(concept_id, + target_vocabulary = NULL, + include_invalid = NULL, + vocab_release = NULL, + relationship_ids = NULL, + page_size = 100, + max_pages = Inf, + progress = TRUE) { + concept_id <- validate_concept_id(concept_id) + + fetch_fn <- function(page, size) { + result <- self$get( + concept_id, + target_vocabulary = target_vocabulary, + relationship_ids = relationship_ids, + include_invalid = include_invalid, + page = page, + page_size = size, + vocab_release = vocab_release + ) + list( + data = result$mappings %||% list(), + meta = attr(result, "pagination") %||% list() + ) + } + + paginate_all( + fetch_fn, + page_size = page_size, + max_pages = max_pages, + progress = progress ) }, @@ -120,11 +213,31 @@ MappingsResource <- R6::R6Class( #' Print resource information. print = function() { cat("\n") - cat(" Methods: get, map\n") + cat(" Methods: get, get_all, map\n") invisible(self) } ), private = list( - .base_req = NULL + .base_req = NULL, + + # Keep get()'s return shape stable across the API gaining pagination. + # + # perform_get() switches shape based on the response: without + # meta.pagination it unwraps to body$data (so `result$mappings` works), + # with it, it returns list(data = , meta = ). When + # GET /concepts/{id}/mappings became paginated on 2026-08-04 that flipped + # this method's result out from under existing callers — `result$mappings` + # started returning NULL against an unchanged SDK, with no error. + # + # So unwrap back to the documented shape and carry the pagination as an + # attribute, which adds the new information without moving the old. + .with_pagination = function(result) { + if (is.list(result) && !is.null(result$data) && !is.null(result$meta)) { + out <- result$data + attr(out, "pagination") <- result$meta + return(out) + } + result + } ) ) diff --git a/README.md b/README.md index b9fcc1d..853b507 100644 --- a/README.md +++ b/README.md @@ -75,8 +75,10 @@ results$data # Get concept by vocabulary code snomed_concept <- client$concepts$get_by_code("SNOMED", "44054006") -# Map to another vocabulary -mappings <- client$mappings$get(201826, target_vocabulary = "ICD10CM") +# Map to another vocabulary. `Maps to` points at *standard* concepts, so +# SNOMED -> ICD10CM returns nothing; look the code up and map it instead. +icd <- client$concepts$get_by_code("ICD10CM", "E11.9") +mappings <- client$mappings$get(icd$concept_id, target_vocabulary = "SNOMED") # Navigate hierarchy ancestors <- client$hierarchy$ancestors(201826, max_levels = 3) @@ -391,7 +393,7 @@ concepts_df %>% | `concepts` | Concept lookup and batch operations | `get()`, `get_by_code()`, `batch()`, `suggest()` | | `search` | Full-text and semantic search | `basic()`, `advanced()`, `semantic()`, `similar()`, `bulk_basic()`, `bulk_semantic()` | | `hierarchy` | Navigate concept relationships | `ancestors()`, `descendants()` | -| `mappings` | Cross-vocabulary mappings | `get()`, `map()` | +| `mappings` | Cross-vocabulary mappings | `get()`, `get_all()`, `map()` | | `vocabularies` | Vocabulary metadata | `list()`, `get()`, `stats()` | | `domains` | Domain information | `list()`, `get()`, `concepts()` | | `fhir` | FHIR-to-OMOP resolution | `resolve()`, `resolve_batch()`, `resolve_codeable_concept()` | diff --git a/inst/examples/map_between_vocabularies.R b/inst/examples/map_between_vocabularies.R index 9c65638..b4749fd 100644 --- a/inst/examples/map_between_vocabularies.R +++ b/inst/examples/map_between_vocabularies.R @@ -34,75 +34,122 @@ DIABETES_CONCEPT_ID <- 201826 cat("1. Getting mappings for a SNOMED concept\n") cat("-----------------------------------------\n") -# Get all mappings for Type 2 diabetes +# One page of mappings for Type 2 diabetes. `get()` is NOT the whole set -- +# read attr(mappings, "pagination") or use get_all(), shown in section 3. mappings <- client$mappings$get(DIABETES_CONCEPT_ID) +pag <- attr(mappings, "pagination") cat(sprintf("Mappings for concept %d (Type 2 diabetes mellitus):\n", DIABETES_CONCEPT_ID)) -mapping_list <- mappings$mappings %||% mappings$data %||% mappings -for (m in mapping_list) { - target <- m$target_concept %||% m - cat(sprintf(" -> [%s] %s (%s)\n", - target$concept_code %||% m$target_concept_code %||% "?", - target$concept_name %||% m$target_concept_name %||% "Unknown", - target$vocabulary_id %||% m$target_vocabulary_id %||% "?")) +if (!is.null(pag)) { + cat(sprintf(" page %s of %s, %s in total\n", + pag$page, pag$total_pages, pag$total_items)) +} +for (m in mappings$mappings) { + # This endpoint projects each row down to source/target id + name, + # relationship_id and confidence. Vocabulary id and concept code are not + # included -- resolve them with client$concepts$get(target_concept_id), + # as section 2 does. (client$mappings$map() does return them.) + cat(sprintf(" %s: %s %s\n", + m$relationship_id, m$target_concept_id, m$target_concept_name)) } cat("\n") # ============================================================================ -# Get Mappings to Specific Vocabulary +# Mapping to a Specific Vocabulary -- Mind the Direction # ============================================================================ -cat("2. Mapping to ICD-10-CM only\n") -cat("----------------------------\n") +cat("2. Which ICD-10-CM codes correspond to this concept\n") +cat("---------------------------------------------------\n") -# Get only ICD-10-CM mappings -icd_mappings <- client$mappings$get( +# `Maps to` always points at a *standard* concept, and ICD-10-CM is +# non-standard, so filtering the default relationship to ICD10CM matches +# nothing -- an empty list, not an error. The codes that roll up INTO a +# standard concept are reached with `Mapped from`. +empty <- client$mappings$get( DIABETES_CONCEPT_ID, target_vocabulary = "ICD10CM" ) +cat(sprintf(" 'Maps to' + ICD10CM: %d rows (as expected)\n", + length(empty$mappings))) -cat("ICD-10-CM mappings for Type 2 diabetes:\n") -mapping_list <- icd_mappings$mappings %||% icd_mappings$data %||% icd_mappings -for (m in mapping_list) { - target <- m$target_concept %||% m - cat(sprintf(" %s - %s\n", - target$concept_code %||% m$target_concept_code %||% "?", - target$concept_name %||% m$target_concept_name %||% "Unknown")) +icd_mappings <- client$mappings$get_all( + DIABETES_CONCEPT_ID, + relationship_ids = "Mapped from", + target_vocabulary = "ICD10CM", + progress = FALSE +) +cat(sprintf(" 'Mapped from' + ICD10CM: %d rows\n", nrow(icd_mappings))) + +# The mapping row has the target's id and name but not its code, so resolve +# the first few. One request each -- fine for five rows, not for all 74. +for (i in seq_len(min(5, nrow(icd_mappings)))) { + target <- client$concepts$get(icd_mappings$target_concept_id[i]) + cat(sprintf(" <- [%s] %s %s\n", + target$vocabulary_id, target$concept_code, target$concept_name)) } cat("\n") # ============================================================================ -# Get Mappings Including Invalid/Deprecated +# Get Every Mapping, Across All Pages # ============================================================================ -cat("3. Mappings including invalid concepts\n") -cat("--------------------------------------\n") +cat("3. Every mapping, not just the first page\n") +cat("------------------------------------------\n") -# Include invalid/deprecated mappings -all_mappings <- client$mappings$get( - DIABETES_CONCEPT_ID, - include_invalid = TRUE +# Copy this one when building a code list: a partial code list is wrong in a +# way nothing in the result reveals. +all_mappings <- client$mappings$get_all(DIABETES_CONCEPT_ID, progress = FALSE) +cat(sprintf("Retrieved %d mappings in total\n\n", nrow(all_mappings))) + +# ============================================================================ +# Value-as-Concept: Composite Concepts Decompose Across Two Relationships +# ============================================================================ + +cat("4. Value-as-Concept\n") +cat("-------------------\n") + +# The default returns "Maps to" only, so you learn the patient is allergic to +# *a drug* but not *which* drug. +PENICILLIN_ALLERGY_ID <- 4167462 +decomposed <- client$mappings$get( + PENICILLIN_ALLERGY_ID, + relationship_ids = c("Maps to", "Maps to value") ) -cat("All mappings (including invalid):\n") -mapping_list <- all_mappings$mappings %||% all_mappings$data %||% all_mappings -for (m in mapping_list) { - target <- m$target_concept %||% m - invalid_status <- target$invalid_reason %||% m$invalid_reason %||% "" - status_str <- if (nzchar(invalid_status)) sprintf(" [%s]", invalid_status) else "" - - cat(sprintf(" [%s] %s%s\n", - target$vocabulary_id %||% m$target_vocabulary_id %||% "?", - target$concept_name %||% m$target_concept_name %||% "Unknown", - status_str)) +for (m in decomposed$mappings) { + # "Maps to" -> the OMOP concept column; "Maps to value" -> value_as_concept_id + column <- if (identical(m$relationship_id, "Maps to value")) { + "value_as_concept_id" + } else { + "concept_id" + } + cat(sprintf(" %s: %s -> %s\n", + m$relationship_id, m$target_concept_name, column)) } cat("\n") +# ============================================================================ +# Excluding Invalid/Deprecated Mappings +# ============================================================================ + +cat("5. Dropping deprecated mappings\n") +cat("-------------------------------\n") + +# Deprecated mappings are returned BY DEFAULT on this endpoint. FALSE is the +# meaningful direction; omitting the argument keeps them. +valid_only <- client$mappings$get_all( + DIABETES_CONCEPT_ID, + include_invalid = FALSE, + progress = FALSE +) +cat(sprintf(" default (includes deprecated): %d\n", nrow(all_mappings))) +cat(sprintf(" include_invalid = FALSE: %d\n\n", nrow(valid_only))) + # ============================================================================ # Batch Mapping Multiple Concepts # ============================================================================ -cat("4. Batch mapping multiple concepts\n") +cat("6. Batch mapping multiple concepts\n") cat("----------------------------------\n") # Map multiple SNOMED concepts to ICD-10-CM @@ -145,7 +192,7 @@ cat("\n") # Lookup Concept by Vocabulary Code # ============================================================================ -cat("5. Looking up concepts by code\n") +cat("7. Looking up concepts by code\n") cat("------------------------------\n") # Look up ICD-10-CM code E11 (Type 2 diabetes mellitus) @@ -171,7 +218,7 @@ cat("\n") # Mapping with Specific Vocabulary Release # ============================================================================ -cat("6. Mapping with specific vocabulary release\n") +cat("8. Mapping with specific vocabulary release\n") cat("-------------------------------------------\n") # Get mappings from a specific vocabulary release version @@ -182,8 +229,7 @@ versioned_mappings <- client$mappings$get( ) cat("Mappings from vocabulary release 2025.1:\n") -mapping_list <- versioned_mappings$mappings %||% versioned_mappings$data %||% versioned_mappings -cat(sprintf(" Found %d mappings\n", length(mapping_list))) +cat(sprintf(" Found %d mappings\n", length(versioned_mappings$mappings))) cat("\n") # ============================================================================ diff --git a/man/MappingsResource.Rd b/man/MappingsResource.Rd index 4ca173c..dbc786b 100644 --- a/man/MappingsResource.Rd +++ b/man/MappingsResource.Rd @@ -4,7 +4,10 @@ \alias{MappingsResource} \title{Mappings Resource} \value{ -Mappings for the concept. +Mappings for the concept, with pagination metadata attached as +the \code{pagination} attribute. + +A tibble of all mappings for the concept. Mapping results with summary. } @@ -17,6 +20,7 @@ R6 class providing access to mapping operations. \itemize{ \item \href{#method-MappingsResource-new}{\code{MappingsResource$new()}} \item \href{#method-MappingsResource-get}{\code{MappingsResource$get()}} +\item \href{#method-MappingsResource-get_all}{\code{MappingsResource$get_all()}} \item \href{#method-MappingsResource-map}{\code{MappingsResource$map()}} \item \href{#method-MappingsResource-print}{\code{MappingsResource$print()}} \item \href{#method-MappingsResource-clone}{\code{MappingsResource$clone()}} @@ -43,13 +47,72 @@ Create a new MappingsResource. \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MappingsResource-get}{}}} \subsection{Method \code{get()}}{ -Get mappings for a concept. +Get one page of mappings for a concept. + +The endpoint is paginated and a concept can easily have more mappings +than one page holds, so a full page means "there is probably more", +not "this is everything". Read the \code{pagination} attribute on the +result, or use \code{get_all()} to walk every page. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MappingsResource$get( concept_id, target_vocabulary = NULL, - include_invalid = FALSE, - vocab_release = NULL + include_invalid = NULL, + vocab_release = NULL, + relationship_ids = NULL, + page = 1, + page_size = 100 +)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{concept_id}}{The concept ID.} + +\item{\code{target_vocabulary}}{Filter to a specific target vocabulary (e.g., "ICD10CM").} + +\item{\code{include_invalid}}{Whether to return mappings whose relationship or +target concept is deprecated. Default \code{NULL} takes the server default, +which for this endpoint is to \emph{include} them; pass \code{FALSE} to exclude +them. The source concept is never filtered, so a deprecated concept +still returns what it maps to.} + +\item{\code{vocab_release}}{Specific vocabulary release version (e.g., "2025.1"). Default \code{NULL}.} + +\item{\code{relationship_ids}}{Character vector of relationship types to return. +Defaults server-side to \code{"Maps to"}. Pass \code{c("Maps to", "Maps to value")} +to also get the Value-as-Concept decomposition of composite concepts - +"Allergy to penicillin G" maps to "Allergy to drug" via \verb{Maps to} and to +"penicillin G" via \verb{Maps to value}, and the default returns only the +first of those.} + +\item{\code{page}}{Page number. Default 1.} + +\item{\code{page_size}}{Mappings per page. Default 100, maximum 200.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-MappingsResource-get_all}{}}} +\subsection{Method \code{get_all()}}{ +Get every mapping for a concept, walking all pages. + +Prefer this over \code{get()} when assembling a code list — \code{get()} returns +a single page, and a partial code list is wrong in a way nothing in +the result reveals. +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{MappingsResource$get_all( + concept_id, + target_vocabulary = NULL, + include_invalid = NULL, + vocab_release = NULL, + relationship_ids = NULL, + page_size = 100, + max_pages = Inf, + progress = TRUE )}\if{html}{\out{
}} } @@ -60,9 +123,19 @@ Get mappings for a concept. \item{\code{target_vocabulary}}{Filter to a specific target vocabulary (e.g., "ICD10CM").} -\item{\code{include_invalid}}{Include invalid/deprecated mappings. Default \code{FALSE}.} +\item{\code{include_invalid}}{Whether to return deprecated mappings. Same +semantics as \verb{$get()}, including the include-by-default behaviour.} \item{\code{vocab_release}}{Specific vocabulary release version (e.g., "2025.1"). Default \code{NULL}.} + +\item{\code{relationship_ids}}{Relationship types to return. Same semantics as +\verb{$get()} -- see there for the Value-as-Concept case.} + +\item{\code{page_size}}{Mappings fetched per request. Default 100, maximum 200.} + +\item{\code{max_pages}}{Maximum pages to fetch. Default \code{Inf}.} + +\item{\code{progress}}{Show progress bar. Default \code{TRUE}.} } \if{html}{\out{}} } diff --git a/tests/testthat/test-mappings.R b/tests/testthat/test-mappings.R index a070db2..f74cd1a 100644 --- a/tests/testthat/test-mappings.R +++ b/tests/testthat/test-mappings.R @@ -18,7 +18,7 @@ test_that("MappingsResource print method works", { resource <- MappingsResource$new(base_req) expect_output(print(resource), "") - expect_output(print(resource), "get, map") + expect_output(print(resource), "get, get_all, map") }) # ============================================================================== @@ -50,6 +50,105 @@ test_that("mappings$get calls correct endpoint", { expect_equal(called_with$path, "concepts/201826/mappings") }) +test_that("mappings$get sends pagination params, defaults included", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + list(mappings = list()) + } + ) + + resource$get(201826) + expect_equal(called_with$query$page, 1L) + expect_equal(called_with$query$page_size, 100L) + + resource$get(201826, page = 3, page_size = 200) + expect_equal(called_with$query$page, 3L) + expect_equal(called_with$query$page_size, 200L) +}) + +test_that("mappings$get rejects a page_size above the server ceiling", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + expect_error(resource$get(201826, page_size = 500)) + expect_error(resource$get(201826, page = 0)) +}) + +test_that("mappings$get keeps $mappings reachable when the API returns pagination", { + # Regression guard: perform_get() changes shape once meta.pagination is + # present, which silently moved mappings to $data$mappings for callers. + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + pagination <- list( + page = 1L, page_size = 100L, total_items = 232L, + total_pages = 3L, has_next = TRUE, has_previous = FALSE + ) + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + list( + data = list(mappings = list(list(target_concept_id = 1))), + meta = pagination + ) + } + ) + + result <- resource$get(201826) + + expect_length(result$mappings, 1) + expect_equal(attr(result, "pagination")$total_items, 232L) + expect_true(attr(result, "pagination")$has_next) +}) + +test_that("mappings$get_all walks every page", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + pages_requested <- integer(0) + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + page <- query$page + pages_requested <<- c(pages_requested, page) + list( + data = list(mappings = list(list(target_concept_id = page))), + meta = list( + page = page, page_size = 1L, total_items = 2L, + total_pages = 2L, has_next = page < 2L, has_previous = page > 1L + ) + ) + } + ) + + result <- resource$get_all(201826, page_size = 1, progress = FALSE) + + expect_equal(pages_requested, c(1L, 2L)) + expect_equal(nrow(result), 2) + expect_equal(result$target_concept_id, c(1L, 2L)) +}) + +test_that("mappings$get_all stops after one page without pagination metadata", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + calls <- 0L + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + calls <<- calls + 1L + list(mappings = list(list(target_concept_id = 1))) + } + ) + + result <- resource$get_all(201826, page_size = 100, progress = FALSE) + + expect_equal(calls, 1L) + expect_equal(nrow(result), 1) +}) + test_that("mappings$get includes target vocabulary filter", { base_req <- httr2::request("https://api.omophub.com/v1") resource <- MappingsResource$new(base_req) @@ -84,6 +183,162 @@ test_that("mappings$get includes include_invalid option", { expect_equal(called_with$query$include_invalid, "true") }) +# @param-order vs signature is checked for every R6 method in the package +# by test-roxygen-param-order.R, so there is no mappings-only copy here. +test_that("mappings$get keeps the 1.8.1 positional contract", { + # 1.8.1 shipped get(concept_id, target_vocabulary, include_invalid, + # vocab_release). New arguments must be APPENDED: inserting one shifts every + # positional caller onto the wrong parameter, and because the new arguments + # validate their types, the symptom is a validation error rather than a + # wrong result. + formal_names <- names(formals(MappingsResource$public_methods$get)) + expect_equal( + formal_names[1:4], + c("concept_id", "target_vocabulary", "include_invalid", "vocab_release") + ) + + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + list(mappings = list()) + } + ) + + # The exact positional call a 1.8.1 user could have written. + resource$get(201826, "ICD10CM", FALSE, "2025.1") + + expect_equal(called_with$query$target_vocabulary, "ICD10CM") + expect_equal(called_with$query$include_invalid, "false") + expect_equal(called_with$query$vocab_release, "2025.1") + expect_null(called_with$query$relationship_ids) +}) + +test_that("mappings$get comma-joins relationship_ids", { + # Value-as-Concept is unreachable without this: the server defaults to + # "Maps to" alone, so a composite concept returns only half its + # decomposition unless "Maps to value" is asked for too. + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + list(mappings = list()) + } + ) + + resource$get(4167462) + expect_null(called_with$query$relationship_ids) + + resource$get(4167462, relationship_ids = c("Maps to", "Maps to value")) + expect_equal(called_with$query$relationship_ids, "Maps to,Maps to value") + + resource$get(4167462, relationship_ids = "Maps to value") + expect_equal(called_with$query$relationship_ids, "Maps to value") +}) + +test_that("mappings$get_all forwards relationship_ids", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + structure( + list(mappings = list()), + pagination = list( + page = 1, page_size = 100, total_items = 0, + total_pages = 0, has_next = FALSE, has_previous = FALSE + ) + ) + } + ) + + resource$get_all( + 4167462, + relationship_ids = c("Maps to", "Maps to value"), + progress = FALSE + ) + + expect_equal(called_with$query$relationship_ids, "Maps to,Maps to value") +}) + +test_that("mappings$get rejects a non-character relationship_ids", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + local_mocked_bindings( + perform_get = function(req, path, query = NULL) list(mappings = list()) + ) + + expect_error(resource$get(4167462, relationship_ids = 42)) +}) + +test_that("mappings$get treats include_invalid as tri-state, not a flag", { + # This endpoint defaults to *including* deprecated mappings, so omitting the + # parameter and sending "false" are different requests. FALSE used to be + # dropped as falsy, silently returning the rows the caller asked to exclude. + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + list(mappings = list()) + } + ) + + resource$get(201826) + expect_null(called_with$query$include_invalid) + + resource$get(201826, include_invalid = FALSE) + expect_equal(called_with$query$include_invalid, "false") + + resource$get(201826, include_invalid = TRUE) + expect_equal(called_with$query$include_invalid, "true") +}) + +test_that("mappings$get_all forwards include_invalid = FALSE", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + called_with <- NULL + local_mocked_bindings( + perform_get = function(req, path, query = NULL) { + called_with <<- list(query = query) + structure( + list(mappings = list()), + pagination = list( + page = 1, page_size = 100, total_items = 0, + total_pages = 0, has_next = FALSE, has_previous = FALSE + ) + ) + } + ) + + resource$get_all(201826, include_invalid = FALSE, progress = FALSE) + + expect_equal(called_with$query$include_invalid, "false") +}) + +test_that("mappings$get rejects a non-flag include_invalid", { + base_req <- httr2::request("https://api.omophub.com/v1") + resource <- MappingsResource$new(base_req) + + local_mocked_bindings( + perform_get = function(req, path, query = NULL) list(mappings = list()) + ) + + expect_error(resource$get(201826, include_invalid = "yes")) +}) + test_that("mappings$get includes vocab_release option", { base_req <- httr2::request("https://api.omophub.com/v1") resource <- MappingsResource$new(base_req) diff --git a/tests/testthat/test-roxygen-param-order.R b/tests/testthat/test-roxygen-param-order.R new file mode 100644 index 0000000..7bc62a5 --- /dev/null +++ b/tests/testthat/test-roxygen-param-order.R @@ -0,0 +1,111 @@ +# Roxygen renders a method's Arguments section in SIGNATURE order, so a @param +# block that disagrees with the signature still produces correct help. The +# damage is to the source: the next person editing the block sees an argument +# order that contradicts the signature a few lines below, which is how the +# 1.9.0 reorder of MappingsResource$get() came to shift `include_invalid` and +# `vocab_release` out of the positions 1.8.1 had shipped. +# +# For an R6 method, position IS the public contract -- R has no keyword-only +# arguments -- so this guard covers every documented method in the package +# rather than only the ones that have been bitten so far. + +#' Extract the R6 generator name a source file defines, or NULL. +generator_name <- function(src) { + hit <- grep("^[A-Za-z][A-Za-z0-9_.]* <- R6::R6Class\\(", src) + if (length(hit) != 1) { + return(NULL) + } + sub("^([A-Za-z][A-Za-z0-9_.]*) <- R6::R6Class\\(.*$", "\\1", src[hit]) +} + +#' @param names, in source order, of the roxygen block directly above `sig`. +documented_params <- function(src, sig) { + i <- sig - 1 + while (i >= 1 && grepl("^ #'", src[i])) i <- i - 1 + if (i + 1 > sig - 1) { + return(character(0)) + } + block <- src[(i + 1):(sig - 1)] + as.character( + sub("^ #' @param ([^ ]+).*$", "\\1", grep("^ #' @param ", block, value = TRUE)) + ) +} + +test_that("every documented R6 method lists @param in signature order", { + # This reads the package SOURCE, which only exists in a source tree. Under + # `R CMD check` and `covr` the tests run against an INSTALLED copy, whose R/ + # holds omophub.rdb rather than any .R file -- so the scan would find zero + # files and, without this skip, fail the check for reasons unrelated to the + # code. `.github/workflows/R-CMD-check.yaml` runs the guard against the + # checkout in a separate step so it still gates every PR. + # + # One list.files() call feeds both the skip and the scan, so the two cannot + # drift apart -- e.g. someone widening the pattern in one place only. No + # dir.exists() guard is needed: list.files() on a missing directory returns + # character(0) rather than erroring. + files <- list.files( + file.path(test_path("..", ".."), "R"), + pattern = "[.]R$", full.names = TRUE + ) + skip_if_not( + length(files) > 0, + "package source not available (installed-package check)" + ) + + generators_seen <- 0 + for (f in files) { + src <- readLines(f, warn = FALSE) + gen_name <- generator_name(src) + if (is.null(gen_name) || !exists(gen_name)) next + generator <- get(gen_name) + generators_seen <- generators_seen + 1 + + found <- character(0) + for (sig in grep("^ [a-zA-Z_.][a-zA-Z0-9_.]* = function\\(", src)) { + method <- sub("^ ([a-zA-Z_.][a-zA-Z0-9_.]*) = function\\(.*$", "\\1", src[sig]) + fn <- generator$public_methods[[method]] + if (is.null(fn)) next + found <- c(found, method) + + # `...` drops out of BOTH sides: documenting it is good practice but + # optional, and whether a method does is not an ORDER question. + documented <- setdiff(documented_params(src, sig), "...") + actual <- setdiff(as.character(names(formals(fn))), "...") + + if (length(documented) == 0L) { + # Skipping is only legitimate when there is nothing to order. A method + # that takes arguments and documents none would otherwise slip through + # this guard silently. + expect_equal( + actual, character(0), + info = sprintf( + "%s$%s() takes arguments but documents no @param", gen_name, method + ) + ) + next + } + + expect_equal( + documented, actual, + info = sprintf("%s$%s() in %s", gen_name, method, basename(f)) + ) + } + + # Guard the guard, exactly rather than by a floor: every method the class + # actually has must have been reached by the scan. An indentation change or + # a signature the regex cannot see shows up here as a named missing method, + # and adding or removing a method never needs a hardcoded count updated. + # `clone` is generated by R6 and has no source block, so it is not expected. + expect_setequal(found, setdiff(names(generator$public_methods), "clone")) + } + + # And every R6 class in the package was reached, not just the first. Counted + # by a deliberately different route than generator_name() uses, so that a bug + # in its stricter pattern surfaces here instead of quietly shrinking scope. + classes_in_package <- sum(vapply( + files, + function(f) any(grepl("R6::R6Class(", readLines(f, warn = FALSE), fixed = TRUE)), + logical(1) + )) + expect_equal(generators_seen, classes_in_package) +}) diff --git a/vignettes/getting-started.Rmd b/vignettes/getting-started.Rmd index 3ab3fa0..958cdcb 100644 --- a/vignettes/getting-started.Rmd +++ b/vignettes/getting-started.Rmd @@ -309,18 +309,48 @@ Find how a concept maps to other vocabularies: result <- client$mappings$get(201826) for (mapping in result$mappings) { cat(sprintf("%s: %s\n", - mapping$target_vocabulary_id, + mapping$relationship_id, mapping$target_concept_name)) } ``` -Map to specific vocabularies: +`get()` returns one page. The pagination metadata rides along as an attribute, +and `get_all()` walks every page — prefer it when you are building a code list: + +```{r mappings-pagination} +attr(result, "pagination")$total_items + +all_mappings <- client$mappings$get_all(201826, progress = FALSE) +nrow(all_mappings) +``` + +Mind the direction when filtering by vocabulary. `Maps to` always points at a +*standard* concept, so asking a SNOMED concept for its ICD-10-CM mappings +returns nothing — an empty list, not an error. The codes that roll up into a +standard concept are reached with `Mapped from`: ```{r mappings-filter} -result <- client$mappings$get( +icd_codes <- client$mappings$get_all( 201826, - target_vocabulary = "ICD10CM" + relationship_ids = "Mapped from", + target_vocabulary = "ICD10CM", + progress = FALSE ) +nrow(icd_codes) +``` + +Composite concepts decompose across two relationships, and the default returns +only the first — `Maps to` gives you "Allergy to drug", while `Maps to value` +gives you *which* drug, destined for `value_as_concept_id`: + +```{r mappings-value-as-concept} +decomposed <- client$mappings$get( + 4167462, # Allergy to penicillin G + relationship_ids = c("Maps to", "Maps to value") +) +for (m in decomposed$mappings) { + cat(sprintf("%s: %s\n", m$relationship_id, m$target_concept_name)) +} ``` ## Error Handling