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

(v0.7.1.9093) as.ab() fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-10-06 21:07:38 +02:00
parent 8bc4081b03
commit b6653a620a
13 changed files with 43 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files

37
R/ab.R
View File

@ -84,7 +84,7 @@ as.ab <- function(x, ...) {
# keep only max 1 space
x_bak_clean <- trimws(gsub(" +", " ", x_bak_clean, ignore.case = TRUE))
# non-character, space or number should be a slash
x_bak_clean <- gsub("[^A-Za-z0-9 ]", "/", x_bak_clean)
x_bak_clean <- gsub("[^A-Za-z0-9 -]", "/", x_bak_clean)
# spaces around non-characters must be removed: amox + clav -> amox/clav
x_bak_clean <- gsub("(.*[a-zA-Z0-9]) ([^a-zA-Z0-9].*)", "\\1\\2", x_bak_clean)
x_bak_clean <- gsub("(.*[^a-zA-Z0-9]) ([a-zA-Z0-9].*)", "\\1\\2", x_bak_clean)
@ -247,22 +247,25 @@ as.ab <- function(x, ...) {
x_new[i] <- x_translated_guess
next
}
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
x_translated <- paste(lapply(strsplit(x_translated, "[^a-zA-Z0-9 ]"),
function(y) {
for (i in 1:length(y)) {
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
y[i] <- ifelse(!is.na(y_name),
y_name,
y[i])
}
y
})[[1]],
collapse = "/")
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
if (!is.na(x_translated_guess)) {
x_new[i] <- x_translated_guess
next
if (!isFALSE(list(...)$initial_search2)) {
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
x_translated <- paste(lapply(strsplit(x_translated, "[^a-zA-Z0-9 ]"),
function(y) {
for (i in 1:length(y)) {
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE, initial_search2 = FALSE))
y[i] <- ifelse(!is.na(y_name),
y_name,
y[i])
}
y
})[[1]],
collapse = "/")
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
if (!is.na(x_translated_guess)) {
x_new[i] <- x_translated_guess
next
}
}
}

2
R/atc_online.R
View File

@ -76,7 +76,7 @@ atc_online_property <- function(atc_code,
administration = 'O',
url = 'https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no') {
if (!all(c("curl", "rvest", "xml2") %in% rownames(installed.packages()))) {
if (!all(c("curl", "rvest", "xml2") %in% rownames(utils::installed.packages()))) {
stop("Packages 'xml2', 'rvest' and 'curl' are required for this function")
}

4
R/misc.R
View File

@ -153,8 +153,8 @@ round2 <- function(x, digits = 0, force_zero = TRUE) {
# https://stackoverflow.com/a/12688836/4575331
val <- (trunc((abs(x) * 10 ^ digits) + 0.5) / 10 ^ digits) * sign(x)
if (digits > 0 & force_zero == TRUE) {
val[val != as.integer(val)] <- paste0(val[val != as.integer(val)],
strrep("0", max(0, digits - nchar(gsub(".*[.](.*)$", "\\1", val[val != as.integer(val)])))))
val[val != as.integer(val) & !is.na(val)] <- paste0(val[val != as.integer(val) & !is.na(val)],
strrep("0", max(0, digits - nchar(gsub(".*[.](.*)$", "\\1", val[val != as.integer(val) & !is.na(val)])))))
}
val
}