Browse Source

(v1.5.0.9028) Updated taxonomy until March 2021

main
parent
commit
ddf88345f1
  1. 8
      DESCRIPTION
  2. 15
      NEWS.md
  3. 32
      R/catalogue_of_life.R
  4. 36
      R/data.R
  5. 33
      R/ggplot_rsi.R
  6. 13
      R/like.R
  7. 28
      R/mo.R
  8. 16
      R/mo_property.R
  9. 113
      R/plot.R
  10. BIN
      R/sysdata.rda
  11. 19
      R/translate.R
  12. 2
      _pkgdown.yml
  13. BIN
      data-raw/AMR_latest.tar.gz
  14. 2
      data-raw/_internals.R
  15. BIN
      data-raw/intrinsic_resistant.dta
  16. 2
      data-raw/intrinsic_resistant.md5
  17. BIN
      data-raw/intrinsic_resistant.rds
  18. BIN
      data-raw/intrinsic_resistant.sas
  19. BIN
      data-raw/intrinsic_resistant.sav
  20. 9898
      data-raw/intrinsic_resistant.txt
  21. BIN
      data-raw/intrinsic_resistant.xlsx
  22. BIN
      data-raw/microorganisms.dta
  23. BIN
      data-raw/microorganisms.old.dta
  24. 2
      data-raw/microorganisms.old.md5
  25. BIN
      data-raw/microorganisms.old.rds
  26. BIN
      data-raw/microorganisms.old.sas
  27. BIN
      data-raw/microorganisms.old.sav
  28. 3422
      data-raw/microorganisms.old.txt
  29. BIN
      data-raw/microorganisms.old.xlsx
  30. BIN
      data-raw/microorganisms.rds
  31. BIN
      data-raw/microorganisms.sas
  32. BIN
      data-raw/microorganisms.sav
  33. BIN
      data-raw/microorganisms.translation.rds
  34. 31794
      data-raw/microorganisms.txt
  35. BIN
      data-raw/microorganisms.xlsx
  36. 2
      data-raw/mo.md5
  37. 414
      data-raw/reproduction_of_microorganisms_update.R
  38. 2
      data-raw/rsi.md5
  39. BIN
      data-raw/rsi_translation.dta
  40. BIN
      data-raw/rsi_translation.rds
  41. BIN
      data-raw/rsi_translation.sas
  42. BIN
      data-raw/rsi_translation.sav
  43. 8
      data-raw/rsi_translation.txt
  44. BIN
      data-raw/rsi_translation.xlsx
  45. 8
      data-raw/snomed.R
  46. 674
      data-raw/translations.tsv
  47. BIN
      data/intrinsic_resistant.rda
  48. BIN
      data/microorganisms.codes.rda
  49. BIN
      data/microorganisms.old.rda
  50. BIN
      data/microorganisms.rda
  51. BIN
      data/rsi_translation.rda
  52. 2
      docs/404.html
  53. 2
      docs/LICENSE-text.html
  54. 500
      docs/articles/AMR.html
  55. BIN
      docs/articles/AMR_files/figure-html/disk_plots-1.png
  56. BIN
      docs/articles/AMR_files/figure-html/disk_plots_mo_ab-1.png
  57. BIN
      docs/articles/AMR_files/figure-html/mic_plots-1.png
  58. BIN
      docs/articles/AMR_files/figure-html/mic_plots-2.png
  59. BIN
      docs/articles/AMR_files/figure-html/mic_plots_mo_ab-1.png
  60. BIN
      docs/articles/AMR_files/figure-html/mic_plots_mo_ab-2.png
  61. BIN
      docs/articles/AMR_files/figure-html/plot 1-1.png
  62. BIN
      docs/articles/AMR_files/figure-html/plot 3-1.png
  63. BIN
      docs/articles/AMR_files/figure-html/plot 4-1.png
  64. BIN
      docs/articles/AMR_files/figure-html/plot 5-1.png
  65. 2
      docs/articles/index.html
  66. 2
      docs/authors.html
  67. 8
      docs/index.html
  68. 30
      docs/news/index.html
  69. 2
      docs/pkgdown.yml
  70. 4
      docs/reference/as.mo.html
  71. 8
      docs/reference/catalogue_of_life.html
  72. 6
      docs/reference/catalogue_of_life_version.html
  73. 15
      docs/reference/ggplot_rsi.html
  74. 16
      docs/reference/index.html
  75. 4
      docs/reference/microorganisms.codes.html
  76. 44
      docs/reference/microorganisms.html
  77. 6
      docs/reference/microorganisms.old.html
  78. 4
      docs/reference/mo_property.html
  79. 10
      docs/reference/plot.html
  80. 4
      docs/reference/rsi_translation.html
  81. 2
      docs/survey.html
  82. 2
      index.md
  83. 2
      man/as.mo.Rd
  84. 6
      man/catalogue_of_life.Rd
  85. 4
      man/catalogue_of_life_version.Rd
  86. 13
      man/ggplot_rsi.Rd
  87. 37
      man/microorganisms.Rd
  88. 2
      man/microorganisms.codes.Rd
  89. 4
      man/microorganisms.old.Rd
  90. 2
      man/mo_property.Rd
  91. 6
      man/plot.Rd
  92. 2
      man/rsi_translation.Rd
  93. 8
      tests/testthat/test-data.R
  94. 1
      tests/testthat/test-mo.R
  95. 3
      tests/testthat/test-mo_property.R

8
DESCRIPTION

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
Package: AMR
Version: 1.5.0.9027
Date: 2021-02-26
Version: 1.5.0.9028
Date: 2021-03-04
Title: Antimicrobial Resistance Data Analysis
Authors@R: c(
person(role = c("aut", "cre"),
@ -38,8 +38,8 @@ Authors@R: c( @@ -38,8 +38,8 @@ Authors@R: c(
Description: Functions to simplify the analysis and prediction of Antimicrobial
Resistance (AMR) and to work with microbial and antimicrobial properties by
using evidence-based methods, like those defined by Leclercq et al. (2013)
<doi:10.1111/j.1469-0691.2011.03703.x> and the Clinical and Laboratory
Standards Institute (2014) <isbn: 1-56238-899-1>.
<doi:10.1111/j.1469-0691.2011.03703.x> and containing reference data such as
LPSN <doi:10.1099/ijsem.0.004332>.
Depends:
R (>= 3.0.0)
Suggests:

15
NEWS.md

@ -1,5 +1,5 @@ @@ -1,5 +1,5 @@
# AMR 1.5.0.9027
## <small>Last updated: 26 February 2021</small>
# AMR 1.5.0.9028
## <small>Last updated: 4 March 2021</small>
### New
* Support for EUCAST Clinical Breakpoints v11.0 (2021), effective in the `eucast_rules()` function and in `as.rsi()` to interpret MIC and disk diffusion values. This is now the default guideline in this package.
@ -45,6 +45,14 @@ @@ -45,6 +45,14 @@
```
### Changed
* Microbial taxonomy updated to 3 March 2021 (according to the [LSPN](https://lpsn.dsmz.de))
* Added 3,372 new names and 1,523 existing names became synomyms
* The URL of a bacterial species (`mo_url()`) will now lead to https://lpsn.dsmz.de
* Big update for plotting classes `rsi`, `<mic>`, and `<disk>`:
* Plotting of MIC and disk diffusion values now support interpretation colouring if you supply the microorganism and antimicrobial agent
* All colours were updated to colour-blind friendly versions for values R, S and I for all plot methods (also applies to tibble printing)
* Interpretation of MIC and disk diffusion values to R/SI will now be translated if the system language is German, Dutch or Spanish (see `translate`)
* Plotting is now possible with base R using `plot()` and with ggplot2 using `ggplot()` on any vector of MIC and disk diffusion values
* `is.rsi()` and `is.rsi.eligible()` now return a vector of `TRUE`/`FALSE` when the input is a data set, by iterating over all columns
* Using functions without setting a data set (e.g., `mo_is_gram_negative()`, `mo_is_gram_positive()`, `mo_is_intrinsic_resistant()`, `first_isolate()`, `mdro()`) now work with `dplyr`s `group_by()` again
* `first_isolate()` can be used with `group_by()` (also when using a dot `.` as input for the data) and now returns the names of the groups
@ -55,8 +63,6 @@ @@ -55,8 +63,6 @@
* `is.rsi.eligible()` now detects if the column name resembles an antibiotic name or code and now returns `TRUE` immediately if the input contains any of the values "R", "S" or "I". This drastically improves speed, also for a lot of other functions that rely on automatic determination of antibiotic columns.
* Functions `get_episode()` and `is_new_episode()` now support less than a day as value for argument `episode_days` (e.g., to include one patient/test per hour)
* Argument `ampc_cephalosporin_resistance` in `eucast_rules()` now also applies to value "I" (not only "S")
* Updated `plot()` functions for classes `<mic>`, `<disk>` and `<rsi>` - the former two now support colouring if you supply the microorganism and antimicrobial agent
* Updated colours to colour-blind friendly version for values R, S and I in tibble printing and for all plot methods (`ggplot_rsi()` and using `plot()` on classes `<mic>`, `<disk>` and `<rsi>`)
* Functions `print()` and `summary()` on a Principal Components Analysis object (`pca()`) now print additional group info if the original data was grouped using `dplyr::group_by()`
* Improved speed and reliability of `guess_ab_col()`. As this also internally improves the reliability of `first_isolate()` and `mdro()`, this might have a slight impact on the results of those functions.
* Fix for `mo_name()` when used in other languages than English
@ -64,6 +70,7 @@ @@ -64,6 +70,7 @@
* *Staphylococcus cornubiensis* is now correctly categorised as coagulase-positive
* `random_disk()` and `random_mic()` now have an expanded range in their randomisation
* Support for GISA (glycopeptide-intermediate *S. aureus*), so e.g. `mo_genus("GISA")` will return `"Staphylococcus"`
* Added translations of German and Spanish for more than 200 antimicrobial drugs
### Other
* Big documentation updates

32
R/catalogue_of_life.R

@ -46,7 +46,7 @@ format_included_data_number <- function(data) { @@ -46,7 +46,7 @@ format_included_data_number <- function(data) {
#' \if{html}{\figure{logo_col.png}{options: height=40px style=margin-bottom:5px} \cr}
#' This package contains the complete taxonomic tree of almost all microorganisms (~70,000 species) from the authoritative and comprehensive Catalogue of Life (CoL, <http://www.catalogueoflife.org>). The CoL is the most comprehensive and authoritative global index of species currently available. Nonetheless, we supplemented the CoL data with data from the List of Prokaryotic names with Standing in Nomenclature (LPSN, [lpsn.dsmz.de](https://lpsn.dsmz.de)). This supplementation is needed until the [CoL+ project](https://github.com/CatalogueOfLife/general) is finished, which we await.
#'
#' [Click here][catalogue_of_life] for more information about the included taxa. Check which versions of the CoL and LSPN were included in this package with [catalogue_of_life_version()].
#' [Click here][catalogue_of_life] for more information about the included taxa. Check which versions of the CoL and LPSN were included in this package with [catalogue_of_life_version()].
#' @section Included Taxa:
#' Included are:
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria", "Chromista", "Protozoa")), ])` (sub)species from the kingdoms of Archaea, Bacteria, Chromista and Protozoa
@ -99,7 +99,7 @@ NULL @@ -99,7 +99,7 @@ NULL
#'
#' This function returns information about the included data from the Catalogue of Life.
#' @seealso [microorganisms]
#' @details For DSMZ, see [microorganisms].
#' @details For LPSN, see [microorganisms].
#' @return a [list], which prints in pretty format
#' @inheritSection catalogue_of_life Catalogue of Life
#' @inheritSection AMR Read more on Our Website!
@ -109,15 +109,15 @@ catalogue_of_life_version <- function() { @@ -109,15 +109,15 @@ catalogue_of_life_version <- function() {
check_dataset_integrity()
# see the `catalogue_of_life` list in R/data.R
lst <- list(catalogue_of_life =
lst <- list(CoL =
list(version = gsub("{year}", catalogue_of_life$year, catalogue_of_life$version, fixed = TRUE),
url = gsub("{year}", catalogue_of_life$year, catalogue_of_life$url_CoL, fixed = TRUE),
n = nrow(pm_filter(microorganisms, source == "CoL"))),
deutsche_sammlung_von_mikroorganismen_und_zellkulturen =
list(version = "Prokaryotic Nomenclature Up-to-Date from DSMZ",
url = catalogue_of_life$url_DSMZ,
yearmonth = catalogue_of_life$yearmonth_DSMZ,
n = nrow(pm_filter(microorganisms, source == "DSMZ"))),
LPSN =
list(version = "List of Prokaryotic names with Standing in Nomenclature",
url = catalogue_of_life$url_LPSN,
yearmonth = catalogue_of_life$yearmonth_LPSN,
n = nrow(pm_filter(microorganisms, source == "LPSN"))),
total_included =
list(
n_total_species = nrow(microorganisms),
@ -132,14 +132,14 @@ catalogue_of_life_version <- function() { @@ -132,14 +132,14 @@ catalogue_of_life_version <- function() {
#' @noRd
print.catalogue_of_life_version <- function(x, ...) {
lst <- x
cat(paste0(font_bold("Included in this AMR package are:\n\n"),
font_underline(lst$catalogue_of_life$version), "\n",
" Available at: ", lst$catalogue_of_life$url, "\n",
" Number of included species: ", format(lst$catalogue_of_life$n, big.mark = ","), "\n",
font_underline(paste0(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$version, " (",
lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$yearmonth, ")")), "\n",
" Available at: ", lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$url, "\n",
" Number of included species: ", format(lst$deutsche_sammlung_von_mikroorganismen_und_zellkulturen$n, big.mark = ","), "\n\n",
cat(paste0(font_bold("Included in this AMR package (v", utils::packageDescription("AMR")$Version, ") are:\n\n", collapse = ""),
font_underline(lst$CoL$version), "\n",
" Available at: ", lst$CoL$url, "\n",
" Number of included species: ", format(lst$CoL$n, big.mark = ","), "\n",
font_underline(paste0(lst$LPSN$version, " (",
lst$LPSN$yearmonth, ")")), "\n",
" Available at: ", lst$LPSN$url, "\n",
" Number of included species: ", format(lst$LPSN$n, big.mark = ","), "\n\n",
"=> Total number of species included: ", format(lst$total_included$n_total_species, big.mark = ","), "\n",
"=> Total number of synonyms included: ", format(lst$total_included$n_total_synonyms, big.mark = ","), "\n\n",
"See for more info ?microorganisms and ?catalogue_of_life.\n"))

36
R/data.R

@ -83,7 +83,7 @@ @@ -83,7 +83,7 @@
#' Data Set with `r format(nrow(microorganisms), big.mark = ",")` Microorganisms
#'
#' A data set containing the microbial taxonomy of six kingdoms from the Catalogue of Life. MO codes can be looked up using [as.mo()].
#' A data set containing the microbial taxonomy, last updated in `r catalogue_of_life$yearmonth_LPSN`, of six kingdoms from the Catalogue of Life (CoL) and the List of Prokaryotic names with Standing in Nomenclature (LPSN). MO codes can be looked up using [as.mo()].
#' @inheritSection catalogue_of_life Catalogue of Life
#' @format A [data.frame] with `r format(nrow(microorganisms), big.mark = ",")` observations and `r ncol(microorganisms)` variables:
#' - `mo`\cr ID of microorganism as used by this package
@ -92,15 +92,15 @@ @@ -92,15 +92,15 @@
#' - `rank`\cr Text of the taxonomic rank of the microorganism, like `"species"` or `"genus"`
#' - `ref`\cr Author(s) and year of concerning scientific publication
#' - `species_id`\cr ID of the species as used by the Catalogue of Life
#' - `source`\cr Either "CoL", "DSMZ" (see *Source*) or "manually added"
#' - `source`\cr Either `r vector_or(microorganisms$source)` (see *Source*)
#' - `prevalence`\cr Prevalence of the microorganism, see [as.mo()]
#' - `snomed`\cr SNOMED code of the microorganism. Use [mo_snomed()] to retrieve it quickly, see [mo_property()].
#' @details
#' Please note that entries are only based on the Catalogue of Life and the LPSN (see below). Since these sources incorporate entries based on (recent) publications in the International Journal of Systematic and Evolutionary Microbiology (IJSEM), it can happen that the year of publication is sometimes later than one might expect.
#'
#' For example, *Staphylococcus pettenkoferi* was newly named in Diagnostic Microbiology and Infectious Disease in 2002 (PMID 12106949), but it was not before 2007 that a publication in IJSEM followed (PMID 17625191). Consequently, the AMR package returns 2007 for `mo_year("S. pettenkoferi")`.
#' For example, *Staphylococcus pettenkoferi* was described for the first time in Diagnostic Microbiology and Infectious Disease in 2002 (\doi{10.1016/s0732-8893(02)00399-1}), but it was not before 2007 that a publication in IJSEM followed (\doi{10.1099/ijs.0.64381-0}). Consequently, the AMR package returns 2007 for `mo_year("S. pettenkoferi")`.
#'
#' ## Manually additions
#' ## Manual additions
#' For convenience, some entries were added manually:
#'
#' - 11 entries of *Streptococcus* (beta-haemolytic: groups A, B, C, D, F, G, H, K and unspecified; other: viridans, milleri)
@ -110,7 +110,6 @@ @@ -110,7 +110,6 @@
#' - 1 entry of *Blastocystis* (*Blastocystis hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
#' - 5 other 'undefined' entries (unknown, unknown Gram negatives, unknown Gram positives, unknown yeast and unknown fungus)
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not (yet) in the Catalogue of Life
#' - `r format(nrow(subset(microorganisms, source == "DSMZ")), big.mark = ",")` species from the DSMZ (Deutsche Sammlung von Mikroorganismen und Zellkulturen) since the DSMZ contain the latest taxonomic information based on recent publications
#'
#' ## Direct download
#' This data set is available as 'flat file' for use even without \R - you can find the file here:
@ -120,16 +119,21 @@ @@ -120,16 +119,21 @@
#' The file in \R format (with preserved data structure) can be found here:
#'
#' * <https://github.com/msberends/AMR/raw/master/data/microorganisms.rda>
#' @section About the Records from DSMZ (see *Source*):
#' Names of prokaryotes are defined as being validly published by the International Code of Nomenclature of Bacteria. Validly published are all names which are included in the Approved Lists of Bacterial Names and the names subsequently published in the International Journal of Systematic Bacteriology (IJSB) and, from January 2000, in the International Journal of Systematic and Evolutionary Microbiology (IJSEM) as original articles or in the validation lists.
#' *(from <https://www.dsmz.de/services/online-tools/prokaryotic-nomenclature-up-to-date>)*
#' @section About the Records from LPSN (see *Source*):
#' The List of Prokaryotic names with Standing in Nomenclature (LPSN) provides comprehensive information on the nomenclature of prokaryotes. LPSN is a free to use service founded by Jean P. Euzeby in 1997 and later on maintained by Aidan C. Parte.
#'
#' In February 2020, the DSMZ records were merged with the List of Prokaryotic names with Standing in Nomenclature (LPSN).
#' @source Catalogue of Life: Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org> (check included annual version with [catalogue_of_life_version()]).
#' As of February 2020, the regularly augmented LPSN database at DSMZ is the basis of the new LPSN service. The new database was implemented for the Type-Strain Genome Server and augmented in 2018 to store all kinds of nomenclatural information. Data from the previous version of LPSN and from the Prokaryotic Nomenclature Up-to-date (PNU) service were imported into the new system. PNU had been established in 1993 as a service of the Leibniz Institute DSMZ, and was curated by Norbert Weiss, Manfred Kracht and Dorothea Gleim.
#' @source
#' `r gsub("{year}", catalogue_of_life$year, catalogue_of_life$version, fixed = TRUE)`
#'
#' Parte, A.C. (2018). LPSN — List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#'
#' Leibniz Institute DSMZ-German Collection of Microorganisms and Cell Cultures, Germany, Prokaryotic Nomenclature Up-to-Date, <https://www.dsmz.de/services/online-tools/prokaryotic-nomenclature-up-to-date> and <https://lpsn.dsmz.de> (check included version with [catalogue_of_life_version()]).
#' * Annual Checklist (public online taxonomic database), <http://www.catalogueoflife.org>
#'
#' List of Prokaryotic names with Standing in Nomenclature: `r catalogue_of_life$yearmonth_LPSN`
#'
#' * Parte, A.C., Sarda Carbasse, J., Meier-Kolthoff, J.P., Reimer, L.C. and Goker, M. (2020). List of Prokaryotic names with Standing in Nomenclature (LPSN) moves to the DSMZ. International Journal of Systematic and Evolutionary Microbiology, 70, 5607-5612; \doi{10.1099/ijsem.0.004332}
#' * Parte, A.C. (2018). LPSN — List of Prokaryotic names with Standing in Nomenclature (bacterio.net), 20 years on. International Journal of Systematic and Evolutionary Microbiology, 68, 1825-1829; \doi{10.1099/ijsem.0.002786}
#' * Parte, A.C. (2014). LPSN — List of Prokaryotic names with Standing in Nomenclature. Nucleic Acids Research, 42, Issue D1, D613–D616; \doi{10.1093/nar/gkt1111}
#' * Euzeby, J.P. (1997). List of Bacterial Names with Standing in Nomenclature: a Folder Available on the Internet. International Journal of Systematic Bacteriology, 47, 590-592; \doi{10.1099/00207713-47-2-590}
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
@ -139,8 +143,8 @@ catalogue_of_life <- list( @@ -139,8 +143,8 @@ catalogue_of_life <- list(
year = 2019,
version = "Catalogue of Life: {year} Annual Checklist",
url_CoL = "http://www.catalogueoflife.org/col/",
url_DSMZ = "https://lpsn.dsmz.de",
yearmonth_DSMZ = "May 2020"
url_LPSN = "https://lpsn.dsmz.de",
yearmonth_LPSN = "March 2021"
)
#' Data Set with Previously Accepted Taxonomic Names
@ -242,7 +246,7 @@ catalogue_of_life <- list( @@ -242,7 +246,7 @@ catalogue_of_life <- list(
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "CLSI")$guideline)))`) and EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(rsi_translation, guideline %like% "EUCAST")$guideline)))`). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
#' @format A [data.frame] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
#' - `guideline`\cr Name of the guideline
#' - `method`\cr Either "MIC" or "DISK"
#' - `method`\cr Either `r vector_or(rsi_translation$method)`
#' - `site`\cr Body site, e.g. "Oral" or "Respiratory"
#' - `mo`\cr Microbial ID, see [as.mo()]
#' - `ab`\cr Antibiotic ID, see [as.ab()]

33
R/ggplot_rsi.R

@ -100,11 +100,20 @@ @@ -100,11 +100,20 @@
#' size = 1,
#' linetype = 2,
#' alpha = 0.25)
#'
#'
#' # you can alter the colours with colour names:
#' example_isolates %>%
#' select(AMX) %>%
#' ggplot_rsi(colours = c(SI = "yellow"))
#'
#'
#' # but you can also use the built-in colour-blind friendly colours for
#' # your plots, where "S" is green, "I" is yellow and "R" is red:
#' data.frame(x = c("Value1", "Value2", "Value3"),
#' y = c(1, 2, 3),
#' z = c("Value4", "Value5", "Value6")) %>%
#' ggplot() +
#' geom_col(aes(x = x, y = y, fill = z)) +
#' scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R")
#' }
#'
#' \donttest{
@ -360,7 +369,7 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) { @@ -360,7 +369,7 @@ scale_y_percent <- function(breaks = seq(0, 1, 0.1), limits = NULL) {
scale_rsi_colours <- function(...,
aesthetics = "fill") {
stop_ifnot_installed("ggplot2")
meet_criteria(aesthetics, allow_class = c("character"), has_length = c(1, 2), is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
meet_criteria(aesthetics, allow_class = "character", is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
# behaviour until AMR pkg v1.5.0 and also when coming from ggplot_rsi()
if ("colours" %in% names(list(...))) {
@ -376,14 +385,16 @@ scale_rsi_colours <- function(..., @@ -376,14 +385,16 @@ scale_rsi_colours <- function(...,
return(invisible())
}
names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible",
unique(translations_file[which(translations_file$pattern == "susceptible"),
names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible",
unique(translations_file[which(translations_file$pattern == "Susceptible"),
"replacement", drop = TRUE]))
names_incr_exposure <- c("I", "intermediate", "increased exposure", "incr. exposure",
unique(translations_file[which(translations_file$pattern == "intermediate"),
names_incr_exposure <- c("I", "intermediate", "increased exposure", "incr. exposure", "Increased exposure", "Incr. exposure",
unique(translations_file[which(translations_file$pattern == "Intermediate"),
"replacement", drop = TRUE]),
unique(translations_file[which(translations_file$pattern == "Incr. exposure"),
"replacement", drop = TRUE]))
names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant",
unique(translations_file[which(translations_file$pattern == "resistant"),
names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant",
unique(translations_file[which(translations_file$pattern == "Resistant"),
"replacement", drop = TRUE]))
susceptible <- rep("#3CAEA3", length(names_susceptible))
@ -399,8 +410,8 @@ scale_rsi_colours <- function(..., @@ -399,8 +410,8 @@ scale_rsi_colours <- function(...,
dots[dots == "S"] <- "#3CAEA3"
dots[dots == "I"] <- "#F6D55C"
dots[dots == "R"] <- "#ED553B"
colours <- replace(original_cols, names(dots), dots)
ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = colours)
cols <- replace(original_cols, names(dots), dots)
ggplot2::scale_discrete_manual(aesthetics = aesthetics, values = cols)
}
#' @rdname ggplot_rsi

13
R/like.R

@ -100,13 +100,12 @@ like <- function(x, pattern, ignore.case = TRUE) { @@ -100,13 +100,12 @@ like <- function(x, pattern, ignore.case = TRUE) {
} else if (length(pattern) != length(x)) {
stop_("arguments `x` and `pattern` must be of same length, or either one must be 1")
}
mapply(FUN = grepl,
pattern,
x,
MoreArgs = list(ignore.case = FALSE, fixed = fixed, perl = !fixed),
SIMPLIFY = TRUE,
USE.NAMES = FALSE)
unlist(
Map(f = grepl,
pattern,
x,
MoreArgs = list(ignore.case = FALSE, fixed = fixed, perl = !fixed)),
use.names = FALSE)
}
}

28
R/mo.R

@ -463,16 +463,22 @@ exec_as.mo <- function(x, @@ -463,16 +463,22 @@ exec_as.mo <- function(x,
# translate 'unknown' names back to English
if (any(x %like% "unbekannt|onbekend|desconocid|sconosciut|iconnu|desconhecid", na.rm = TRUE)) {
trns <- subset(translations_file, pattern %like% "unknown" | affect_mo_name == TRUE)
lapply(seq_len(nrow(trns)),
function(i) x <<- gsub(pattern = trns$replacement[i],
replacement = trns$pattern[i],
x = x,
ignore.case = TRUE,
perl = TRUE))
langs <- LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]
for (l in langs) {
for (i in seq_len(nrow(trns))) {
if (!is.na(trns[i, l, drop = TRUE])) {
x <- gsub(pattern = trns[i, l, drop = TRUE],
replacement = trns$pattern[i],
x = x,
ignore.case = TRUE,
perl = TRUE)
}
}
}
}
x_backup <- x
# from here on case-insensitive
x <- tolower(x)
@ -1551,6 +1557,9 @@ exec_as.mo <- function(x, @@ -1551,6 +1557,9 @@ exec_as.mo <- function(x,
if (property == "mo") {
x <- set_clean_class(x, new_class = c("mo", "character"))
}
# keep track of time
end_time <- Sys.time()
if (length(mo_renamed()) > 0) {
print(mo_renamed())
@ -1571,10 +1580,9 @@ exec_as.mo <- function(x, @@ -1571,10 +1580,9 @@ exec_as.mo <- function(x,
x <- structure(x, uncertainties = uncertainties)
} else {
# keep track of time - give some hints to improve speed if it takes a long time
end_time <- Sys.time()
delta_time <- difftime(end_time, start_time, units = "secs")
if (delta_time >= 30) {
message_("Using `as.mo()` took ", delta_time, " seconds, which is a long time. Some suggestions to improve speed include:")
message_("Using `as.mo()` took ", round(delta_time), " seconds, which is a long time. Some suggestions to improve speed include:")
message_(word_wrap("- Try to use as many valid taxonomic names as possible for your input.",
extra_indent = 2),
as_note = FALSE)
@ -1922,7 +1930,7 @@ print.mo_renamed <- function(x, ...) { @@ -1922,7 +1930,7 @@ print.mo_renamed <- function(x, ...) {
"",
paste0(" (", gsub("et al.", font_italic("et al."), x$old_ref[i]), ")")),
" was renamed ",
ifelse(as.integer(gsub("[^0-9]", "", x$new_ref[i])) < as.integer(gsub("[^0-9]", "", x$old_ref[i])),
ifelse(!x$new_ref[i] %in% c("", NA) && as.integer(gsub("[^0-9]", "", x$new_ref[i])) < as.integer(gsub("[^0-9]", "", x$old_ref[i])),
font_bold("back to "),
""),
font_italic(x$new_name[i]),

16
R/mo_property.R

@ -660,10 +660,20 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) { @@ -660,10 +660,20 @@ mo_url <- function(x, open = FALSE, language = get_locale(), ...) {
pm_left_join(pm_select(microorganisms, mo, source, species_id), by = "mo")
df$url <- ifelse(df$source == "CoL",
paste0(catalogue_of_life$url_CoL, "details/species/id/", df$species_id, "/"),
ifelse(df$source == "DSMZ",
paste0(catalogue_of_life$url_DSMZ, "/advanced_search?adv[taxon-name]=", gsub(" ", "+", mo_names), "/"),
NA_character_))
NA_character_)
u <- df$url
u[mo_kingdom(mo) == "Bacteria"] <- paste0(catalogue_of_life$url_LPSN, "/species/", gsub(" ", "-", tolower(mo_names), fixed = TRUE))
u[mo_kingdom(mo) == "Bacteria" & mo_rank(mo) == "genus"] <- gsub("/species/",
"/genus/",
u[mo_kingdom(mo) == "Bacteria" & mo_rank(mo) == "genus"],
fixed = TRUE)
u[mo_kingdom(mo) == "Bacteria" &
mo_rank(mo) %in% c("subsp.", "infraspecies")] <- gsub("/species/",
"/subspecies/",
u[mo_kingdom(mo) == "Bacteria" &
mo_rank(mo) %in% c("subsp.", "infraspecies")],
fixed = TRUE)
names(u) <- mo_names
if (open == TRUE) {

113
R/plot.R

@ -36,6 +36,7 @@ @@ -36,6 +36,7 @@
#' @param ab any (vector of) text that can be coerced to a valid antimicrobial code with [as.ab()]
#' @param guideline interpretation guideline to use, defaults to the latest included EUCAST guideline, see *Details*
#' @param colours_RSI colours to use for filling in the bars, must be a vector of three values (in the order R, S and I). The default colours are colour-blind friendly.
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant', defaults to system language (see [get_locale()]) and can be overwritten by setting the option `AMR_locale`, e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
#' @param expand logical to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.
#' @details
#' The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
@ -79,15 +80,19 @@ plot.mic <- function(x, @@ -79,15 +80,19 @@ plot.mic <- function(x,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character")
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_RSI) == 1) {
colours_RSI <- rep(colours_RSI, 3)
}
@ -101,6 +106,7 @@ plot.mic <- function(x, @@ -101,6 +106,7 @@ plot.mic <- function(x,
guideline = guideline,
colours_RSI = colours_RSI,
fn = as.mic,
language = language,
...)
barplot(x,
@ -132,7 +138,7 @@ plot.mic <- function(x, @@ -132,7 +138,7 @@ plot.mic <- function(x,
}
legend("top",
x.intersp = 0.5,
legend = legend_txt,
legend = translate_AMR(legend_txt, language = language),
fill = legend_col,
horiz = TRUE,
cex = 0.75,
@ -152,15 +158,19 @@ barplot.mic <- function(height, @@ -152,15 +158,19 @@ barplot.mic <- function(height,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character")
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
main <- gsub(" +", " ", paste0(main, collapse = " "))
plot(x = height,
@ -186,18 +196,26 @@ ggplot.mic <- function(data, @@ -186,18 +196,26 @@ ggplot.mic <- function(data,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(title, allow_class = "character")
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
title <- gsub(" +", " ", paste0(title, collapse = " "))
if ("main" %in% names(list(...))) {
title <- list(...)$main
}
if (!is.null(title)) {
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
x <- plot_prepare_table(data, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(x = x,
@ -206,6 +224,7 @@ ggplot.mic <- function(data, @@ -206,6 +224,7 @@ ggplot.mic <- function(data,
guideline = guideline,
colours_RSI = colours_RSI,
fn = as.mic,
language = language,
...)
df <- as.data.frame(x, stringsAsFactors = TRUE)
colnames(df) <- c("mic", "count")
@ -213,8 +232,9 @@ ggplot.mic <- function(data, @@ -213,8 +232,9 @@ ggplot.mic <- function(data,
df$cols[df$cols == colours_RSI[1]] <- "Resistant"
df$cols[df$cols == colours_RSI[2]] <- "Susceptible"
df$cols[df$cols == colours_RSI[3]] <- plot_name_of_I(cols_sub$guideline)
df$cols <- factor(df$cols,
levels = c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
df$cols <- factor(translate_AMR(df$cols, language = language),
levels = translate_AMR(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
language = language),
ordered = TRUE)
if (!is.null(mapping)) {
p <- ggplot2::ggplot(df, mapping = mapping)
@ -223,12 +243,14 @@ ggplot.mic <- function(data, @@ -223,12 +243,14 @@ ggplot.mic <- function(data,
}
if (any(colours_RSI %in% cols_sub$cols)) {
vals <- c("Resistant" = colours_RSI[1],
"Susceptible" = colours_RSI[2],
"Incr. exposure" = colours_RSI[3],
"Intermediate" = colours_RSI[3])
names(vals) <- translate_AMR(names(vals), language = language)
p <- p +
ggplot2::geom_col(ggplot2::aes(x = mic, y = count, fill = cols)) +
ggplot2::scale_fill_manual(values = c("Resistant" = colours_RSI[1],
"Susceptible" = colours_RSI[2],
"Incr. exposure" = colours_RSI[3],
"Intermediate" = colours_RSI[3]),
ggplot2::scale_fill_manual(values = vals,
name = NULL)
} else {
p <- p +
@ -252,15 +274,19 @@ plot.disk <- function(x, @@ -252,15 +274,19 @@ plot.disk <- function(x,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character")
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_RSI) == 1) {
colours_RSI <- rep(colours_RSI, 3)
}
@ -274,6 +300,7 @@ plot.disk <- function(x, @@ -274,6 +300,7 @@ plot.disk <- function(x,
guideline = guideline,
colours_RSI = colours_RSI,
fn = as.disk,
language = language,
...)
barplot(x,
@ -305,7 +332,7 @@ plot.disk <- function(x, @@ -305,7 +332,7 @@ plot.disk <- function(x,
}
legend("top",
x.intersp = 0.5,
legend = legend_txt,
legend = translate_AMR(legend_txt, language = language),
fill = legend_col,
horiz = TRUE,
cex = 0.75,
@ -325,15 +352,18 @@ barplot.disk <- function(height, @@ -325,15 +352,18 @@ barplot.disk <- function(height,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
meet_criteria(main, allow_class = "character")
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
main <- gsub(" +", " ", paste0(main, collapse = " "))
@ -360,18 +390,26 @@ ggplot.disk <- function(data, @@ -360,18 +390,26 @@ ggplot.disk <- function(data,
ab = NULL,
guideline = "EUCAST",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(title, allow_class = "character")
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
meet_criteria(guideline, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
title <- gsub(" +", " ", paste0(title, collapse = " "))
if ("main" %in% names(list(...))) {
title <- list(...)$main
}
if (!is.null(title)) {
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
x <- plot_prepare_table(data, expand = expand)
cols_sub <- plot_colours_subtitle_guideline(x = x,
@ -380,15 +418,18 @@ ggplot.disk <- function(data, @@ -380,15 +418,18 @@ ggplot.disk <- function(data,
guideline = guideline,
colours_RSI = colours_RSI,
fn = as.disk,
language = language,
...)
df <- as.data.frame(x, stringsAsFactors = TRUE)
colnames(df) <- c("disk", "count")
df$cols <- cols_sub$cols
df$cols[df$cols == colours_RSI[1]] <- "Resistant"
df$cols[df$cols == colours_RSI[2]] <- "Susceptible"
df$cols[df$cols == colours_RSI[3]] <- plot_name_of_I(cols_sub$guideline)
df$cols <- factor(df$cols,
levels = c("Resistant", plot_name_of_I(cols_sub$guideline), "Susceptible"),
df$cols <- factor(translate_AMR(df$cols, language = language),
levels = translate_AMR(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
language = language),
ordered = TRUE)
if (!is.null(mapping)) {
p <- ggplot2::ggplot(df, mapping = mapping)
@ -397,12 +438,14 @@ ggplot.disk <- function(data, @@ -397,12 +438,14 @@ ggplot.disk <- function(data,
}
if (any(colours_RSI %in% cols_sub$cols)) {
vals <- c("Resistant" = colours_RSI[1],
"Susceptible" = colours_RSI[2],
"Incr. exposure" = colours_RSI[3],
"Intermediate" = colours_RSI[3])
names(vals) <- translate_AMR(names(vals), language = language)
p <- p +
ggplot2::geom_col(ggplot2::aes(x = disk, y = count, fill = cols)) +
ggplot2::scale_fill_manual(values = c("Resistant" = colours_RSI[1],
"Susceptible" = colours_RSI[2],
"Incr. exposure" = colours_RSI[3],
"Intermediate" = colours_RSI[3]),
ggplot2::scale_fill_manual(values = vals,
name = NULL)
} else {
p <- p +
@ -457,7 +500,7 @@ plot_name_of_I <- function(guideline) { @@ -457,7 +500,7 @@ plot_name_of_I <- function(guideline) {
}
}
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, fn, ...) {
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, fn, language, ...) {
guideline <- get_guideline(guideline, AMR::rsi_translation)
if (!is.null(mo) && !is.null(ab)) {
# interpret and give colour based on MIC values
@ -469,14 +512,14 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, f @@ -469,14 +512,14 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, f
cols[rsi == "R"] <- colours_RSI[1]
cols[rsi == "S"] <- colours_RSI[2]
cols[rsi == "I"] <- colours_RSI[3]
moname <- mo_name(mo, language = NULL)
abname <- ab_name(ab, language = NULL)
moname <- mo_name(mo, language = language)
abname <- ab_name(ab, language = language)
if (all(cols == "#BEBEBE")) {
message_("No ", guideline, " interpretations found for ",
ab_name(ab, language = NULL, tolower = TRUE), " in ", moname)
guideline_txt <- ""
} else {
guideline_txt <- paste0("(following ", guideline, ")")
guideline_txt <- paste0("(", guideline, ")")
}
sub <- bquote(.(abname)~"in"~italic(.(moname))~.(guideline_txt))
} else {
@ -498,7 +541,7 @@ plot.rsi <- function(x, @@ -498,7 +541,7 @@ plot.rsi <- function(x,
...) {
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
data <- as.data.frame(table(x), stringsAsFactors = FALSE)
colnames(data) <- c("x", "n")
@ -549,12 +592,16 @@ barplot.rsi <- function(height, @@ -549,12 +592,16 @@ barplot.rsi <- function(height,
xlab = "Antimicrobial Interpretation",
ylab = "Frequency",
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
language = get_locale(),
expand = TRUE,
...) {
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
meet_criteria(language, has_length = 1, is_in = c(LANGUAGES_SUPPORTED, ""), allow_NULL = TRUE, allow_NA = TRUE)
meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_RSI) == 1) {
colours_RSI <- rep(colours_RSI, 3)
}
@ -582,10 +629,18 @@ ggplot.rsi <- function(data, @@ -582,10 +629,18 @@ ggplot.rsi <- function(data,
colours_RSI = c("#ED553B", "#3CAEA3", "#F6D55C"),
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(title, allow_class = "character")
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(colours_RSI, allow_class = "character", has_length = c(1, 3))
if ("main" %in% names(list(...))) {
title <- list(...)$main
}
if (!is.null(title)) {
title <- gsub(" +", " ", paste0(title, collapse = " "))
}
if (length(colours_RSI) == 1) {
colours_RSI <- rep(colours_RSI, 3)
}

BIN
R/sysdata.rda

Binary file not shown.

19
R/translate.R

@ -142,7 +142,8 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a @@ -142,7 +142,8 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a
vector_or(LANGUAGES_SUPPORTED, quotes = TRUE),
call = FALSE)
df_trans <- subset(df_trans, lang == language)
# only keep lines where translation is available for this language
df_trans <- df_trans[which(!is.na(df_trans[, language, drop = TRUE])), , drop = FALSE]
if (only_unknown == TRUE) {
df_trans <- subset(df_trans, pattern %like% "unknown")
}
@ -150,10 +151,10 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a @@ -150,10 +151,10 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a
df_trans <- subset(df_trans, affect_mo_name == TRUE)
}
# default: case sensitive if value if 'ignore.case' is missing:
df_trans$ignore.case[is.na(df_trans$ignore.case)] <- FALSE
# default: not using regular expressions (fixed = TRUE) if 'fixed' is missing:
df_trans$fixed[is.na(df_trans$fixed)] <- TRUE
# default: case sensitive if value if 'case_sensitive' is missing:
df_trans$case_sensitive[is.na(df_trans$case_sensitive)] <- TRUE
# default: not using regular expressions if 'regular_expr' is missing:
df_trans$regular_expr[is.na(df_trans$regular_expr)] <- FALSE
# check if text to look for is in one of the patterns
any_form_in_patterns <- tryCatch(any(from_unique %like% paste0("(", paste(df_trans$pattern, collapse = "|"), ")")),
@ -167,11 +168,11 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a @@ -167,11 +168,11 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE, a
lapply(seq_len(nrow(df_trans)),
function(i) from_unique_translated <<- gsub(pattern = df_trans$pattern[i],
replacement = df_trans$replacement[i],
replacement = df_trans[i, language, drop = TRUE],
x = from_unique_translated,
ignore.case = df_trans$ignore.case[i],
fixed = df_trans$fixed[i],
perl = !df_trans$fixed[i]))
ignore.case = !df_trans$case_sensitive[i],
fixed = !df_trans$regular_expr[i],
perl = df_trans$regular_expr[i]))
# force UTF-8 for diacritics
from_unique_translated <- enc2utf8(from_unique_translated)

2
_pkgdown.yml

@ -143,7 +143,6 @@ reference: @@ -143,7 +143,6 @@ reference:
- "`as.mic`"
- "`as.disk`"
- "`eucast_rules`"
- "`plot`"
- "`isolate_identifier`"
- title: "Analysing data: antimicrobial resistance"
@ -159,6 +158,7 @@ reference: @@ -159,6 +158,7 @@ reference:
- "`key_antibiotics`"
- "`mdro`"
- "`count`"
- "`plot`"
- "`ggplot_rsi`"
- "`bug_drug_combinations`"
- "`antibiotic_class_selectors`"

BIN
data-raw/AMR_latest.tar.gz

Binary file not shown.

2
data-raw/_internals.R

@ -175,7 +175,7 @@ microorganisms.translation <- readRDS("data-raw/microorganisms.translation.rds") @@ -175,7 +175,7 @@ microorganisms.translation <- readRDS("data-raw/microorganisms.translation.rds")
INTRINSIC_R <- create_intr_resistance()
# for checking input in `language` argument in e.g. mo_*() and ab_*() functions
LANGUAGES_SUPPORTED <- sort(c("en", unique(translations_file$lang)))
LANGUAGES_SUPPORTED <- sort(c("en", colnames(translations_file)[nchar(colnames(translations_file)) == 2]))
# vectors of CoNS and CoPS, improves speed in as.mo()
MO_CONS <- create_species_cons_cops("CoNS")

BIN
data-raw/intrinsic_resistant.dta

Binary file not shown.

2
data-raw/intrinsic_resistant.md5

@ -1 +1 @@ @@ -1 +1 @@
b6de75043ef27eabd6fff22f04638225
9c58b2d894dbad7593cd44b78d04cd78

BIN
data-raw/intrinsic_resistant.rds

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sas

Binary file not shown.

BIN
data-raw/intrinsic_resistant.sav

Binary file not shown.

9898
data-raw/intrinsic_resistant.txt

File diff suppressed because it is too large Load Diff

BIN
data-raw/intrinsic_resistant.xlsx

Binary file not shown.

BIN
data-raw/microorganisms.dta

Binary file not shown.

BIN
data-raw/microorganisms.old.dta

Binary file not shown.

2
data-raw/microorganisms.old.md5

@ -1 +1 @@ @@ -1 +1 @@
617b59b8ac3bd1aad7847aafc328f0f3
8338ff5f079f4519fa3c44f8c5bace64

BIN
data-raw/microorganisms.old.rds

Binary file not shown.

BIN
data-raw/microorganisms.old.sas

Binary file not shown.

BIN
data-raw/microorganisms.old.sav

Binary file not shown.

3422
data-raw/microorganisms.old.txt

File diff suppressed because it is too large Load Diff

BIN
data-raw/microorganisms.old.xlsx

Binary file not shown.

BIN
data-raw/microorganisms.rds

Binary file not shown.

BIN
data-raw/microorganisms.sas

Binary file not shown.

BIN
data-raw/microorganisms.sav

Binary file not shown.

BIN
data-raw/microorganisms.translation.rds

Binary file not shown.

31794
data-raw/microorganisms.txt

File diff suppressed because it is too large Load Diff

BIN
data-raw/microorganisms.xlsx

Binary file not shown.

2
data-raw/mo.md5

@ -1 +1 @@ @@ -1 +1 @@
a5b85c5b3d37d6330865dfe09ef9b354
4eb2432919bb70629ef76e62e06da342

414
data-raw/reproduction_of_microorganisms_update.R

@ -0,0 +1,414 @@ @@ -0,0 +1,414 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
# (c) 2018-2021 Berends MS, Luz CF et al. #
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# Register at List of Prokaryotic names with Standing in Nomenclature (LPSN)
# then got to https://lpsn.dsmz.de/downloads and download the latest CSV file.
library(tidyverse)
library(AMR)
# these should still work after this update
test_fullname <- microorganisms$fullname
test_mo <- microorganisms$mo
# Helper functions --------------------------------------------------------
get_author_year <- function(ref) {
# Only keep first author, e.g. transform 'Smith, Jones, 2011' to 'Smith et al., 2011'
authors2 <- iconv(ref, from = "UTF-8", to = "ASCII//TRANSLIT")
authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " () ", authors2)
authors2 <- gsub(" [)(]+ $", "", authors2)
# remove leading and trailing brackets
authors2 <- trimws(gsub("^[(](.*)[)]$", "\\1", authors2))
# only take part after brackets if there's a name
authors2 <- ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2),
gsub(".*[)] (.*)", "\\1", authors2),
authors2)
# get year from last 4 digits
lastyear = as.integer(gsub(".*([0-9]{4})$", "\\1", authors2))
# can never be later than now
lastyear = ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")),
NA,
lastyear)
# get authors without last year
authors <- gsub("(.*)[0-9]{4}$", "\\1", authors2)
# remove nonsense characters from names
authors <- gsub("[^a-zA-Z,'& -]", "", authors)
# remove trailing and leading spaces
authors <- trimws(authors)
# only keep first author and replace all others by 'et al'
authors <- gsub("(,| and| et| &| ex| emend\\.?) .*", " et al.", authors)
# et al. always with ending dot
authors <- gsub(" et al\\.?", " et al.", authors)
authors <- gsub(" ?,$", "", authors)
# don't start with 'sensu' or 'ehrenb'
authors <- gsub("^(sensu|Ehrenb.?) ", "", authors, ignore.case = TRUE)
# no initials, only surname
authors <- gsub("^([A-Z]+ )+", "", authors, ignore.case = FALSE)
# combine author and year if year is available
ref <- ifelse(!is.na(lastyear),
paste0(authors, ", ", lastyear),
authors)
# fix beginning and ending
ref <- gsub(", $", "", ref)
ref <- gsub("^, ", "", ref)
ref <- gsub("^(emend|et al.,?)", "", ref)
ref <- trimws(ref)
ref <- gsub("'", "", ref)
# a lot start with a lowercase character - fix that
ref[!grepl("^d[A-Z]", ref)] <- gsub("^([a-z])", "\\U\\1", ref[!grepl("^d[A-Z]", ref)], perl = TRUE)
# specific one for the French that are named dOrbigny
ref[grepl("^d[A-Z]", ref)] <- gsub("^d", "d'", ref[grepl("^d[A-Z]", ref)])
ref <- gsub(" +", " ", ref)
ref
}
df_remove_nonASCII <- function(df) {
# Remove non-ASCII characters (these are not allowed by CRAN)
df %>%
mutate_if(is.character, iconv, from = "UTF-8", to = "ASCII//TRANSLIT") %>%
# also remove invalid characters
mutate_if(is.character, ~gsub("[\"'`]+", "", .)) %>%
AMR:::dataset_UTF8_to_ASCII()
}
abbreviate_mo <- function(x, minlength = 5, prefix = "", ...) {
# keep a starting Latin ae
suppressWarnings(
gsub("^ae", "\u00E6\u00E6", x, ignore.case = TRUE) %>%
abbreviate(minlength = minlength,
use.classes = TRUE,
method = "both.sides", ...) %>%
paste0(prefix, .) %>%
toupper() %>%
gsub("(\u00C6|\u00E6)+", "AE", .)
)
}
# Read data ---------------------------------------------------------------
taxonomy <- read_csv("~/Downloads/taxonomy.csv")
# Create synonyms ---------------------------------------------------------
new_synonyms <- taxonomy %>%
left_join(taxonomy,
by = c("record_lnk" = "record_no"),
suffix = c("", ".new")) %>%
filter(!is.na(record_lnk)) %>%
mutate_all(~ifelse(is.na(.), "", .)) %>%
transmute(fullname = trimws(paste(genus_name, sp_epithet, subsp_epithet)),
fullname_new = trimws(paste(genus_name.new, sp_epithet.new, subsp_epithet.new)),
ref = get_author_year(authors),
prevalence = 0) %>%
distinct(fullname, .keep_all = TRUE) %>%
filter(fullname != fullname_new) %>%
# this part joins this table to itself to correct for entries that had >1 renames,
# such as:
# Bacteroides tectum -> Bacteroides tectus
# Bacteroides tectus -> Bacteroides pyogenes
left_join(., .,
by = c("fullname_new" = "fullname"),
suffix = c("", ".2")) %>%
mutate(fullname_new = ifelse(!is.na(fullname_new.2), fullname_new.2, fullname_new),
ref = ifelse(!is.na(ref.2), ref.2, ref)) %>%
select(-ends_with(".2"))
mo_became_synonym <- microorganisms %>%
filter(fullname %in% new_synonyms$fullname)
updated_microorganisms <- taxonomy %>%
filter(is.na(record_lnk)) %>%
mutate_all(~ifelse(is.na(.), "", .)) %>%
transmute(mo = "",
fullname = trimws(paste(genus_name, sp_epithet, subsp_epithet)),
kingdom = "Bacteria",
phylum = "",
class = "",
order = "",
family = "",
genus = trimws(genus_name),
species = trimws(replace_na(sp_epithet, "")),
subspecies = trimws(replace_na(subsp_epithet, "")),
rank = case_when(subspecies == "" & species == "" ~ "genus",
subspecies == "" ~ "species",
TRUE ~ "subsp."),
ref = get_author_year(authors),
species_id = as.character(record_no),
source = "LSPN",
prevalence = 0,
snomed = NA)
new_microorganisms <- updated_microorganisms %>%
filter(!fullname %in% microorganisms$fullname)
genera_with_mo_code <- updated_microorganisms %>%
filter(genus %in% (microorganisms %>% filter(kingdom == "Bacteria", rank == "genus") %>% pull(genus))) %>%
distinct(genus) %>%
left_join(microorganisms %>% filter(kingdom == "Bacteria", rank == "genus") %>% select(mo, genus),
by = "genus")
genera_without_mo_code <- updated_microorganisms %>%
filter(!genus %in% genera_with_mo_code$genus) %>%
pull(genus) %>%
unique()
genera_without_mo_code_abbr <- genera_without_mo_code %>%
abbreviate_mo(5, prefix = "B_")
genera_without_mo_code_abbr[genera_without_mo_code_abbr %in% microorganisms$mo] <- abbreviate_mo(genera_without_mo_code[genera_without_mo_code_abbr %in% microorganisms$mo], 6, prefix = "B_")
genera_without_mo_code_abbr[genera_without_mo_code_abbr %in% microorganisms$mo] <- abbreviate_mo(genera_without_mo_code[genera_without_mo_code_abbr %in% microorganisms$mo], 7, prefix = "B_")
# all unique??
sum(genera_without_mo_code_abbr %in% microorganisms$mo) == 0
genus_abb <- tibble(genus = genera_without_mo_code,
abbr = genera_without_mo_code_abbr) %>%
bind_rows(microorganisms %>%
filter(kingdom == "Bacteria", rank == "genus", !genus %in% genera_without_mo_code) %>%
transmute(genus, abbr = as.character(mo))) %>%
arrange(genus)
# Update taxonomy ---------------------------------------------------------
# fill in the taxonomy of new genera
updated_taxonomy <- tibble(phylum = character(0),
class = character(0),
order = character(0),
family = character(0),
genus = character(0))
for (page in LETTERS) {
message("Downloading page ", page, "... ", appendLF = FALSE)
url <- paste0("https://lpsn.dsmz.de/genus?page=", page)
x <- xml2::read_html(url) %>%
rvest::html_node(".main-list") %>%
# evety list element with a set <id> attribute
rvest::html_nodes("li[id]")
for (i in seq_len(length(x))) {
txt <- x %>%
magrittr::extract2(i) %>%
rvest::html_text() %>%
gsub("\\[[A-Za-z]+, no [a-z]+\\]", "NA", .) %>%
gsub("Candidatus ", "", ., fixed = TRUE) %>%
gsub("[ \t\r\n\"]+", "|", .) %>%
gsub("\\|ShowHide.*", "", .) %>%
gsub("[\\[\\]]", "", ., fixed = TRUE) %>%
gsub("^\\|", "", .) %>%
strsplit("|", fixed = TRUE) %>%
unlist()
txt[txt == "NA"] <- ""
txt <- gsub("[^A-Za-z]+", "", txt)
updated_taxonomy <- updated_taxonomy %>%
bind_rows(tibble(phylum = txt[2],
class = txt[3],
order = txt[4],
family = txt[5],
genus = txt[6]))
}
message(length(x), " entries (total ", nrow(updated_taxonomy), ")")
}
# Create new microorganisms -----------------------------------------------
new_microorganisms <- new_microorganisms %>%
left_join(genus_abb, by = "genus") %>%
group_by(genus) %>%
mutate(species_abb = abbreviate_mo(species, 4)) %>%
group_by(genus, species) %>%
mutate(subspecies_abb = abbreviate_mo(subspecies, 4)) %>%
ungroup() %>%
mutate(mo = paste(abbr, species_abb, subspecies_abb, sep = "_"),
mo = gsub("_+$", "", mo)) %>%
select(-matches("abb"))
# add taxonomy new microorganisms
MOs <- microorganisms %>%
mutate(mo = as.character(mo)) %>%
bind_rows(new_microorganisms) %>%
arrange(fullname)
# unique MO codes
MOs$mo[which(duplicated(MOs$mo))] <- paste0(MOs$mo[which(duplicated(MOs$mo))], 1)
# all unique?
!any(duplicated(MOs$mo))
MOs <- MOs %>%
# remove entries that are now a synonym
filter(!fullname %in% new_synonyms$fullname) %>%
# update the taxonomy
left_join(updated_taxonomy, by = "genus", suffix = c("", ".new")) %>%
mutate(phylum = ifelse(!is.na(phylum.new), phylum.new, phylum),
class = ifelse(!is.na(class.new), class.new, class),
order = ifelse(!is.na(order.new), order.new, order),
family = ifelse(!is.na(family.new), family.new, family)) %>%
select(-ends_with(".new")) %>%
# update prevalence based on taxonomy (Berends et al., 2021)
mutate(prevalence = case_when(
class == "Gammaproteobacteria"
| genus %in% c("Enterococcus", "Staphylococcus", "Streptococcus")