add api_members() #2 and concepts_map() wrapper motivated by #18

NAMESPACE

@@ -18,12 +18,14 @@ export(api_concept_descriptions)
 export(api_concepts)
 export(api_descriptions)
 export(api_descriptions_semantic_tags)
+export(api_members)
 export(api_relationship)
 export(api_relationships)
 export(api_version)
 export(concepts_descendants)
 export(concepts_descriptions)
 export(concepts_find)
+export(concepts_map)
 export(release_version)
 export(result_completeness)
 export(result_flatten)

R/rest-api.R

@@ -71,9 +71,19 @@
 #' @param limit a positive integer for the maximum number of results to return.
 #' See \code{\link{snomedizer_options}}. The maximum limit on public endpoints
 #' is 10,000.
+#' @param mapTarget target code to which the SNOMED CT concept represented the
+#' \code{referencedComponentId} is mapped in the target code system, classification,
+#' or terminology (eg ICD-10). This is only used for Map Reference Sets
 #' @param module character vector of SNOMED CT modules to include (example:
 #' \code{"900000000000207008"})
 #' @param offset an integer indicating the number of results to skip
+#' @param owlExpression.conceptId a string for a concept identifier within an
+#' owlExpression. Consult the
+#' \href{SNOMED CT OWL Guide}{http://snomed.org/owl} for detail.
+#' @param owlExpression.gci a boolean indicating whether to return axiom members
+#' with a GCI owlExpression (\code{TRUE}), without (\code{FALSE}), or all members
+#' (\code{NULL}, the default). Consult the
+#' \href{SNOMED CT OWL Guide}{http://snomed.org/owl} for detail.
 #' @param preferredIn character vector of description language reference sets
 #' (example: \code{"900000000000509007"}).
 #' The description must be preferred in at least one of these to match.
@@ -111,6 +121,10 @@
 #' sources defined by the relationship
 #' @param stated a boolean indicating whether to limit search to descendants
 #' whose relationship is stated rather than inferred. Default is \code{FALSE}.
+#' @param targetComponent string identifier the target code
+#' (concept or description) in an Association Reference Set. Consult the
+#' \href{Association Reference Set data structure}{https://confluence.ihtsdotools.org/display/DOCRELFMT/5.2.5+Association+Reference+Set}
+#' for detail.
 #' @param term character vector of terms to search
 #' @param type character vector of concept codes defining the type of description or
 #' the type of attribute/relationship to include, depending on the function:
@@ -881,7 +895,6 @@ api_browser_members <- function(
   # RF2 reference set descriptor data structure
   # https://confluence.ihtsdotools.org/display/DOCRELFMT/5.2.11+Reference+Set+Descriptor
 
-
   stopifnot(length(referenceSet) == 1 | is.null(referenceSet))
   stopifnot(length(referenceSetModule) == 1 | is.null(referenceSetModule))
   stopifnot(is.null(offset) | length(offset) == 1)
@@ -913,3 +926,66 @@ api_browser_members <- function(
 
   rest_result
 }
+
+
+#' @rdname api_operations
+#' @export
+api_members <- function(
+  referenceSet = NULL,
+  referenceSetModule = NULL,
+  referencedComponentId = NULL,
+  active = NULL,
+  offset = NULL,
+  targetComponent = NULL,
+  mapTarget = NULL,
+  owlExpression.conceptId = NULL,
+  owlExpression.gci = NULL,
+  endpoint = snomedizer_options_get("endpoint"),
+  branch = snomedizer_options_get("branch"),
+  limit = snomedizer_options_get("limit"),
+  catch404 = TRUE
+) {
+
+  # get /{branch}/members
+  # RF2 reference set descriptor data structure
+  # https://confluence.ihtsdotools.org/display/DOCRELFMT/5.2.11+Reference+Set+Descriptor
+
+  stopifnot(length(referenceSet) == 1 | is.null(referenceSet))
+  stopifnot(length(referenceSetModule) == 1 | is.null(referenceSetModule))
+  stopifnot(length(targetComponent) == 1 | is.null(targetComponent))
+  stopifnot(length(mapTarget) == 1 | is.null(mapTarget))
+  stopifnot(length(owlExpression.conceptId) == 1 | is.null(owlExpression.conceptId))
+  stopifnot(length(owlExpression.gci) == 1 | is.null(owlExpression.gci))
+  stopifnot(is.null(offset) | length(offset) == 1)
+  referencedComponentId <- .concatenate_array_parameter(referencedComponentId)
+  limit <- .validate_limit(limit)
+
+  rest_url <- httr::parse_url(endpoint)
+  rest_url$path <- c(rest_url$path[rest_url$path != ""],
+                     branch,
+                     "members")
+  rest_url$query <- list(
+    referenceSet = referenceSet,
+    module = referenceSetModule,
+    referencedComponentId = referencedComponentId,
+    active = active,
+    offset = offset,
+    targetComponent = targetComponent,
+    mapTarget = mapTarget,
+    owlExpression.conceptId = owlExpression.conceptId,
+    owlExpression.gci = owlExpression.gci,
+    limit = limit
+  )
+  .check_rest_query_length1(rest_url)
+
+  rest_url <- httr::build_url(rest_url)
+  rest_result <- GET(rest_url)
+
+  if(catch404){
+    .catch_http_error(rest_result)
+  }
+
+  rest_result
+}
+
+

R/wrapper.R

@@ -270,6 +270,129 @@ concepts_descriptions <- function(conceptIds,
 }
 
 
+#' Map SNOMED CT concepts to other terminology or code systems
+#'
+#' @description A wrapper function for the \code{\link{api_members}()} function.
+#' @param concept_ids an optional character vector of one or more SNOMED CT concept
+#' identifiers to be mapped
+#' @param target_code an optional character code designated the concept code in
+#' the other terminology or code system
+#' @param map_refset_id character identifier of a SNOMED CT Map Reference Set.
+#' The default is \code{"447562003"}
+#' @param active whether to restrict results to active concepts. Default is \code{TRUE}.
+#' @param encoding HTTP charset parameter to use (default is \code{"UTF-8"})
+#' @param silent whether to hide progress bar. Default is \code{FALSE}
+#' @param ... other optional arguments listed in \code{\link{api_operations}}, such as
+#' \code{endpoint}, \code{branch} or \code{limit}
+#'
+#' @return a data frame of SNOMED CT concepts mapped to another code system
+#' @export
+#'
+#' @examples
+#' # find SNOMED CT codes corresponding to urinary tract infections N39.0
+#' uti_concepts <- concepts_map(target_code = "N39.0")
+#' dplyr::select(uti_concepts,
+#'               referencedComponentId,
+#'               referencedComponent.pt.term,
+#'               additionalFields.mapTarget,
+#'               additionalFields.mapAdvice)
+#'
+#' # map SNOMED CT codes to ICD=10 codes
+#' map_icd10 <- concepts_map(concept_ids = c("431308006", "312124009", "53084003"))
+#' dplyr::select(map_icd10,
+#'               referencedComponentId,
+#'               referencedComponent.pt.term,
+#'               additionalFields.mapTarget,
+#'               additionalFields.mapAdvice)
+concepts_map <- function(concept_ids = NULL,
+                         target_code = NULL,
+                         map_refset_id = "447562003",
+                         active = TRUE,
+                         encoding = "UTF-8",
+                         silent = FALSE,
+                         ...) {
+
+  if( !is.null(concept_ids) ) {
+    concept_ids <- sort(unique(concept_ids))
+  }
+
+  if( !is.null(concept_ids) && length(unique(concept_ids)) > 100 ) {
+
+    if( !silent ) {
+      progress_bar <- progress::progress_bar$new(
+        format = "  [:bar] :percent :eta",
+        total = (trunc(length(concept_ids)/100) + 1)
+      )
+      progress_bar$tick(0)
+    }
+
+    concept_ids <- split(concept_ids, sort(trunc(seq_len(length(concept_ids))/100)))
+
+    x <- purrr::map(
+      .x = concept_ids,
+      .f = function(chunk,
+                    referenceSet,
+                    active,
+                    mapTarget,
+                    encoding,
+                    silent,
+                    ...) {
+        conc <- api_members(referencedComponentId = chunk,
+                            referenceSet = referenceSet,
+                            active = active,
+                            mapTarget = mapTarget,
+                            ...)
+        if( !silent ) {
+          progress_bar$tick()
+        }
+        if(httr::http_error(conc)) {
+          return(httr::content(conc))
+        } else if(length(httr::content(conc)$items) == 0) {
+          return(NULL)
+        } else {
+          ignore <- result_completeness(conc)
+          concepts <- httr::content(conc, encoding = encoding)
+          concepts <- lapply(concepts[["items"]], as.data.frame)
+          concepts <- dplyr::bind_rows(concepts)
+          return(concepts)
+        }},
+      referenceSet = map_refset_id,
+      active = active,
+      mapTarget = target_code,
+      encoding = encoding,
+      silent = silent,
+      ...
+    )
+
+    x <- dplyr::bind_rows(x)
+
+    return(x)
+
+  } else {
+    x <- api_members(
+      referencedComponentId = concept_ids,
+      referenceSet = map_refset_id,
+      active = active,
+      mapTarget = target_code,
+      ...
+    )
+
+    if(httr::http_error(x)) {
+      return(httr::content(x))
+    } else if(length(httr::content(x)$items) == 0) {
+      return(NULL)
+    } else {
+      ignore <- result_completeness(x)
+      concepts <- httr::content(x, encoding = encoding)
+      concepts <- lapply(concepts[["items"]], as.data.frame)
+      concepts <- dplyr::bind_rows(concepts)
+      return(concepts)
+    }
+  }
+}
+
+
+
 #' Fetch SNOMED CT RF2 release version
 #'
 #' @description Provides the date of the release of the specified endpoint
@@ -312,4 +435,3 @@ release_version <- function(endpoint = snomedizer_options_get("endpoint"),
     )
   )
 }
-

tests/testthat/test.rest-api.R

@@ -339,3 +339,25 @@ test_that("api_browser_members filtering by RefSet member and RefSet", {
   refsets <- dplyr::bind_rows(lapply(refsets$referenceSets, as.data.frame))
   expect_equal(refsets$id, "447562003")
 })
+
+# api_members ------------------------------------------------------------
+
+test_that("api_members find all concepts within ICD N39.0 urinary tract inf", {
+  uti_concepts <- httr::content(api_members(mapTarget = "N39.0",
+                                            referenceSet = "447562003"))
+  uti_concepts <- dplyr::bind_rows(lapply(uti_concepts$items, as.data.frame))
+  expect_true(all(
+    c("61373006", "4800001") %in% uti_concepts$referencedComponent.conceptId
+  ))
+})
+
+test_that("api_members find ICD code(s) corresponding to bacteriuria", {
+  bacteriuria <- httr::content(api_members(referenceSet = "447562003",
+                                           referencedComponentId = "61373006"))
+  bacteriuria <- dplyr::bind_rows(lapply(bacteriuria$items, as.data.frame))
+  expect_equal(
+    bacteriuria$additionalFields.mapTarget,
+    "N39.0"
+  )
+})
+