add api_relationships #2

NAMESPACE

@@ -14,6 +14,7 @@ export(api_concept_descriptions)
 export(api_concepts)
 export(api_descriptions)
 export(api_descriptions_semantic_tags)
+export(api_relationships)
 export(api_version)
 export(concepts_descendants)
 export(concepts_descriptions)

R/rest-api.R

@@ -37,6 +37,8 @@
 #' the count of descendant concepts based on stated or inferred relationships.
 #' Must be one of \code{"inferred"}, \code{"stated"}, or \code{"additional"}.
 #' Default is \code{NULL} for no descendant count reported.
+#' @param destination concept character string restricting the range of the
+#' relationships to be included in results
 #' @param ecl a character expression constraint query (with full relationship inference).
 #' Consult the \href{http://snomed.org/ecl}{Expression Constraint Language guide}
 #' for more detail.
@@ -66,6 +68,16 @@
 #' @param preferredOrAcceptableIn character vector of description language reference sets
 #' (example: \code{"900000000000509007"}).
 #' The description must be preferred OR acceptable in at least one of these to match.
+#' @param characteristicType a character string indicating whether to include
+#' results for: \itemize{
+#'     \item all relationships: NULL (the default)
+#'     \item only stated relationships: "STATED_RELATIONSHIP"
+#'     \item only inferred relationships: "INFERRED_RELATIONSHIP"
+#'     \item only additional relationships: ""ADDITIONAL_RELATIONSHIP" (for
+#'     instance, \code{123005000 | Part of (attribute) |})
+#' }
+#' This parameter corresponds to \code{
+#' 900000000000449001 | Characteristic type (core metadata concept)}
 #' @param searchMode a character string for the search mode. Must be either
 #' \code{"STANDARD"} (default) or \code{"REGEX"}.
 #' @param semanticTag character string of a description semantic tag
@@ -76,12 +88,19 @@
 #' to include (example: \code{c("attribute", "finding")}). See
 #' \code{api_descriptions_semantic_tags()} for a list of valid
 #' description semantic tags.
+#' @param source a character vector of concepts to be included as
+#' 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 term character vector of terms to search
-#' @param type character vector of description types to include. See
-#' \code{api_concept_descendants("900000000000446008")} for valid
-#' description type inputs.
+#' @param type character vector of concept codes defining the type of description or
+#' the type of attribute/relationship to include, depending on the function:
+#' \itemize{
+#'    \item see \code{api_concept_descendants("900000000000446008")} for valid
+#'    description type concepts.
+#'    \item see \code{api_concept_descendants("106237007")} for valid
+#'    attributes (relationship types) concepts.
+#'  }
 #' @param ... other REST API parameters
 #' @importFrom httr parse_url build_url GET
 #' @return An \code{httr} \code{\link[httr]{response}()} object.
@@ -646,6 +665,65 @@ api_descriptions_semantic_tags <- function(
   rest_result
 }
 
+#' @rdname api_operations
+#' @export
+api_relationships <- function(
+  endpoint = snomedizer_options_get("endpoint"),
+  branch = snomedizer_options_get("branch"),
+  active = NULL,
+  source = NULL,
+  type = NULL,
+  destination = NULL,
+  characteristicType = NULL,
+  limit = snomedizer_options_get("limit"),
+  offset = 0,
+  catch404 = TRUE,
+  ...) {
+
+  stopifnot(is.null(active) | length(active) == 1)
+  stopifnot(is.null(source) | length(source) == 1)
+  stopifnot(is.null(type) | length(type) == 1)
+  stopifnot(is.null(destination) | length(destination) == 1)
+
+  stopifnot(
+    is.null(characteristicType) |
+    characteristicType == "STATED_RELATIONSHIP" |
+    characteristicType == "INFERRED_RELATIONSHIP" |
+    characteristicType == "ADDITIONAL_RELATIONSHIP"
+  )
+
+  limit <- .validate_limit(limit)
+
+  rest_url <- httr::parse_url(endpoint)
+  rest_url$path <- c(rest_url$path[rest_url$path != ""],
+                     branch,
+                     "relationships")
+
+  rest_url$query <- list(
+    active = active,
+    source = source,
+    type = type,
+    destination = destination,
+    characteristicType = characteristicType,
+    limit = limit,
+    offset = offset
+  )
+
+  rest_url$query <- append(rest_url$query, list(...))
+  .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
+}
+
+
+
 
 
 

tests/testthat/test.rest-api.R

@@ -229,10 +229,28 @@ test_that("api_browser_concept_descriptions", {
 })
 
 
-
 # api_descriptions_semantic_tags ------------------------------------------
 
 test_that("api_descriptions_semantic_tags", {
   tags <- httr::content(api_descriptions_semantic_tags())
   expect_true("core metadata concept" %in% names(tags))
 })
+
+
+# api_relationships -------------------------------------------------------
+
+test_that("api_relationships", {
+  #test that NULL is equivalent to c("NULL", "NULL")
+  bacter_pneumo_relationships <- result_flatten(api_relationships(source = "312119006"))
+  expect_true(all(c("116680003", "246075003", "370135005", "363698007") %in%
+                    bacter_pneumo_relationships$type.conceptId))
+
+  caused_by_ecoli <- result_flatten(api_relationships(type = "246075003", destination = "112283007"))
+  expect_true(all(c("9323009", "10625111000119106") %in% caused_by_ecoli$source.conceptId))
+
+  caused_by_ecoli <- result_flatten(api_relationships(type = "246075003", destination = "112283007",
+                                                      characteristicType = "STATED_RELATIONSHIP"))
+  expect_false("INFERRED_RELATIONSHIP" %in% caused_by_ecoli$characteristicType)
+
+  expect_equal(api_relationships()$status_code, 200)
+})