mirror of
https://github.com/msberends/AMR.git
synced 2025-07-11 10:21:54 +02:00
(v1.2.0.9034) code cleaning
This commit is contained in:
@ -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
|
||||
}
|
||||
|
||||
|
Reference in New Issue
Block a user