P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 06:51:48 +02:00
Code Releases Activity

(v1.4.0.9003) CoNS update

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-10-20 21:00:57 +02:00
parent ddae8085e1
commit 2ef7dfc8a3
21 changed files with 112 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
R/ab_property.R
View File

@ -89,7 +89,7 @@
#' ab_atc("cephthriaxone")
#' ab_atc("seephthriaaksone")
ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(tolower, allow_class = "logical", has_length = 1)
@ -106,21 +106,21 @@ ab_name <- function(x, language = get_locale(), tolower = FALSE, ...) {
#' @aliases ATC
#' @export
ab_atc <- function(x, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
ab_validate(x = x, property = "atc", ...)
}
#' @rdname ab_property
#' @export
ab_cid <- function(x, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
ab_validate(x = x, property = "cid", ...)
}
#' @rdname ab_property
#' @export
ab_synonyms <- function(x, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
syns <- ab_validate(x = x, property = "synonyms", ...)
names(syns) <- x
if (length(syns) == 1) {
@ -133,14 +133,14 @@ ab_synonyms <- function(x, ...) {
#' @rdname ab_property
#' @export
ab_tradenames <- function(x, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
ab_synonyms(x, ...)
}
#' @rdname ab_property
#' @export
ab_group <- function(x, language = get_locale(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "group", ...), language = language)
}
@ -148,7 +148,7 @@ ab_group <- function(x, language = get_locale(), ...) {
#' @rdname ab_property
#' @export
ab_atc_group1 <- function(x, language = get_locale(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "atc_group1", ...), language = language)
}
@ -156,7 +156,7 @@ ab_atc_group1 <- function(x, language = get_locale(), ...) {
#' @rdname ab_property
#' @export
ab_atc_group2 <- function(x, language = get_locale(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = "atc_group2", ...), language = language)
}
@ -164,7 +164,7 @@ ab_atc_group2 <- function(x, language = get_locale(), ...) {
#' @rdname ab_property
#' @export
ab_loinc <- function(x, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
loincs <- ab_validate(x = x, property = "loinc", ...)
names(loincs) <- x
if (length(loincs) == 1) {
@ -177,7 +177,7 @@ ab_loinc <- function(x, ...) {
#' @rdname ab_property
#' @export
ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
meet_criteria(units, allow_class = "logical", has_length = 1)
@ -193,7 +193,7 @@ ab_ddd <- function(x, administration = "oral", units = FALSE, ...) {
#' @rdname ab_property
#' @export
ab_info <- function(x, language = get_locale(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
x <- as.ab(x, ...)
@ -215,7 +215,7 @@ ab_info <- function(x, language = get_locale(), ...) {
#' @rdname ab_property
#' @export
ab_url <- function(x, open = FALSE, ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(open, allow_class = "logical", has_length = 1)
ab <- as.ab(x = x, ... = ...)
@ -242,7 +242,7 @@ ab_url <- function(x, open = FALSE, ...) {
#' @rdname ab_property
#' @export
ab_property <- function(x, property = "name", language = get_locale(), ...) {
meet_criteria(x, allow_class = c("character", "numeric", "integer"))
meet_criteria(x, allow_NA = TRUE)
meet_criteria(property, is_in = colnames(antibiotics), has_length = 1)
meet_criteria(language, is_in = c(LANGUAGES_SUPPORTED, ""), has_length = 1, allow_NULL = TRUE, allow_NA = TRUE)
translate_AMR(ab_validate(x = x, property = property, ...), language = language)