From d2be72c341d06fb2aa29fbac47232638e49ba088 Mon Sep 17 00:00:00 2001
From: Peter Dutey
Date: Thu, 12 Nov 2020 14:23:40 +0000
Subject: [PATCH] add api_relationships #2
---
NAMESPACE | 1 +
R/rest-api.R | 84 ++++++++++++++++++++++++++++++++--
man/api_operations.Rd | 43 +++++++++++++++--
tests/testthat/test.rest-api.R | 20 +++++++-
4 files changed, 141 insertions(+), 7 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
index 4c3943c..1af2fe6 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/rest-api.R b/R/rest-api.R
index 53847c3..07e9522 100644
--- a/R/rest-api.R
+++ b/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
+}
+
+
+
diff --git a/man/api_operations.Rd b/man/api_operations.Rd
index 2a36304..7f0ea68 100644
--- a/man/api_operations.Rd
+++ b/man/api_operations.Rd
@@ -17,6 +17,7 @@
\alias{api_browser_concept_parents}
\alias{api_browser_concept_descriptions}
\alias{api_descriptions_semantic_tags}
+\alias{api_relationships}
\title{SNOMED CT Terminology Server REST API operations}
\usage{
api_concept(
@@ -149,6 +150,20 @@ api_descriptions_semantic_tags(
branch = snomedizer_options_get("branch"),
catch404 = TRUE
)
+
+api_relationships(
+ 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,
+ ...
+)
}
\arguments{
\item{conceptId}{character string of a SNOMED-CT concept id (for example:
@@ -217,9 +232,14 @@ children/descendants counter should be included in the result}
\item{language}{vector of two-character language codes to include
(example: \code{c("en", "de")}).}
-\item{type}{character vector of description types to include. See
-\code{api_concept_descendants("900000000000446008")} for valid
-description type inputs.}
+\item{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.
+ }}
\item{semanticTag}{character string of a description semantic tag
to include (example: \code{"attribute"}). See
@@ -259,6 +279,23 @@ by concept. Default is \code{FALSE}.}
\item{searchMode}{a character string for the search mode. Must be either
\code{"STANDARD"} (default) or \code{"REGEX"}.}
+
+\item{source}{a character vector of concepts to be included as
+sources defined by the relationship}
+
+\item{destination}{concept character string restricting the range of the
+relationships to be included in results}
+
+\item{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)}}
}
\value{
An \code{httr} \code{\link[httr]{response}()} object.
diff --git a/tests/testthat/test.rest-api.R b/tests/testthat/test.rest-api.R
index ce0739b..a857510 100644
--- a/tests/testthat/test.rest-api.R
+++ b/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)
+})