P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-10 05:41:59 +02:00
Code Releases Activity

(v1.4.0.9001) is_gram_positive(), is_gram_negative(), parameter hardening

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-10-19 17:09:19 +02:00
parent 833a1be36d
commit 4e9ccb4435
76 changed files with 969 additions and 491 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
R/atc_online.R
View File

@ -78,6 +78,11 @@ atc_online_property <- function(atc_code,
administration = "O",
url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no",
url_vet = "https://www.whocc.no/atcvet/atcvet_index/?code=%s&showdescription=no") {
meet_criteria(atc_code, allow_class = "character")
meet_criteria(property, allow_class = "character", has_length = 1, is_in = c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups"), ignore.case = TRUE)
meet_criteria(administration, allow_class = "character", has_length = 1)
meet_criteria(url, allow_class = "character", has_length = 1, looks_like = "https?://")
meet_criteria(url_vet, allow_class = "character", has_length = 1, looks_like = "https?://")
has_internet <- import_fn("has_internet", "curl")
html_attr <- import_fn("html_attr", "rvest")
@ -99,24 +104,12 @@ atc_online_property <- function(atc_code,
return(rep(NA, length(atc_code)))
}
stop_if(length(property) != 1L, "`property` must be of length 1")
stop_if(length(administration) != 1L, "`administration` must be of length 1")
# also allow unit as property
if (property %like% "unit") {
property <- "U"
}
# validation of properties
valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups")
valid_properties.bak <- valid_properties
property <- tolower(property)
valid_properties <- tolower(valid_properties)
stop_ifnot(property %in% valid_properties,
"Invalid `property`, use one of ", paste(valid_properties.bak, collapse = ", "))
if (property == "ddd") {
returnvalue <- rep(NA_real_, length(atc_code))
} else if (property == "groups") {
@ -199,11 +192,13 @@ atc_online_property <- function(atc_code,
#' @rdname atc_online
#' @export
atc_online_groups <- function(atc_code, ...) {
meet_criteria(atc_code, allow_class = "character")
atc_online_property(atc_code = atc_code, property = "groups", ...)
}
#' @rdname atc_online
#' @export
atc_online_ddd <- function(atc_code, ...) {
meet_criteria(atc_code, allow_class = "character")
atc_online_property(atc_code = atc_code, property = "ddd", ...)
}