mirror of https://github.com/msberends/AMR.git
atc_groups
This commit is contained in:
parent
0a5898b17d
commit
bdc860e29c
|
|
@ -1,6 +1,6 @@
|
|||
Package: AMR
|
||||
Version: 0.2.0.9003
|
||||
Date: 2018-06-08
|
||||
Version: 0.2.0.9004
|
||||
Date: 2018-06-18
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
person(
|
||||
|
|
@ -28,6 +28,7 @@ Depends:
|
|||
R (>= 3.0.0)
|
||||
Imports:
|
||||
backports,
|
||||
curl,
|
||||
dplyr (>= 0.7.0),
|
||||
data.table (>= 1.10.0),
|
||||
reshape2 (>= 1.4.0),
|
||||
|
|
|
|||
|
|
@ -24,6 +24,8 @@ export(abname)
|
|||
export(anti_join_microorganisms)
|
||||
export(as.mic)
|
||||
export(as.rsi)
|
||||
export(atc_ddd)
|
||||
export(atc_groups)
|
||||
export(atc_property)
|
||||
export(first_isolate)
|
||||
export(freq)
|
||||
|
|
@ -58,6 +60,7 @@ exportMethods(print.tbl)
|
|||
exportMethods(print.tbl_df)
|
||||
exportMethods(summary.mic)
|
||||
exportMethods(summary.rsi)
|
||||
importFrom(curl,nslookup)
|
||||
importFrom(data.table,data.table)
|
||||
importFrom(dplyr,"%>%")
|
||||
importFrom(dplyr,all_vars)
|
||||
|
|
@ -92,6 +95,8 @@ importFrom(graphics,barplot)
|
|||
importFrom(graphics,plot)
|
||||
importFrom(graphics,text)
|
||||
importFrom(reshape2,dcast)
|
||||
importFrom(rvest,html_children)
|
||||
importFrom(rvest,html_node)
|
||||
importFrom(rvest,html_nodes)
|
||||
importFrom(rvest,html_table)
|
||||
importFrom(stats,fivenum)
|
||||
|
|
|
|||
13
NEWS.md
13
NEWS.md
|
|
@ -1,11 +1,14 @@
|
|||
# 0.2.0.90xx (development version)
|
||||
|
||||
* Vignettes 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)`
|
||||
* Renamed `toConsole` parameter of `freq` to `as.data.frame`
|
||||
* New vignette about frequency tables
|
||||
* 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` function to `as.data.frame`
|
||||
* 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"`
|
||||
* 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
|
||||
* 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`
|
||||
* 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`
|
||||
* Fix for printing tibbles where characters would be accidentally transformed to factors
|
||||
|
||||
|
|
|
|||
158
R/atc.R
158
R/atc.R
|
|
@ -18,13 +18,14 @@
|
|||
|
||||
#' 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 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 administration type of administration, see \emph{Details}
|
||||
#' @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 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 ... parameters to pass on to \code{atc_property}
|
||||
#' @details
|
||||
#' Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
||||
#' Options for parameter \code{administration}:
|
||||
#' \itemize{
|
||||
#' \item{\code{"Implant"}}{ = Implant}
|
||||
#' \item{\code{"Inhal"}}{ = Inhalation}
|
||||
|
|
@ -38,7 +39,7 @@
|
|||
#' \item{\code{"V"}}{ = vaginal}
|
||||
#' }
|
||||
#'
|
||||
#' Abbreviations for the property \code{"U"} (unit):
|
||||
#' Abbreviations of return values when using \code{property = "U"} (unit):
|
||||
#' \itemize{
|
||||
#' \item{\code{"g"}}{ = gram}
|
||||
#' \item{\code{"mg"}}{ = milligram}
|
||||
|
|
@ -50,36 +51,80 @@
|
|||
#' \item{\code{"ml"}}{ = milliliter (e.g. eyedrops)}
|
||||
#' }
|
||||
#' @export
|
||||
#' @rdname atc_property
|
||||
#' @importFrom dplyr %>% progress_estimated
|
||||
#' @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/}
|
||||
#' @examples
|
||||
#' \donttest{
|
||||
#' atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
|
||||
#' atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
|
||||
#' # What's the ATC 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,
|
||||
property,
|
||||
administration = 'O',
|
||||
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') {
|
||||
property <- 'U'
|
||||
}
|
||||
|
||||
# validation of properties
|
||||
valid_properties.bak <- c("ATC code", "Name", "DDD", "U", "Adm.R", "Note")
|
||||
valid_properties <- valid_properties.bak #%>% tolower()
|
||||
valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups")
|
||||
valid_properties.bak <- valid_properties
|
||||
|
||||
property <- tolower(property)
|
||||
valid_properties <- tolower(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))
|
||||
} else if (property == 'groups') {
|
||||
returnvalue <- list()
|
||||
} else {
|
||||
returnvalue <- rep(NA_character_, length(atc_code))
|
||||
}
|
||||
|
||||
progress <- progress_estimated(n = length(atc_code))
|
||||
|
|
@ -89,47 +134,80 @@ atc_property <- function(atc_code,
|
|||
progress$tick()$print()
|
||||
|
||||
atc_url <- sub('%s', atc_code[i], url, fixed = TRUE)
|
||||
tbl <- xml2::read_html(atc_url) %>%
|
||||
rvest::html_nodes('table') %>%
|
||||
rvest::html_table(header = TRUE)
|
||||
|
||||
if (length(tbl) == 0) {
|
||||
warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
|
||||
returnvalue[i] <- NA
|
||||
next
|
||||
}
|
||||
if (property == "groups") {
|
||||
tbl <- xml2::read_html(atc_url) %>%
|
||||
rvest::html_node("#content") %>%
|
||||
rvest::html_children() %>%
|
||||
rvest::html_node("a")
|
||||
|
||||
tbl <- tbl[[1]]
|
||||
# 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)
|
||||
|
||||
if (property == 'Name') {
|
||||
returnvalue[i] <- tbl[1, 2]
|
||||
} else {
|
||||
tbl <- xml2::read_html(atc_url) %>%
|
||||
rvest::html_nodes('table') %>%
|
||||
rvest::html_table(header = TRUE) %>%
|
||||
as.data.frame(stringsAsFactors = FALSE)
|
||||
|
||||
names(returnvalue)[i] <- tbl[1, 2] %>% as.character()
|
||||
# case insensitive column names
|
||||
colnames(tbl) <- tolower(colnames(tbl)) %>% gsub('^atc.*', 'atc', .)
|
||||
|
||||
if (!'Adm.R' %in% colnames(tbl) | is.na(tbl[1, 'Adm.R'])) {
|
||||
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]
|
||||
} else {
|
||||
for (j in 1:nrow(tbl)) {
|
||||
if (tbl[j, 'Adm.R'] == administration) {
|
||||
returnvalue[i] <- tbl[j, property]
|
||||
if (!'adm.r' %in% colnames(tbl) | is.na(tbl[1, 'adm.r'])) {
|
||||
returnvalue[i] <- NA
|
||||
next
|
||||
} else {
|
||||
for (j in 1:nrow(tbl)) {
|
||||
if (tbl[j, 'adm.r'] == administration) {
|
||||
returnvalue[i] <- tbl[j, property]
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cat('\n')
|
||||
returnvalue
|
||||
if (property == "groups" & length(returnvalue) == 1) {
|
||||
returnvalue <- returnvalue[[1]]
|
||||
}
|
||||
|
||||
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
|
||||
#'
|
||||
#' 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 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 tolower return output as lower case with function \code{\link{tolower}}.
|
||||
#' @keywords ab antibiotics
|
||||
|
|
@ -156,6 +234,14 @@ atc_property <- function(atc_code,
|
|||
#' # "AMCL"
|
||||
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
|
||||
|
||||
from <- from[1]
|
||||
|
|
@ -291,12 +377,12 @@ guess_atc <- function(x) {
|
|||
|
||||
if (nrow(found) == 0) {
|
||||
# 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) {
|
||||
# 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) {
|
||||
|
|
|
|||
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"))
|
||||
#' 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
|
||||
#' barplot(rsi_data) # for frequencies
|
||||
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"))
|
||||
#' is.mic(mic_data)
|
||||
#'
|
||||
#' # this can also coerce combined MIC/RSI values:
|
||||
#' as.mic("<=0.002; R") # will return <=0.002
|
||||
#'
|
||||
#' plot(mic_data)
|
||||
#' barplot(mic_data)
|
||||
as.mic <- function(x, na.rm = FALSE) {
|
||||
|
|
@ -216,8 +222,10 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||
}
|
||||
x.bak <- x
|
||||
|
||||
# comma to dot
|
||||
# comma to period
|
||||
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
|
||||
x <- gsub('^[.]+', '0.', x)
|
||||
# <=0.2560.512 should be 0.512
|
||||
|
|
@ -228,8 +236,10 @@ as.mic <- function(x, na.rm = FALSE) {
|
|||
x <- gsub('[^0-9]+$', '', x)
|
||||
# remove last zeroes
|
||||
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",
|
||||
"<0.003", "<=0.003", "0.003", ">=0.003", ">0.003",
|
||||
"<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",
|
||||
"<512", "<=512", "512", ">=512", ">512",
|
||||
"<1024", "<=1024", "1024", ">=1024", ">1024")
|
||||
x <- x %>% as.character()
|
||||
|
||||
na_before <- x[is.na(x) | x == ''] %>% length()
|
||||
x[!x %in% lvls] <- NA
|
||||
|
|
|
|||
|
|
@ -173,7 +173,6 @@ first_isolate <- function(tbl,
|
|||
filter_specimen <- ''
|
||||
}
|
||||
|
||||
specgroup.notice <- ''
|
||||
weighted.notice <- ''
|
||||
# filter on specimen group and keyantibiotics when they are filled in
|
||||
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
|
||||
tbl <- tbl %>%
|
||||
mutate(first_isolate_row_index = 1:nrow(tbl),
|
||||
eersteisolaatbepaling = 0,
|
||||
date_lab = tbl %>% pull(col_date),
|
||||
patient_id = tbl %>% pull(col_patient_id),
|
||||
species = tbl %>% pull(col_species),
|
||||
genus = tbl %>% pull(col_genus)) %>%
|
||||
mutate(species = if_else(is.na(species), '', species),
|
||||
genus = if_else(is.na(genus), '', genus))
|
||||
mutate(species = if_else(is.na(species) | species == "(no MO)", "", species),
|
||||
genus = if_else(is.na(genus) | genus == "(no MO)", "", genus))
|
||||
|
||||
if (filter_specimen == '') {
|
||||
|
||||
|
|
@ -380,7 +378,7 @@ first_isolate <- function(tbl,
|
|||
|
||||
# NA's where genus is unavailable
|
||||
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 %>%
|
||||
arrange(first_isolate_row_index) %>%
|
||||
|
|
|
|||
|
|
@ -44,7 +44,7 @@
|
|||
#' # and can even contain 2 columns, which is convenient for genus/species combinations:
|
||||
#' df$bactid <- df %>% select(genus, species) %>% guess_bactid()
|
||||
#' # same result:
|
||||
#' df <- df %>% mutate(bactid = paste(genus, species) %>% guess_bactid())
|
||||
#' df <- df %>% mutate(bactid = paste(genus, species)) %>% guess_bactid())
|
||||
#' }
|
||||
guess_bactid <- function(x) {
|
||||
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ abname(abcode, from = c("guess", "atc", "molis", "umcg"), to = "official",
|
|||
\arguments{
|
||||
\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}
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
is.mic(mic_data)
|
||||
|
||||
# this can also coerce combined MIC/RSI values:
|
||||
as.mic("<=0.002; R") # will return <=0.002
|
||||
|
||||
plot(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"))
|
||||
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
|
||||
barplot(rsi_data) # for frequencies
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,6 +2,8 @@
|
|||
% Please edit documentation in R/atc.R
|
||||
\name{atc_property}
|
||||
\alias{atc_property}
|
||||
\alias{atc_groups}
|
||||
\alias{atc_ddd}
|
||||
\title{Properties of an ATC code}
|
||||
\source{
|
||||
\url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
|
||||
|
|
@ -9,21 +11,27 @@
|
|||
\usage{
|
||||
atc_property(atc_code, property, administration = "O",
|
||||
url = "https://www.whocc.no/atc_ddd_index/?code=\%s&showdescription=no")
|
||||
|
||||
atc_groups(atc_code, ...)
|
||||
|
||||
atc_ddd(atc_code, ...)
|
||||
}
|
||||
\arguments{
|
||||
\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{...}{parameters to pass on to \code{atc_property}}
|
||||
}
|
||||
\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{
|
||||
Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
||||
Options for parameter \code{administration}:
|
||||
\itemize{
|
||||
\item{\code{"Implant"}}{ = Implant}
|
||||
\item{\code{"Inhal"}}{ = Inhalation}
|
||||
|
|
@ -37,7 +45,7 @@ Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
|
|||
\item{\code{"V"}}{ = vaginal}
|
||||
}
|
||||
|
||||
Abbreviations for the property \code{"U"} (unit):
|
||||
Abbreviations of return values when using \code{property = "U"} (unit):
|
||||
\itemize{
|
||||
\item{\code{"g"}}{ = gram}
|
||||
\item{\code{"mg"}}{ = milligram}
|
||||
|
|
@ -51,7 +59,19 @@ Abbreviations for the property \code{"U"} (unit):
|
|||
}
|
||||
\examples{
|
||||
\donttest{
|
||||
atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
|
||||
atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
|
||||
# What's the ATC 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:
|
||||
df$bactid <- df \%>\% select(genus, species) \%>\% guess_bactid()
|
||||
# same result:
|
||||
df <- df \%>\% mutate(bactid = paste(genus, species) \%>\% guess_bactid())
|
||||
df <- df \%>\% mutate(bactid = paste(genus, species)) \%>\% guess_bactid())
|
||||
}
|
||||
}
|
||||
\seealso{
|
||||
|
|
|
|||
|
|
@ -3,6 +3,9 @@ context("atc.R")
|
|||
test_that("atc_property works", {
|
||||
expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
|
||||
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", {
|
||||
|
|
|
|||
|
|
@ -8,46 +8,57 @@ test_that("keyantibiotics work", {
|
|||
})
|
||||
|
||||
test_that("first isolates work", {
|
||||
# septic_patients contains 1960 out of 2000 first isolates
|
||||
#septic_ptns <- septic_patients
|
||||
expect_equal(sum(first_isolate(tbl = septic_patients,
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
info = FALSE)), 1960)
|
||||
|
||||
# septic_patients contains 1962 out of 2000 first *weighted* isolates
|
||||
# septic_patients contains 1959 out of 2000 first isolates
|
||||
expect_equal(
|
||||
suppressWarnings(sum(
|
||||
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
|
||||
sum(
|
||||
first_isolate(tbl = septic_patients,
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
col_keyantibiotics = "keyab",
|
||||
type = "keyantibiotics",
|
||||
info = TRUE))),
|
||||
1962)
|
||||
info = FALSE),
|
||||
na.rm = TRUE), 1959)
|
||||
|
||||
# septic_patients contains 1733 out of 2000 first non-ICU isolates
|
||||
# septic_patients contains 1961 out of 2000 first *weighted* isolates
|
||||
expect_equal(
|
||||
suppressWarnings(
|
||||
sum(
|
||||
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
col_keyantibiotics = "keyab",
|
||||
type = "keyantibiotics",
|
||||
info = TRUE),
|
||||
na.rm = TRUE)),
|
||||
1961)
|
||||
|
||||
# septic_patients contains 1732 out of 2000 first non-ICU isolates
|
||||
expect_equal(
|
||||
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)),
|
||||
1733
|
||||
)
|
||||
first_isolate(septic_patients,
|
||||
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'
|
||||
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
|
||||
expect_lt(sum(
|
||||
first_isolate(tbl = mutate(septic_patients,
|
||||
specimen = if_else(row_number() %in% random_rows,
|
||||
"Urine",
|
||||
"Unknown")),
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
col_specimen = "specimen",
|
||||
filter_specimen = "Urine",
|
||||
info = TRUE)),
|
||||
expect_lt(
|
||||
sum(
|
||||
first_isolate(tbl = mutate(septic_patients,
|
||||
specimen = if_else(row_number() %in% random_rows,
|
||||
"Urine",
|
||||
"Unknown")),
|
||||
col_date = "date",
|
||||
col_patient_id = "patient_id",
|
||||
col_bactid = "bactid",
|
||||
col_specimen = "specimen",
|
||||
filter_specimen = "Urine",
|
||||
info = TRUE),
|
||||
na.rm = TRUE),
|
||||
1501)
|
||||
|
||||
})
|
||||
|
|
|
|||
Loading…
Reference in New Issue