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

(v1.3.0.9022) mo_matching_score(), poorman update, as.rsi() fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-09-18 16:05:53 +02:00
parent 89401ede9f
commit 4e40e42011
138 changed files with 2923 additions and 1472 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
R/atc_online.R
View File

@ -21,12 +21,13 @@
#' Get ATC properties from WHOCC website
#'
#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic), such as the name, defined daily dose (DDD) or standard unit.
#' @inheritSection lifecycle Stable lifecycle
#' @description Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit.
#' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.
#' @param administration type of administration when using `property = "Adm.R"`, see Details
#' @param url url of website of the WHO. The sign `%s` can be used as a placeholder for ATC codes.
#' @param url url of website of the WHOCC. The sign `%s` can be used as a placeholder for ATC codes.
#' @param url_vet url of website of the WHOCC for veterinary medicine. The sign `%s` can be used as a placeholder for ATC_vet codes (that all start with "Q").
#' @param ... parameters to pass on to `atc_property`
#' @details
#' Options for parameter `administration`:
@ -74,7 +75,8 @@
atc_online_property <- function(atc_code,
property,
administration = "O",
url = "https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no") {
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") {
has_internet <- import_fn("has_internet", "curl")
html_attr <- import_fn("html_attr", "rvest")
@ -122,25 +124,31 @@ atc_online_property <- function(atc_code,
returnvalue <- rep(NA_character_, length(atc_code))
}
progress <- progress_estimated(n = length(atc_code), 3)
progress <- progress_ticker(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 (atc_code[i] %like% "^Q") {
# veterinary drugs, ATC_vet codes start with a "Q"
atc_url <- url_vet
} else {
atc_url <- url
}
atc_url <- sub("%s", atc_code[i], atc_url, fixed = TRUE)
if (property == "groups") {
tbl <- read_html(atc_url) %>%
html_node("#content") %>%
html_children() %>%
tbl <- read_html(atc_url) %pm>%
html_node("#content") %pm>%
html_children() %pm>%
html_node("a")
# get URLS of items
hrefs <- tbl %>% html_attr("href")
hrefs <- tbl %pm>% html_attr("href")
# get text of items
texts <- tbl %>% html_text()
texts <- tbl %pm>% html_text()
# select only text items where URL like "code="
texts <- texts[grepl("?code=", tolower(hrefs), fixed = TRUE)]
# last one is antibiotics, skip it
@ -148,9 +156,9 @@ atc_online_property <- function(atc_code,
returnvalue <- c(list(texts), returnvalue)
} else {
tbl <- read_html(atc_url) %>%
html_nodes("table") %>%
html_table(header = TRUE) %>%
tbl <- read_html(atc_url) %pm>%
html_nodes("table") %pm>%
html_table(header = TRUE) %pm>%
as.data.frame(stringsAsFactors = FALSE)
# case insensitive column names