P281424
/
AMR
mirror of https://github.com/msberends/AMR.git
1
0
Fork 0
Code Releases Activity

abname improvement, small fixes

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-08-13 11:00:53 +02:00
parent ce2cdb9309
commit dba06c3295
9 changed files with 201 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 0.2.0.9023
Date: 2018-08-12
Date: 2018-08-13
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(
@ -37,10 +37,7 @@ Authors@R: c(
family = "Sinha",
email = "b.sinha@umcg.nl",
role = "ths",
comment = c(ORCID = "0000-0003-1634-0010")),
person(
family = "University of Groningen",
role = "uvp"))
comment = c(ORCID = "0000-0003-1634-0010")))
Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR)
of microbial isolates, by using new S3 classes and applying EUCAST expert rules
on antibiograms according to Leclercq (2013)
@ -54,7 +51,6 @@ Imports:
dplyr (>= 0.7.0),
xml2 (>= 1.0.0),
knitr (>= 1.0.0),
Rcpp (>= 0.12.14),
readr,
rvest (>= 0.3.2),
tibble

5
NEWS.md
View File

@ -35,13 +35,14 @@
* Possibility to globally set the default for the amount of items to print, with `options(max.print.freq = n)` where *n* is your preset value
#### Changed
* Improvements for forcasting with `resistance_predict` and added more examples
* More antibiotics for EUCAST rules
* Improvements for forecasting with `resistance_predict` and added more examples
* More antibiotics added as parameters for EUCAST rules
* Updated version of the `septic_patients` data set to better reflect the reality
* Pretty printing for tibbles removed as it is not really the scope of this package
* Printing of `mic` and `rsi` classes now returns all values - use `freq` to check distributions
* Improved speed of key antibiotics comparison for determining first isolates
* Column names for the `key_antibiotics` function are now generic: 6 for broadspectrum ABs, 6 for Gram-positive specific and 6 for Gram-negative specific ABs
* Speed improvement for the `abname` function
* `%like%` now supports multiple patterns
* Frequency tables are now actual `data.frame`s with altered console printing to make it look like a frequency table. Because of this, the parameter `toConsole` is not longer needed.
* Fix for `freq` where the class of an item would be lost

163
R/abname.R Normal file
View File

@ -0,0 +1,163 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# AUTHORS #
# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# LICENCE #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License version 2.0, #
# as published by the Free Software Foundation. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# ==================================================================== #
#' 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"}. When using \code{to = "atc"}, the ATC code will be searched 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
#' @source \code{\link{antibiotics}}
#' @export
#' @importFrom dplyr %>% pull
#' @examples
#' abname("AMCL")
#' # "amoxicillin and enzyme inhibitor"
#'
#' # It is quite flexible at default (having `from = "guess"`)
#' abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil"))
#' # "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin"
#'
#' # Multiple antibiotics can be combined with "+".
#' # The second antibiotic will be set to lower case when `tolower` was not set:
#' abname("AMCL+GENT", textbetween = "/")
#' # "amoxicillin and enzyme inhibitor/gentamicin"
#'
#' abname(c("AMCL", "GENT"))
#' # "Amoxicillin and beta-lactamase inhibitor" "Gentamicin"
#'
#' abname("AMCL", to = "trivial_nl")
#' # "Amoxicilline/clavulaanzuur"
#'
#' abname("AMCL", to = "atc")
#' # "J01CR02"
#'
#' # specific codes for University Medical Center Groningen (UMCG):
#' abname("J01CR02", from = "atc", to = "umcg")
#' # "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
abx <- AMR::antibiotics
from <- from[1]
# if (from == "guess") {
# for (i in 1:3) {
# if (abcode[1] %in% (antibiotics %>% pull(i))) {
# from <- colnames(antibiotics)[i]
# }
# }
# if (from == "guess") {
# from <- "umcg"
# }
# }
colnames(abx) <- colnames(abx) %>% tolower()
from <- from %>% tolower()
to <- to %>% tolower()
if (!(from %in% colnames(abx) | from == "guess") |
!to %in% colnames(abx)) {
stop(paste0('Invalid `from` or `to`. Choose one of ',
colnames(abx) %>% paste(collapse = ", "), '.'), call. = FALSE)
}
abcode <- as.character(abcode)
abcode.bak <- abcode
for (i in 1:length(abcode)) {
if (abcode[i] %like% "[+]") {
# support for multiple ab's with +
parts <- trimws(strsplit(abcode[i], split = "+", fixed = TRUE)[[1]])
ab1 <- abname(parts[1], from = from, to = to)
ab2 <- abname(parts[2], from = from, to = to)
if (missing(tolower)) {
ab2 <- tolower(ab2)
}
abcode[i] <- paste0(ab1, textbetween, ab2)
next
}
if (from %in% c("atc", "guess")) {
if (abcode[i] %in% abx$atc) {
abcode[i] <- abx[which(abx$atc == abcode[i]),] %>% pull(to)
next
}
}
if (from %in% c("molis", "guess")) {
if (abcode[i] %in% abx$molis) {
abcode[i] <- abx[which(abx$molis == abcode[i]),] %>% pull(to)
next
}
}
if (from %in% c("umcg", "guess")) {
if (abcode[i] %in% abx$umcg) {
abcode[i] <- abx[which(abx$umcg == abcode[i]),] %>% pull(to)
next
}
}
if (from %in% c("trade_name", "guess")) {
if (abcode[i] %in% abx$trade_name) {
abcode[i] <- abx[which(abx$trade_name == abcode[i]),] %>% pull(to)
next
}
if (sum(abx$trade_name %like% abcode[i]) > 0) {
abcode[i] <- abx[which(abx$trade_name %like% abcode[i]),] %>% pull(to)
next
}
}
if (from != "guess") {
# when not found, try any `from`
abcode[i] <- abx[which(abx[,from] == abcode[i]),] %>% pull(to) %>% .[1]
}
# when nothing found, try first chars of official name
# if (is.na(abcode[i])) {
# abcode[i] <- antibiotics %>%
# filter(official %like% paste0('^', abcode.bak[i])) %>%
# pull(to) %>%
# .[1]
# next
# }
if (is.na(abcode[i]) | length(abcode[i] == 0)) {
abcode[i] <- abcode.bak[i]
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
}
}
if (tolower == TRUE) {
abcode <- abcode %>% tolower()
}
abcode
}

133
R/atc.R
View File

@ -203,139 +203,6 @@ 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"}. 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
#' @source \code{\link{antibiotics}}
#' @export
#' @importFrom dplyr %>% filter select slice
#' @examples
#' abname("AMCL")
#' # "amoxicillin and enzyme inhibitor"
#'
#' abname("AMCL+GENT")
#' # "amoxicillin and enzyme inhibitor + gentamicin"
#'
#' abname(c("AMCL", "GENT"))
#' # "amoxicillin and enzyme inhibitor" "gentamicin"
#'
#' abname("AMCL", to = "trivial_nl")
#' # "Amoxicilline/clavulaanzuur"
#'
#' abname("AMCL", to = "atc")
#' # "J01CR02"
#'
#' abname("J01CR02", from = "atc", to = "umcg")
#' # "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]
if (from == "guess") {
for (i in 1:3) {
if (abcode[1] %in% (antibiotics %>% pull(i))) {
from <- colnames(antibiotics)[i]
}
}
if (from == "guess") {
from <- "umcg"
}
}
colnames(antibiotics) <- colnames(antibiotics) %>% tolower()
from <- from %>% tolower()
to <- to %>% tolower()
if (!from %in% colnames(antibiotics) |
!to %in% colnames(antibiotics)) {
stop(paste0('Invalid `from` or `to`. Choose one of ',
colnames(antibiotics) %>% paste(collapse = ", "), '.'), call. = FALSE)
}
abcode <- as.character(abcode)
abcode.bak <- abcode
for (i in 1:length(abcode)) {
abcode[i] <- abcode[i]
if (!grepl('+', abcode[i], fixed = TRUE) & !grepl(' en ', abcode[i], fixed = TRUE)) {
# only 1 drug
if (abcode[i] %in% (antibiotics %>% pull(from))) {
abcode[i] <-
antibiotics %>%
filter(.[, from] == abcode[i]) %>%
select(to) %>%
slice(1) %>%
as.character()
} else {
# not found
abcode[i] <- NA
}
} else {
# more than 1 drug
if (grepl('+', abcode[i], fixed = TRUE)) {
abcode.group <-
strsplit(abcode[i], '+', fixed = TRUE) %>%
unlist() %>%
trimws('both')
} else if (grepl(' en ', abcode[i], fixed = TRUE)) {
abcode.group <-
strsplit(abcode[i], ' en ', fixed = TRUE) %>%
unlist() %>%
trimws('both')
} else {
warning('Invalid concat.')
abcode[i] <- NA
next
}
for (j in 1:length(abcode.group)) {
abcode.group[j] <-
antibiotics %>%
filter(.[, from] == abcode.group[j]) %>%
select(to) %>%
slice(1) %>%
as.character()
if (j > 1 & to %in% c('official', 'trivial_nl')) {
abcode.group[j] <- abcode.group[j] %>% tolower()
}
}
abcode[i] <- paste(abcode.group, collapse = textbetween)
}
# when nothing found, try first chars of official name
if (is.na(abcode[i])) {
abcode[i] <- antibiotics %>%
filter(official %like% paste0('^', abcode.bak[i])) %>%
pull(to) %>%
.[1]
}
if (is.na(abcode[i])) {
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
}
}
if (tolower == TRUE) {
abcode <- abcode %>% tolower()
}
abcode
}
#' Find ATC code based on antibiotic property
#'

2
R/ggplot_rsi.R
View File

@ -71,7 +71,7 @@
#' select(hospital_id, amox, cipr) %>%
#' group_by(hospital_id) %>%
#' ggplot_rsi() +
#' facet_grid("hospital_id") +
#' facet_wrap("hospital_id", nrow = 1) +
#' labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital")
ggplot_rsi <- function(data,
position = "stack",

17
man/abname.Rd Executable file → Normal file
View File

@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/atc.R
% Please edit documentation in R/abname.R
\name{abname}
\alias{abname}
\title{Name of an antibiotic}
@ -13,7 +13,7 @@ abname(abcode, from = c("guess", "atc", "molis", "umcg"),
\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"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.}
\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 searched using \code{\link{guess_atc}}.}
\item{textbetween}{text to put between multiple returned texts}
@ -26,11 +26,17 @@ Convert antibiotic codes (from a laboratory information system like MOLIS or GLI
abname("AMCL")
# "amoxicillin and enzyme inhibitor"
abname("AMCL+GENT")
# "amoxicillin and enzyme inhibitor + gentamicin"
# It is quite flexible at default (having `from = "guess"`)
abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil"))
# "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin" "Amoxicillin"
# Multiple antibiotics can be combined with "+".
# The second antibiotic will be set to lower case when `tolower` was not set:
abname("AMCL+GENT", textbetween = "/")
# "amoxicillin and enzyme inhibitor/gentamicin"
abname(c("AMCL", "GENT"))
# "amoxicillin and enzyme inhibitor" "gentamicin"
# "Amoxicillin and beta-lactamase inhibitor" "Gentamicin"
abname("AMCL", to = "trivial_nl")
# "Amoxicilline/clavulaanzuur"
@ -38,6 +44,7 @@ abname("AMCL", to = "trivial_nl")
abname("AMCL", to = "atc")
# "J01CR02"
# specific codes for University Medical Center Groningen (UMCG):
abname("J01CR02", from = "atc", to = "umcg")
# "AMCL"
}

2
man/ggplot_rsi.Rd
View File

@ -84,6 +84,6 @@ septic_patients \%>\%
select(hospital_id, amox, cipr) \%>\%
group_by(hospital_id) \%>\%
ggplot_rsi() +
facet_grid("hospital_id") +
facet_wrap("hospital_id", nrow = 1) +
labs(title = "AMR of Amoxicillin And Ciprofloxacine Per Hospital")
}

19
tests/testthat/test-abname.R Normal file
View File

@ -0,0 +1,19 @@
context("abname.R")
test_that("abname works", {
expect_equal(abname("AMOX"), "Amoxicillin")
expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin"))
expect_equal(abname(c("AMOX+GENT")), "Amoxicillin + gentamicin")
expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin")
expect_equal(abname("amox", from = 'molis', tolower = TRUE), "amoxicillin")
expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin")
expect_equal(abname(c("amox", "J01CA04", "Trimox", "dispermox", "Amoxil")),
rep("Amoxicillin", 5))
expect_equal(abname("AMOX", to = 'atc'), "J01CA04")
expect_error(abname("AMOX", to = c(1:3)))
expect_error(abname("AMOX", to = "test"))
expect_warning(abname("TEST
"))
expect_warning(abname("AMOX or GENT"))
})

17
tests/testthat/test-atc.R
View File

@ -4,7 +4,6 @@ test_that("atc_property works", {
if (!is.null(curl::nslookup("www.whocc.no", error = FALSE))) {
expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
expect_equal(atc_property("J01CA04", property = "unit"), "g")
expect_equal(atc_property("J01CA04", property = "DDD"),
atc_ddd("J01CA04"))
@ -19,22 +18,6 @@ test_that("atc_property works", {
}
})
test_that("abname works", {
expect_equal(abname("AMOX"), "Amoxicillin")
expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin"))
expect_equal(abname(c("AMOX+GENT")), "Amoxicillin + gentamicin")
expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin")
expect_equal(abname("amox", from = 'molis', tolower = TRUE), "amoxicillin")
expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin")
expect_equal(abname("AMOX", to = 'atc'), "J01CA04")
expect_equal(abname("AMOX en GENT"), "Amoxicillin + gentamicin")
expect_error(abname("AMOX", to = c(1:3)))
expect_error(abname("AMOX", to = "test"))
expect_warning(abname("TEST
"))
expect_warning(abname("AMOX or GENT"))
})
test_that("guess_atc works", {
expect_equal(guess_atc(c("J01FA01",
"Erythromycin",