mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 05:26:13 +01:00
atc_groups
This commit is contained in:
parent
0a5898b17d
commit
bdc860e29c
@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 0.2.0.9003
|
Version: 0.2.0.9004
|
||||||
Date: 2018-06-08
|
Date: 2018-06-18
|
||||||
Title: Antimicrobial Resistance Analysis
|
Title: Antimicrobial Resistance Analysis
|
||||||
Authors@R: c(
|
Authors@R: c(
|
||||||
person(
|
person(
|
||||||
@ -28,6 +28,7 @@ Depends:
|
|||||||
R (>= 3.0.0)
|
R (>= 3.0.0)
|
||||||
Imports:
|
Imports:
|
||||||
backports,
|
backports,
|
||||||
|
curl,
|
||||||
dplyr (>= 0.7.0),
|
dplyr (>= 0.7.0),
|
||||||
data.table (>= 1.10.0),
|
data.table (>= 1.10.0),
|
||||||
reshape2 (>= 1.4.0),
|
reshape2 (>= 1.4.0),
|
||||||
|
@ -24,6 +24,8 @@ export(abname)
|
|||||||
export(anti_join_microorganisms)
|
export(anti_join_microorganisms)
|
||||||
export(as.mic)
|
export(as.mic)
|
||||||
export(as.rsi)
|
export(as.rsi)
|
||||||
|
export(atc_ddd)
|
||||||
|
export(atc_groups)
|
||||||
export(atc_property)
|
export(atc_property)
|
||||||
export(first_isolate)
|
export(first_isolate)
|
||||||
export(freq)
|
export(freq)
|
||||||
@ -58,6 +60,7 @@ exportMethods(print.tbl)
|
|||||||
exportMethods(print.tbl_df)
|
exportMethods(print.tbl_df)
|
||||||
exportMethods(summary.mic)
|
exportMethods(summary.mic)
|
||||||
exportMethods(summary.rsi)
|
exportMethods(summary.rsi)
|
||||||
|
importFrom(curl,nslookup)
|
||||||
importFrom(data.table,data.table)
|
importFrom(data.table,data.table)
|
||||||
importFrom(dplyr,"%>%")
|
importFrom(dplyr,"%>%")
|
||||||
importFrom(dplyr,all_vars)
|
importFrom(dplyr,all_vars)
|
||||||
@ -92,6 +95,8 @@ importFrom(graphics,barplot)
|
|||||||
importFrom(graphics,plot)
|
importFrom(graphics,plot)
|
||||||
importFrom(graphics,text)
|
importFrom(graphics,text)
|
||||||
importFrom(reshape2,dcast)
|
importFrom(reshape2,dcast)
|
||||||
|
importFrom(rvest,html_children)
|
||||||
|
importFrom(rvest,html_node)
|
||||||
importFrom(rvest,html_nodes)
|
importFrom(rvest,html_nodes)
|
||||||
importFrom(rvest,html_table)
|
importFrom(rvest,html_table)
|
||||||
importFrom(stats,fivenum)
|
importFrom(stats,fivenum)
|
||||||
|
13
NEWS.md
13
NEWS.md
@ -1,11 +1,14 @@
|
|||||||
# 0.2.0.90xx (development version)
|
# 0.2.0.90xx (development version)
|
||||||
|
|
||||||
* Vignettes about frequency tables
|
* New vignette about frequency tables
|
||||||
* Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)`
|
* Added possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)`
|
||||||
* Renamed `toConsole` parameter of `freq` to `as.data.frame`
|
* Renamed `toConsole` parameter of `freq` function to `as.data.frame`
|
||||||
* Small translational improvements to the `septic_patients` dataset
|
* Small translational improvements to the `septic_patients` dataset
|
||||||
* Coerce RSI values from combined MIC/RSI values: `as.rsi("<=0.002; S")` will now return `"S"`
|
* Combined MIC/RSI values will now be coerced by the `rsi` and `mic` functions: `as.rsi("<=0.002; S")` will return `S` and `as.mic("<=0.002; S")` will return `<=0.002`
|
||||||
* Fix for warning **hybrid evaluation forced for row_number** ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above
|
* It is now possible to coerce MIC values when there's a space between the operator and the value, i.e. `as.mic("<= 0.002")` now works
|
||||||
|
* Added `"groups"` option for `atc_property(..., property)`. It will return a vector of the ATC hierarchy as defined by the [WHO](https://www.whocc.no/atc/structure_and_principles/). The new function `atc_groups` is a convenient wrapper around this. * Build-in host check for `atc_property` as it requires the host set by `url` to be responsive
|
||||||
|
* Improved `first_isolate` algorithm to exclude isolates where bacteria ID or genus is unavailable
|
||||||
|
* Fix for warning *hybrid evaluation forced for row_number* ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above
|
||||||
* Support for 1 or 2 columns as input for `guess_bactid`
|
* Support for 1 or 2 columns as input for `guess_bactid`
|
||||||
* Fix for printing tibbles where characters would be accidentally transformed to factors
|
* Fix for printing tibbles where characters would be accidentally transformed to factors
|
||||||
|
|
||||||
|
144
R/atc.R
144
R/atc.R
@ -18,13 +18,14 @@
|
|||||||
|
|
||||||
#' Properties of an ATC code
|
#' Properties of an ATC code
|
||||||
#'
|
#'
|
||||||
#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \strong{This function requires an internet connection.}
|
#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \cr \strong{This function requires an internet connection.}
|
||||||
#' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
|
#' @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 \code{"ATC code"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"} en \code{"Note"}.
|
#' @param property property of an ATC code. Valid values are \code{"ATC"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"}, \code{"Note"} and \code{groups}. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.
|
||||||
#' @param administration type of administration, see \emph{Details}
|
#' @param administration type of administration when using \code{property = "Adm.R"}, see Details
|
||||||
#' @param url url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.
|
#' @param url url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.
|
||||||
|
#' @param ... parameters to pass on to \code{atc_property}
|
||||||
#' @details
|
#' @details
|
||||||
#' Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
#' Options for parameter \code{administration}:
|
||||||
#' \itemize{
|
#' \itemize{
|
||||||
#' \item{\code{"Implant"}}{ = Implant}
|
#' \item{\code{"Implant"}}{ = Implant}
|
||||||
#' \item{\code{"Inhal"}}{ = Inhalation}
|
#' \item{\code{"Inhal"}}{ = Inhalation}
|
||||||
@ -38,7 +39,7 @@
|
|||||||
#' \item{\code{"V"}}{ = vaginal}
|
#' \item{\code{"V"}}{ = vaginal}
|
||||||
#' }
|
#' }
|
||||||
#'
|
#'
|
||||||
#' Abbreviations for the property \code{"U"} (unit):
|
#' Abbreviations of return values when using \code{property = "U"} (unit):
|
||||||
#' \itemize{
|
#' \itemize{
|
||||||
#' \item{\code{"g"}}{ = gram}
|
#' \item{\code{"g"}}{ = gram}
|
||||||
#' \item{\code{"mg"}}{ = milligram}
|
#' \item{\code{"mg"}}{ = milligram}
|
||||||
@ -50,36 +51,80 @@
|
|||||||
#' \item{\code{"ml"}}{ = milliliter (e.g. eyedrops)}
|
#' \item{\code{"ml"}}{ = milliliter (e.g. eyedrops)}
|
||||||
#' }
|
#' }
|
||||||
#' @export
|
#' @export
|
||||||
|
#' @rdname atc_property
|
||||||
#' @importFrom dplyr %>% progress_estimated
|
#' @importFrom dplyr %>% progress_estimated
|
||||||
#' @importFrom xml2 read_html
|
#' @importFrom xml2 read_html
|
||||||
#' @importFrom rvest html_nodes html_table
|
#' @importFrom rvest html_children html_node html_nodes html_table
|
||||||
|
#' @importFrom curl nslookup
|
||||||
#' @source \url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
|
#' @source \url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
|
#' # What's the ATC of amoxicillin?
|
||||||
#' atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
|
#' guess_atc("Amoxicillin")
|
||||||
|
#' # [1] "J01CA04"
|
||||||
|
#'
|
||||||
|
#' # oral DDD (Defined Daily Dose) of amoxicillin
|
||||||
|
#' atc_property("J01CA04", "DDD", "O")
|
||||||
|
#' # parenteral DDD (Defined Daily Dose) of amoxicillin
|
||||||
|
#' atc_property("J01CA04", "DDD", "P")
|
||||||
|
#'
|
||||||
|
#' atc_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
|
||||||
|
#' # [1] "ANTIINFECTIVES FOR SYSTEMIC USE"
|
||||||
|
#' # [2] "ANTIBACTERIALS FOR SYSTEMIC USE"
|
||||||
|
#' # [3] "BETA-LACTAM ANTIBACTERIALS, PENICILLINS"
|
||||||
|
#' # [4] "Penicillins with extended spectrum"
|
||||||
#' }
|
#' }
|
||||||
atc_property <- function(atc_code,
|
atc_property <- function(atc_code,
|
||||||
property,
|
property,
|
||||||
administration = 'O',
|
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') {
|
||||||
|
|
||||||
# property <- property %>% tolower()
|
# check active network interface, from https://stackoverflow.com/a/5078002/4575331
|
||||||
#
|
has_internet <- function(url) {
|
||||||
|
# extract host from given url
|
||||||
|
# https://www.whocc.no/atc_ddd_index/ -> www.whocc.no
|
||||||
|
url <- url %>%
|
||||||
|
gsub("^(http://|https://)", "", .) %>%
|
||||||
|
strsplit('/', fixed = TRUE) %>%
|
||||||
|
unlist() %>%
|
||||||
|
.[1]
|
||||||
|
!is.null(curl::nslookup(url, error = FALSE))
|
||||||
|
}
|
||||||
|
# check for connection using the ATC of amoxicillin
|
||||||
|
if (!has_internet(url = url)) {
|
||||||
|
message("The URL could not be reached.")
|
||||||
|
return(rep(NA, length(atc_code)))
|
||||||
|
}
|
||||||
|
|
||||||
|
if (length(property) != 1L) {
|
||||||
|
stop('`property` must be of length 1', call. = FALSE)
|
||||||
|
}
|
||||||
|
if (length(administration) != 1L) {
|
||||||
|
stop('`administration` must be of length 1', call. = FALSE)
|
||||||
|
}
|
||||||
|
|
||||||
|
# also allow unit as property
|
||||||
if (property %like% 'unit') {
|
if (property %like% 'unit') {
|
||||||
property <- 'U'
|
property <- 'U'
|
||||||
}
|
}
|
||||||
|
|
||||||
# validation of properties
|
# validation of properties
|
||||||
valid_properties.bak <- c("ATC code", "Name", "DDD", "U", "Adm.R", "Note")
|
valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups")
|
||||||
valid_properties <- valid_properties.bak #%>% tolower()
|
valid_properties.bak <- valid_properties
|
||||||
|
|
||||||
|
property <- tolower(property)
|
||||||
|
valid_properties <- tolower(valid_properties)
|
||||||
|
|
||||||
if (!property %in% valid_properties) {
|
if (!property %in% valid_properties) {
|
||||||
stop('Invalid `property`, use one of ', paste(valid_properties, collapse = ", "), '.')
|
stop('Invalid `property`, use one of ', paste(valid_properties.bak, collapse = ", "), '.')
|
||||||
}
|
}
|
||||||
|
|
||||||
returnvalue <- rep(NA_character_, length(atc_code))
|
if (property == 'ddd') {
|
||||||
if (property == 'DDD') {
|
|
||||||
returnvalue <- rep(NA_real_, length(atc_code))
|
returnvalue <- rep(NA_real_, length(atc_code))
|
||||||
|
} else if (property == 'groups') {
|
||||||
|
returnvalue <- list()
|
||||||
|
} else {
|
||||||
|
returnvalue <- rep(NA_character_, length(atc_code))
|
||||||
}
|
}
|
||||||
|
|
||||||
progress <- progress_estimated(n = length(atc_code))
|
progress <- progress_estimated(n = length(atc_code))
|
||||||
@ -89,9 +134,31 @@ atc_property <- function(atc_code,
|
|||||||
progress$tick()$print()
|
progress$tick()$print()
|
||||||
|
|
||||||
atc_url <- sub('%s', atc_code[i], url, fixed = TRUE)
|
atc_url <- sub('%s', atc_code[i], url, fixed = TRUE)
|
||||||
|
|
||||||
|
if (property == "groups") {
|
||||||
|
tbl <- xml2::read_html(atc_url) %>%
|
||||||
|
rvest::html_node("#content") %>%
|
||||||
|
rvest::html_children() %>%
|
||||||
|
rvest::html_node("a")
|
||||||
|
|
||||||
|
# get URLS of items
|
||||||
|
hrefs <- tbl %>% rvest::html_attr("href")
|
||||||
|
# get text of items
|
||||||
|
texts <- tbl %>% rvest::html_text()
|
||||||
|
# select only text items where URL like "code="
|
||||||
|
texts <- texts[grepl("?code=", tolower(hrefs), fixed = TRUE)]
|
||||||
|
# last one is antibiotics, skip it
|
||||||
|
texts <- texts[1:length(texts) - 1]
|
||||||
|
returnvalue <- c(list(texts), returnvalue)
|
||||||
|
|
||||||
|
} else {
|
||||||
tbl <- xml2::read_html(atc_url) %>%
|
tbl <- xml2::read_html(atc_url) %>%
|
||||||
rvest::html_nodes('table') %>%
|
rvest::html_nodes('table') %>%
|
||||||
rvest::html_table(header = TRUE)
|
rvest::html_table(header = TRUE) %>%
|
||||||
|
as.data.frame(stringsAsFactors = FALSE)
|
||||||
|
|
||||||
|
# case insensitive column names
|
||||||
|
colnames(tbl) <- tolower(colnames(tbl)) %>% gsub('^atc.*', 'atc', .)
|
||||||
|
|
||||||
if (length(tbl) == 0) {
|
if (length(tbl) == 0) {
|
||||||
warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
|
warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
|
||||||
@ -99,37 +166,48 @@ atc_property <- function(atc_code,
|
|||||||
next
|
next
|
||||||
}
|
}
|
||||||
|
|
||||||
tbl <- tbl[[1]]
|
if (property %in% c('atc', 'name')) {
|
||||||
|
# ATC and name are only in first row
|
||||||
if (property == 'Name') {
|
returnvalue[i] <- tbl[1, property]
|
||||||
returnvalue[i] <- tbl[1, 2]
|
|
||||||
} else {
|
} else {
|
||||||
|
if (!'adm.r' %in% colnames(tbl) | is.na(tbl[1, 'adm.r'])) {
|
||||||
names(returnvalue)[i] <- tbl[1, 2] %>% as.character()
|
|
||||||
|
|
||||||
if (!'Adm.R' %in% colnames(tbl) | is.na(tbl[1, 'Adm.R'])) {
|
|
||||||
returnvalue[i] <- NA
|
returnvalue[i] <- NA
|
||||||
next
|
next
|
||||||
} else {
|
} else {
|
||||||
for (j in 1:nrow(tbl)) {
|
for (j in 1:nrow(tbl)) {
|
||||||
if (tbl[j, 'Adm.R'] == administration) {
|
if (tbl[j, 'adm.r'] == administration) {
|
||||||
returnvalue[i] <- tbl[j, property]
|
returnvalue[i] <- tbl[j, property]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (property == "groups" & length(returnvalue) == 1) {
|
||||||
|
returnvalue <- returnvalue[[1]]
|
||||||
|
}
|
||||||
|
|
||||||
cat('\n')
|
|
||||||
returnvalue
|
returnvalue
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @rdname atc_property
|
||||||
|
#' @export
|
||||||
|
atc_groups <- function(atc_code, ...) {
|
||||||
|
atc_property(atc_code = atc_code, property = "groups", ...)
|
||||||
|
}
|
||||||
|
|
||||||
|
#' @rdname atc_property
|
||||||
|
#' @export
|
||||||
|
atc_ddd <- function(atc_code, ...) {
|
||||||
|
atc_property(atc_code = atc_code, property = "ddd", ...)
|
||||||
}
|
}
|
||||||
|
|
||||||
#' Name of an antibiotic
|
#' Name of an antibiotic
|
||||||
#'
|
#'
|
||||||
#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
|
#' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
|
||||||
#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}
|
#' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}
|
||||||
#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.
|
#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.
|
||||||
#' @param textbetween text to put between multiple returned texts
|
#' @param textbetween text to put between multiple returned texts
|
||||||
#' @param tolower return output as lower case with function \code{\link{tolower}}.
|
#' @param tolower return output as lower case with function \code{\link{tolower}}.
|
||||||
#' @keywords ab antibiotics
|
#' @keywords ab antibiotics
|
||||||
@ -156,6 +234,14 @@ atc_property <- function(atc_code,
|
|||||||
#' # "AMCL"
|
#' # "AMCL"
|
||||||
abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) {
|
abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) {
|
||||||
|
|
||||||
|
if (length(to) != 1L) {
|
||||||
|
stop('`to` must be of length 1', call. = FALSE)
|
||||||
|
}
|
||||||
|
|
||||||
|
if (to == "atc") {
|
||||||
|
return(guess_atc(abcode))
|
||||||
|
}
|
||||||
|
|
||||||
antibiotics <- AMR::antibiotics
|
antibiotics <- AMR::antibiotics
|
||||||
|
|
||||||
from <- from[1]
|
from <- from[1]
|
||||||
@ -291,12 +377,12 @@ guess_atc <- function(x) {
|
|||||||
|
|
||||||
if (nrow(found) == 0) {
|
if (nrow(found) == 0) {
|
||||||
# try abbreviation of molis and glims
|
# try abbreviation of molis and glims
|
||||||
found <- AMR::antibiotics %>% filter(molis == x[i] | umcg == x[i])
|
found <- AMR::antibiotics %>% filter(tolower(molis) == tolower(x[i]) | tolower(umcg) == tolower(x[i]))
|
||||||
}
|
}
|
||||||
|
|
||||||
if (nrow(found) == 0) {
|
if (nrow(found) == 0) {
|
||||||
# try exact official name
|
# try exact official name
|
||||||
found <- AMR::antibiotics[which(AMR::antibiotics$official == x[i]),]
|
found <- AMR::antibiotics[which(tolower(AMR::antibiotics$official) == tolower(x[i])),]
|
||||||
}
|
}
|
||||||
|
|
||||||
if (nrow(found) == 0) {
|
if (nrow(found) == 0) {
|
||||||
|
15
R/classes.R
15
R/classes.R
@ -30,6 +30,9 @@
|
|||||||
#' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
|
#' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
|
||||||
#' is.rsi(rsi_data)
|
#' is.rsi(rsi_data)
|
||||||
#'
|
#'
|
||||||
|
#' # this can also coerce combined MIC/RSI values:
|
||||||
|
#' as.rsi("<= 0.002; R") # will return R
|
||||||
|
#'
|
||||||
#' plot(rsi_data) # for percentages
|
#' plot(rsi_data) # for percentages
|
||||||
#' barplot(rsi_data) # for frequencies
|
#' barplot(rsi_data) # for frequencies
|
||||||
as.rsi <- function(x) {
|
as.rsi <- function(x) {
|
||||||
@ -204,6 +207,9 @@ barplot.rsi <- function(height, ...) {
|
|||||||
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
#' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
||||||
#' is.mic(mic_data)
|
#' is.mic(mic_data)
|
||||||
#'
|
#'
|
||||||
|
#' # this can also coerce combined MIC/RSI values:
|
||||||
|
#' as.mic("<=0.002; R") # will return <=0.002
|
||||||
|
#'
|
||||||
#' plot(mic_data)
|
#' plot(mic_data)
|
||||||
#' barplot(mic_data)
|
#' barplot(mic_data)
|
||||||
as.mic <- function(x, na.rm = FALSE) {
|
as.mic <- function(x, na.rm = FALSE) {
|
||||||
@ -216,8 +222,10 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||||||
}
|
}
|
||||||
x.bak <- x
|
x.bak <- x
|
||||||
|
|
||||||
# comma to dot
|
# comma to period
|
||||||
x <- gsub(',', '.', x, fixed = TRUE)
|
x <- gsub(',', '.', x, fixed = TRUE)
|
||||||
|
# remove space between operator and number ("<= 0.002" -> "<=0.002")
|
||||||
|
x <- gsub('(<|=|>) +', '\\1', x)
|
||||||
# starting dots must start with 0
|
# starting dots must start with 0
|
||||||
x <- gsub('^[.]+', '0.', x)
|
x <- gsub('^[.]+', '0.', x)
|
||||||
# <=0.2560.512 should be 0.512
|
# <=0.2560.512 should be 0.512
|
||||||
@ -228,8 +236,10 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||||||
x <- gsub('[^0-9]+$', '', x)
|
x <- gsub('[^0-9]+$', '', x)
|
||||||
# remove last zeroes
|
# remove last zeroes
|
||||||
x <- gsub('[.]?0+$', '', x)
|
x <- gsub('[.]?0+$', '', x)
|
||||||
|
# force to be character
|
||||||
|
x <- as.character(x)
|
||||||
|
|
||||||
# these are alllowed MIC values and will be factor levels
|
# these are alllowed MIC values and will become factor levels
|
||||||
lvls <- c("<0.002", "<=0.002", "0.002", ">=0.002", ">0.002",
|
lvls <- c("<0.002", "<=0.002", "0.002", ">=0.002", ">0.002",
|
||||||
"<0.003", "<=0.003", "0.003", ">=0.003", ">0.003",
|
"<0.003", "<=0.003", "0.003", ">=0.003", ">0.003",
|
||||||
"<0.004", "<=0.004", "0.004", ">=0.004", ">0.004",
|
"<0.004", "<=0.004", "0.004", ">=0.004", ">0.004",
|
||||||
@ -286,7 +296,6 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||||||
"<320", "<=320", "320", ">=320", ">320",
|
"<320", "<=320", "320", ">=320", ">320",
|
||||||
"<512", "<=512", "512", ">=512", ">512",
|
"<512", "<=512", "512", ">=512", ">512",
|
||||||
"<1024", "<=1024", "1024", ">=1024", ">1024")
|
"<1024", "<=1024", "1024", ">=1024", ">1024")
|
||||||
x <- x %>% as.character()
|
|
||||||
|
|
||||||
na_before <- x[is.na(x) | x == ''] %>% length()
|
na_before <- x[is.na(x) | x == ''] %>% length()
|
||||||
x[!x %in% lvls] <- NA
|
x[!x %in% lvls] <- NA
|
||||||
|
@ -173,7 +173,6 @@ first_isolate <- function(tbl,
|
|||||||
filter_specimen <- ''
|
filter_specimen <- ''
|
||||||
}
|
}
|
||||||
|
|
||||||
specgroup.notice <- ''
|
|
||||||
weighted.notice <- ''
|
weighted.notice <- ''
|
||||||
# filter on specimen group and keyantibiotics when they are filled in
|
# filter on specimen group and keyantibiotics when they are filled in
|
||||||
if (!is.na(filter_specimen) & filter_specimen != '') {
|
if (!is.na(filter_specimen) & filter_specimen != '') {
|
||||||
@ -197,13 +196,12 @@ first_isolate <- function(tbl,
|
|||||||
# create new dataframe with original row index and right sorting
|
# create new dataframe with original row index and right sorting
|
||||||
tbl <- tbl %>%
|
tbl <- tbl %>%
|
||||||
mutate(first_isolate_row_index = 1:nrow(tbl),
|
mutate(first_isolate_row_index = 1:nrow(tbl),
|
||||||
eersteisolaatbepaling = 0,
|
|
||||||
date_lab = tbl %>% pull(col_date),
|
date_lab = tbl %>% pull(col_date),
|
||||||
patient_id = tbl %>% pull(col_patient_id),
|
patient_id = tbl %>% pull(col_patient_id),
|
||||||
species = tbl %>% pull(col_species),
|
species = tbl %>% pull(col_species),
|
||||||
genus = tbl %>% pull(col_genus)) %>%
|
genus = tbl %>% pull(col_genus)) %>%
|
||||||
mutate(species = if_else(is.na(species), '', species),
|
mutate(species = if_else(is.na(species) | species == "(no MO)", "", species),
|
||||||
genus = if_else(is.na(genus), '', genus))
|
genus = if_else(is.na(genus) | genus == "(no MO)", "", genus))
|
||||||
|
|
||||||
if (filter_specimen == '') {
|
if (filter_specimen == '') {
|
||||||
|
|
||||||
@ -380,7 +378,7 @@ first_isolate <- function(tbl,
|
|||||||
|
|
||||||
# NA's where genus is unavailable
|
# NA's where genus is unavailable
|
||||||
all_first <- all_first %>%
|
all_first <- all_first %>%
|
||||||
mutate(real_first_isolate = if_else(genus == '', NA, real_first_isolate))
|
mutate(real_first_isolate = if_else(genus %in% c('', '(no MO)', NA), NA, real_first_isolate))
|
||||||
|
|
||||||
all_first <- all_first %>%
|
all_first <- all_first %>%
|
||||||
arrange(first_isolate_row_index) %>%
|
arrange(first_isolate_row_index) %>%
|
||||||
|
@ -44,7 +44,7 @@
|
|||||||
#' # and can even contain 2 columns, which is convenient for genus/species combinations:
|
#' # and can even contain 2 columns, which is convenient for genus/species combinations:
|
||||||
#' df$bactid <- df %>% select(genus, species) %>% guess_bactid()
|
#' df$bactid <- df %>% select(genus, species) %>% guess_bactid()
|
||||||
#' # same result:
|
#' # same result:
|
||||||
#' df <- df %>% mutate(bactid = paste(genus, species) %>% guess_bactid())
|
#' df <- df %>% mutate(bactid = paste(genus, species)) %>% guess_bactid())
|
||||||
#' }
|
#' }
|
||||||
guess_bactid <- function(x) {
|
guess_bactid <- function(x) {
|
||||||
|
|
||||||
|
@ -13,7 +13,7 @@ abname(abcode, from = c("guess", "atc", "molis", "umcg"), to = "official",
|
|||||||
\arguments{
|
\arguments{
|
||||||
\item{abcode}{a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}}
|
\item{abcode}{a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}}
|
||||||
|
|
||||||
\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.}
|
\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.}
|
||||||
|
|
||||||
\item{textbetween}{text to put between multiple returned texts}
|
\item{textbetween}{text to put between multiple returned texts}
|
||||||
|
|
||||||
|
@ -24,6 +24,9 @@ This transforms a vector to a new class\code{mic}, which is an ordered factor wi
|
|||||||
mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
|
||||||
is.mic(mic_data)
|
is.mic(mic_data)
|
||||||
|
|
||||||
|
# this can also coerce combined MIC/RSI values:
|
||||||
|
as.mic("<=0.002; R") # will return <=0.002
|
||||||
|
|
||||||
plot(mic_data)
|
plot(mic_data)
|
||||||
barplot(mic_data)
|
barplot(mic_data)
|
||||||
}
|
}
|
||||||
|
@ -23,6 +23,9 @@ rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
|
|||||||
rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
|
rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
|
||||||
is.rsi(rsi_data)
|
is.rsi(rsi_data)
|
||||||
|
|
||||||
|
# this can also coerce combined MIC/RSI values:
|
||||||
|
as.rsi("<= 0.002; R") # will return R
|
||||||
|
|
||||||
plot(rsi_data) # for percentages
|
plot(rsi_data) # for percentages
|
||||||
barplot(rsi_data) # for frequencies
|
barplot(rsi_data) # for frequencies
|
||||||
}
|
}
|
||||||
|
@ -2,6 +2,8 @@
|
|||||||
% Please edit documentation in R/atc.R
|
% Please edit documentation in R/atc.R
|
||||||
\name{atc_property}
|
\name{atc_property}
|
||||||
\alias{atc_property}
|
\alias{atc_property}
|
||||||
|
\alias{atc_groups}
|
||||||
|
\alias{atc_ddd}
|
||||||
\title{Properties of an ATC code}
|
\title{Properties of an ATC code}
|
||||||
\source{
|
\source{
|
||||||
\url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
|
\url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
|
||||||
@ -9,21 +11,27 @@
|
|||||||
\usage{
|
\usage{
|
||||||
atc_property(atc_code, property, administration = "O",
|
atc_property(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")
|
||||||
|
|
||||||
|
atc_groups(atc_code, ...)
|
||||||
|
|
||||||
|
atc_ddd(atc_code, ...)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{atc_code}{a character or character vector with ATC code(s) of antibiotic(s)}
|
\item{atc_code}{a character or character vector with ATC code(s) of antibiotic(s)}
|
||||||
|
|
||||||
\item{property}{property of an ATC code. Valid values are \code{"ATC code"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"} en \code{"Note"}.}
|
\item{property}{property of an ATC code. Valid values are \code{"ATC"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"}, \code{"Note"} and \code{groups}. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.}
|
||||||
|
|
||||||
\item{administration}{type of administration, see \emph{Details}}
|
\item{administration}{type of administration when using \code{property = "Adm.R"}, see Details}
|
||||||
|
|
||||||
\item{url}{url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.}
|
\item{url}{url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.}
|
||||||
|
|
||||||
|
\item{...}{parameters to pass on to \code{atc_property}}
|
||||||
}
|
}
|
||||||
\description{
|
\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. \strong{This function requires an internet connection.}
|
Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \cr \strong{This function requires an internet connection.}
|
||||||
}
|
}
|
||||||
\details{
|
\details{
|
||||||
Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
Options for parameter \code{administration}:
|
||||||
\itemize{
|
\itemize{
|
||||||
\item{\code{"Implant"}}{ = Implant}
|
\item{\code{"Implant"}}{ = Implant}
|
||||||
\item{\code{"Inhal"}}{ = Inhalation}
|
\item{\code{"Inhal"}}{ = Inhalation}
|
||||||
@ -37,7 +45,7 @@ Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
|||||||
\item{\code{"V"}}{ = vaginal}
|
\item{\code{"V"}}{ = vaginal}
|
||||||
}
|
}
|
||||||
|
|
||||||
Abbreviations for the property \code{"U"} (unit):
|
Abbreviations of return values when using \code{property = "U"} (unit):
|
||||||
\itemize{
|
\itemize{
|
||||||
\item{\code{"g"}}{ = gram}
|
\item{\code{"g"}}{ = gram}
|
||||||
\item{\code{"mg"}}{ = milligram}
|
\item{\code{"mg"}}{ = milligram}
|
||||||
@ -51,7 +59,19 @@ Abbreviations for the property \code{"U"} (unit):
|
|||||||
}
|
}
|
||||||
\examples{
|
\examples{
|
||||||
\donttest{
|
\donttest{
|
||||||
atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
|
# What's the ATC of amoxicillin?
|
||||||
atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
|
guess_atc("Amoxicillin")
|
||||||
|
# [1] "J01CA04"
|
||||||
|
|
||||||
|
# oral DDD (Defined Daily Dose) of amoxicillin
|
||||||
|
atc_property("J01CA04", "DDD", "O")
|
||||||
|
# parenteral DDD (Defined Daily Dose) of amoxicillin
|
||||||
|
atc_property("J01CA04", "DDD", "P")
|
||||||
|
|
||||||
|
atc_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
|
||||||
|
# [1] "ANTIINFECTIVES FOR SYSTEMIC USE"
|
||||||
|
# [2] "ANTIBACTERIALS FOR SYSTEMIC USE"
|
||||||
|
# [3] "BETA-LACTAM ANTIBACTERIALS, PENICILLINS"
|
||||||
|
# [4] "Penicillins with extended spectrum"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -35,7 +35,7 @@ df$bactid <- df \%>\% select(microorganism_name) \%>\% guess_bactid()
|
|||||||
# and can even contain 2 columns, which is convenient for genus/species combinations:
|
# and can even contain 2 columns, which is convenient for genus/species combinations:
|
||||||
df$bactid <- df \%>\% select(genus, species) \%>\% guess_bactid()
|
df$bactid <- df \%>\% select(genus, species) \%>\% guess_bactid()
|
||||||
# same result:
|
# same result:
|
||||||
df <- df \%>\% mutate(bactid = paste(genus, species) \%>\% guess_bactid())
|
df <- df \%>\% mutate(bactid = paste(genus, species)) \%>\% guess_bactid())
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
\seealso{
|
\seealso{
|
||||||
|
@ -3,6 +3,9 @@ context("atc.R")
|
|||||||
test_that("atc_property works", {
|
test_that("atc_property works", {
|
||||||
expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
|
expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
|
||||||
expect_equivalent(atc_property("J01CA04", "DDD"), 1)
|
expect_equivalent(atc_property("J01CA04", "DDD"), 1)
|
||||||
|
expect_equal(length(atc_property("J01CA04", property = "Groups")), 4)
|
||||||
|
expect_error(atc_property("J01CA04", property = c(1:5)))
|
||||||
|
expect_error(atc_property("J01CA04", administration = c(1:5)))
|
||||||
})
|
})
|
||||||
|
|
||||||
test_that("abname works", {
|
test_that("abname works", {
|
||||||
|
@ -8,36 +8,47 @@ test_that("keyantibiotics work", {
|
|||||||
})
|
})
|
||||||
|
|
||||||
test_that("first isolates work", {
|
test_that("first isolates work", {
|
||||||
# septic_patients contains 1960 out of 2000 first isolates
|
# septic_patients contains 1959 out of 2000 first isolates
|
||||||
#septic_ptns <- septic_patients
|
expect_equal(
|
||||||
expect_equal(sum(first_isolate(tbl = septic_patients,
|
sum(
|
||||||
|
first_isolate(tbl = septic_patients,
|
||||||
col_date = "date",
|
col_date = "date",
|
||||||
col_patient_id = "patient_id",
|
col_patient_id = "patient_id",
|
||||||
col_bactid = "bactid",
|
col_bactid = "bactid",
|
||||||
info = FALSE)), 1960)
|
info = FALSE),
|
||||||
|
na.rm = TRUE), 1959)
|
||||||
|
|
||||||
# septic_patients contains 1962 out of 2000 first *weighted* isolates
|
# septic_patients contains 1961 out of 2000 first *weighted* isolates
|
||||||
expect_equal(
|
expect_equal(
|
||||||
suppressWarnings(sum(
|
suppressWarnings(
|
||||||
|
sum(
|
||||||
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
|
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
|
||||||
col_date = "date",
|
col_date = "date",
|
||||||
col_patient_id = "patient_id",
|
col_patient_id = "patient_id",
|
||||||
col_bactid = "bactid",
|
col_bactid = "bactid",
|
||||||
col_keyantibiotics = "keyab",
|
col_keyantibiotics = "keyab",
|
||||||
type = "keyantibiotics",
|
type = "keyantibiotics",
|
||||||
info = TRUE))),
|
info = TRUE),
|
||||||
1962)
|
na.rm = TRUE)),
|
||||||
|
1961)
|
||||||
|
|
||||||
# septic_patients contains 1733 out of 2000 first non-ICU isolates
|
# septic_patients contains 1732 out of 2000 first non-ICU isolates
|
||||||
expect_equal(
|
expect_equal(
|
||||||
sum(
|
sum(
|
||||||
first_isolate(septic_patients, col_bactid = "bactid", col_date = "date", col_patient_id = "patient_id", col_icu = "ward_icu", info = TRUE, icu_exclude = TRUE)),
|
first_isolate(septic_patients,
|
||||||
1733
|
col_bactid = "bactid",
|
||||||
)
|
col_date = "date",
|
||||||
|
col_patient_id = "patient_id",
|
||||||
|
col_icu = "ward_icu",
|
||||||
|
info = TRUE,
|
||||||
|
icu_exclude = TRUE),
|
||||||
|
na.rm = TRUE),
|
||||||
|
1732)
|
||||||
|
|
||||||
# set 1500 random observations to be of specimen type 'Urine'
|
# set 1500 random observations to be of specimen type 'Urine'
|
||||||
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
|
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
|
||||||
expect_lt(sum(
|
expect_lt(
|
||||||
|
sum(
|
||||||
first_isolate(tbl = mutate(septic_patients,
|
first_isolate(tbl = mutate(septic_patients,
|
||||||
specimen = if_else(row_number() %in% random_rows,
|
specimen = if_else(row_number() %in% random_rows,
|
||||||
"Urine",
|
"Urine",
|
||||||
@ -47,7 +58,7 @@ test_that("first isolates work", {
|
|||||||
col_bactid = "bactid",
|
col_bactid = "bactid",
|
||||||
col_specimen = "specimen",
|
col_specimen = "specimen",
|
||||||
filter_specimen = "Urine",
|
filter_specimen = "Urine",
|
||||||
info = TRUE)),
|
info = TRUE),
|
||||||
|
na.rm = TRUE),
|
||||||
1501)
|
1501)
|
||||||
|
|
||||||
})
|
})
|
||||||
|
Loading…
Reference in New Issue
Block a user