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

(v1.2.0.9034) code cleaning

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-07-13 09:17:24 +02:00
parent c0cf7ab02b
commit 6ab468362d
36 changed files with 266 additions and 265 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
R/atc_online.R
View File

@ -84,7 +84,7 @@ atc_online_property <- function(atc_code,
html_table <- import_fn("html_table", "rvest")
html_text <- import_fn("html_text", "rvest")
read_html <- import_fn("read_html", "xml2")
check_dataset_integrity()
if (!all(atc_code %in% antibiotics)) {
@ -95,25 +95,25 @@ atc_online_property <- function(atc_code,
message("There appears to be no internet connection.")
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") {
@ -121,22 +121,22 @@ atc_online_property <- function(atc_code,
} else {
returnvalue <- rep(NA_character_, length(atc_code))
}
progress <- progress_estimated(n = length(atc_code), 3)
on.exit(close(progress))
for (i in seq_len(length(atc_code))) {
progress$tick()
atc_url <- sub("%s", atc_code[i], url, fixed = TRUE)
if (property == "groups") {
tbl <- read_html(atc_url) %>%
html_node("#content") %>%
html_children() %>%
html_node("a")
# get URLS of items
hrefs <- tbl %>% html_attr("href")
# get text of items
@ -146,22 +146,22 @@ atc_online_property <- function(atc_code,
# last one is antibiotics, skip it
texts <- texts[seq_len(length(texts)) - 1]
returnvalue <- c(list(texts), returnvalue)
} else {
tbl <- read_html(atc_url) %>%
html_nodes("table") %>%
html_table(header = TRUE) %>%
as.data.frame(stringsAsFactors = FALSE)
# case insensitive column names
colnames(tbl) <- gsub("^atc.*", "atc", tolower(colnames(tbl)))
if (length(tbl) == 0) {
warning("ATC not found: ", atc_code[i], ". Please check ", atc_url, ".", call. = FALSE)
returnvalue[i] <- NA
next
}
if (property %in% c("atc", "name")) {
# ATC and name are only in first row
returnvalue[i] <- tbl[1, property]
@ -179,11 +179,11 @@ atc_online_property <- function(atc_code,
}
}
}
if (property == "groups" & length(returnvalue) == 1) {
returnvalue <- returnvalue[[1]]
}
returnvalue
}