Browse Source

(v1.6.0.9021) join functions update

main
parent
commit
29dbfa2f49
  1. 5
      DESCRIPTION
  2. 7
      NEWS.md
  3. 10
      R/aa_helper_functions.R
  4. 4
      R/ab.R
  5. 2
      R/ab_class_selectors.R
  6. 8
      R/ab_from_text.R
  7. 4
      R/ab_property.R
  8. 6
      R/age.R
  9. 2
      R/atc_online.R
  10. 10
      R/bug_drug_combinations.R
  11. 14
      R/data.R
  12. 2
      R/disk.R
  13. 20
      R/eucast_rules.R
  14. 2
      R/filter_ab_class.R
  15. 10
      R/first_isolate.R
  16. 4
      R/g.test.R
  17. 6
      R/ggplot_pca.R
  18. 4
      R/ggplot_rsi.R
  19. 4
      R/guess_ab_col.R
  20. 11
      R/italicise_taxonomy.R
  21. 225
      R/join_microorganisms.R
  22. 12
      R/key_antimicrobials.R
  23. 4
      R/kurtosis.R
  24. 4
      R/like.R
  25. 22
      R/mdro.R
  26. 25
      R/mic.R
  27. 16
      R/mo.R
  28. 2
      R/mo_property.R
  29. 8
      R/pca.R
  30. 4
      R/plot.R
  31. 10
      R/proportion.R
  32. 4
      R/random.R
  33. 8
      R/resistance_predict.R
  34. 32
      R/rsi.R
  35. 2
      R/skewness.R
  36. 11
      R/zzz.R
  37. BIN
      data-raw/AMR_latest.tar.gz
  38. 2
      docs/404.html
  39. 2
      docs/LICENSE-text.html
  40. 2
      docs/articles/index.html
  41. 2
      docs/authors.html
  42. 2
      docs/index.html
  43. 21
      docs/news/index.html
  44. 2
      docs/pkgdown.yml
  45. 44
      docs/reference/WHONET.html
  46. 10
      docs/reference/ab_from_text.html
  47. 42
      docs/reference/ab_property.html
  48. 42
      docs/reference/age.html
  49. 40
      docs/reference/age_groups.html
  50. 40
      docs/reference/antibiotic_class_selectors.html
  51. 6
      docs/reference/as.ab.html
  52. 40
      docs/reference/as.disk.html
  53. 50
      docs/reference/as.mic.html
  54. 8
      docs/reference/as.mo.html
  55. 70
      docs/reference/as.rsi.html
  56. 40
      docs/reference/atc_online.html
  57. 50
      docs/reference/bug_drug_combinations.html
  58. 44
      docs/reference/count.html
  59. 46
      docs/reference/eucast_rules.html
  60. 44
      docs/reference/example_isolates.html
  61. 40
      docs/reference/filter_ab_class.html
  62. 12
      docs/reference/first_isolate.html
  63. 42
      docs/reference/g.test.html
  64. 8
      docs/reference/ggplot_pca.html
  65. 48
      docs/reference/ggplot_rsi.html
  66. 42
      docs/reference/guess_ab_col.html
  67. 2
      docs/reference/index.html
  68. 13
      docs/reference/italicise_taxonomy.html
  69. 17
      docs/reference/join.html
  70. 12
      docs/reference/key_antimicrobials.html
  71. 42
      docs/reference/kurtosis.html
  72. 6
      docs/reference/like.html
  73. 10
      docs/reference/mdro.html
  74. 40
      docs/reference/mo_property.html
  75. 42
      docs/reference/pca.html
  76. 42
      docs/reference/plot.html
  77. 48
      docs/reference/proportion.html
  78. 6
      docs/reference/random.html
  79. 50
      docs/reference/resistance_predict.html
  80. 40
      docs/reference/rsi_translation.html
  81. 40
      docs/reference/skewness.html
  82. 2
      docs/survey.html
  83. 6
      man/WHONET.Rd
  84. 8
      man/ab_from_text.Rd
  85. 4
      man/ab_property.Rd
  86. 4
      man/age.Rd
  87. 2
      man/age_groups.Rd
  88. 2
      man/antibiotic_class_selectors.Rd
  89. 4
      man/as.ab.Rd
  90. 2
      man/as.disk.Rd
  91. 12
      man/as.mic.Rd
  92. 6
      man/as.mo.Rd
  93. 28
      man/as.rsi.Rd
  94. 2
      man/atc_online.Rd
  95. 12
      man/bug_drug_combinations.Rd
  96. 6
      man/count.Rd
  97. 8
      man/eucast_rules.Rd
  98. 6
      man/example_isolates.Rd
  99. 2
      man/filter_ab_class.Rd
  100. 10
      man/first_isolate.Rd
  101. Some files were not shown because too many files have changed in this diff Show More

5
DESCRIPTION

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
Package: AMR
Version: 1.6.0.9020
Date: 2021-05-06
Version: 1.6.0.9021
Date: 2021-05-12
Title: Antimicrobial Resistance Data Analysis
Authors@R: c(
person(role = c("aut", "cre"),
@ -46,6 +46,7 @@ Suggests: @@ -46,6 +46,7 @@ Suggests:
curl,
dplyr,
ggplot2,
ggtext,
knitr,
microbenchmark,
pillar,

7
NEWS.md

@ -1,5 +1,5 @@ @@ -1,5 +1,5 @@
# `AMR` 1.6.0.9020
## <small>Last updated: 6 May 2021</small>
# `AMR` 1.6.0.9021
## <small>Last updated: 12 May 2021</small>
### New
* Function `custom_eucast_rules()` that brings support for custom AMR rules in `eucast_rules()`
@ -37,6 +37,9 @@ @@ -37,6 +37,9 @@
* Added 25 common system codes for bacteria to the `microorganisms.codes` data set
* Added 16 common system codes for antimicrobial agents to the `antibiotics` data set
* Fix for using `skimr::skim()` on classes `mo`, `mic` and `disk` when using the just released `dplyr` v1.0.6
* Updated `skimr::skim()` usage for MIC values to also include 25th and 75th percentiles
* Fix for plotting missing MIC/disk diffusion values
* Updated join functions to always use `dplyr` join functions if the `dplyr` package is installed - now also preserving grouped variables
# `AMR` 1.6.0

10
R/aa_helper_functions.R

@ -321,9 +321,7 @@ word_wrap <- function(..., @@ -321,9 +321,7 @@ word_wrap <- function(...,
msg <- paste0(c(...), collapse = "")
if (isTRUE(as_note)) {
# \u2139 is a symbol officially named 'information source'
# \ufe0f can add the blue square around it: \u2139\ufe0f
msg <- paste0("\u2139 ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
msg <- paste0(pkg_env$info_icon, " ", gsub("^note:? ?", "", msg, ignore.case = TRUE))
}
if (msg %like% "\n") {
@ -539,7 +537,7 @@ vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE) { @@ -539,7 +537,7 @@ vector_and <- function(v, quotes = TRUE, reverse = FALSE, sort = TRUE) {
vector_or(v = v, quotes = quotes, reverse = reverse, sort = sort, last_sep = " and ")
}
format_class <- function(class, plural) {
format_class <- function(class, plural = FALSE) {
class.bak <- class
class[class == "numeric"] <- "number"
class[class == "integer"] <- "whole number"
@ -553,9 +551,7 @@ format_class <- function(class, plural) { @@ -553,9 +551,7 @@ format_class <- function(class, plural) {
ifelse(plural, "s", ""))
# exceptions
class[class == "logical"] <- ifelse(plural, "a vector of `TRUE`/`FALSE`", "`TRUE` or `FALSE`")
if ("data.frame" %in% class) {
class <- "a data set"
}
class[class == "data.frame"] <- "a data set"
if ("list" %in% class) {
class <- "a list"
}

4
R/ab.R

@ -27,8 +27,8 @@ @@ -27,8 +27,8 @@
#'
#' Use this function to determine the antibiotic code of one or more antibiotics. The data set [antibiotics] will be searched for abbreviations, official names and synonyms (brand names).
#' @inheritSection lifecycle Stable Lifecycle
#' @param x character vector to determine to antibiotic ID
#' @param flag_multiple_results logical to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
#' @param x a [character] vector to determine to antibiotic ID
#' @param flag_multiple_results a [logical] to indicate whether a note should be printed to the console that probably more than one antibiotic code or name can be retrieved from a single input value.
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
#' @param ... arguments passed on to internal functions
#' @rdname as.ab

2
R/ab_class_selectors.R

@ -27,7 +27,7 @@ @@ -27,7 +27,7 @@
#'
#' These functions help to select the columns of antibiotics that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
#' @inheritSection lifecycle Stable Lifecycle
#' @param only_rsi_columns a logical to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
#' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
#' @inheritParams filter_ab_class
#' @details \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
#'

8
R/ab_from_text.R

@ -29,17 +29,17 @@ @@ -29,17 +29,17 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param text text to analyse
#' @param type type of property to search for, either `"drug"`, `"dose"` or `"administration"`, see *Examples*
#' @param collapse character to pass on to `paste(, collapse = ...)` to only return one character per element of `text`, see *Examples*
#' @param collapse a [character] to pass on to `paste(, collapse = ...)` to only return one [character] per element of `text`, see *Examples*
#' @param translate_ab if `type = "drug"`: a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]. Defaults to `FALSE`. Using `TRUE` is equal to using "name".
#' @param thorough_search logical to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
#' @param info logical to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
#' @param thorough_search a [logical] to indicate whether the input must be extensively searched for misspelling and other faulty input values. Setting this to `TRUE` will take considerably more time than when using `FALSE`. At default, it will turn `TRUE` when all input elements contain a maximum of three words.
#' @param info a [logical] to indicate whether a progress bar should be printed, defaults to `TRUE` only in interactive mode
#' @param ... arguments passed on to [as.ab()]
#' @details This function is also internally used by [as.ab()], although it then only searches for the first drug name and will throw a note if more drug names could have been returned. Note: the [as.ab()] function may use very long regular expression to match brand names of antimicrobial agents. This may fail on some systems.
#'
#' ## Argument `type`
#' At default, the function will search for antimicrobial drug names. All text elements will be searched for official names, ATC codes and brand names. As it uses [as.ab()] internally, it will correct for misspelling.
#'
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for numeric values that are higher than 100 and do not resemble years. The output will be numeric. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
#' With `type = "dose"` (or similar, like "dosing", "doses"), all text elements will be searched for [numeric] values that are higher than 100 and do not resemble years. The output will be [numeric]. It supports any unit (g, mg, IE, etc.) and multiple values in one clinical text, see *Examples*.
#'
#' With `type = "administration"` (or abbreviations, like "admin", "adm"), all text elements will be searched for a form of drug administration. It supports the following forms (including common abbreviations): buccal, implant, inhalation, instillation, intravenous, nasal, oral, parenteral, rectal, sublingual, transdermal and vaginal. Abbreviations for oral (such as 'po', 'per os') will become "oral", all values for intravenous (such as 'iv', 'intraven') will become "iv". It supports multiple values in one clinical text, see *Examples*.
#'

4
R/ab_property.R

@ -28,11 +28,11 @@ @@ -28,11 +28,11 @@
#' Use these functions to return a specific property of an antibiotic from the [antibiotics] data set. All input values will be evaluated internally with [as.ab()].
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param tolower logical to indicate whether the first character of every output should be transformed to a lower case character. This will lead to e.g. "polymyxin B" and not "polymyxin b".
#' @param tolower a [logical] to indicate whether the first [character] of every output should be transformed to a lower case [character]. This will lead to e.g. "polymyxin B" and not "polymyxin b".
#' @param property one of the column names of one of the [antibiotics] data set
#' @param language language of the returned text, defaults to system language (see [get_locale()]) and can also be set with `getOption("AMR_locale")`. Use `language = NULL` or `language = ""` to prevent translation.
#' @param administration way of administration, either `"oral"` or `"iv"`
#' @param units a logical to indicate whether the units instead of the DDDs itself must be returned, see *Examples*
#' @param units a [logical] to indicate whether the units instead of the DDDs itself must be returned, see *Examples*
#' @param open browse the URL using [utils::browseURL()]
#' @param ... other arguments passed on to [as.ab()]
#' @details All output [will be translated][translate] where possible.

6
R/age.R

@ -29,8 +29,8 @@ @@ -29,8 +29,8 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param x date(s), will be coerced with [as.POSIXlt()]
#' @param reference reference date(s) (defaults to today), will be coerced with [as.POSIXlt()]
#' @param exact a logical to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
#' @param na.rm a logical to indicate whether missing values should be removed
#' @param exact a [logical] to indicate whether age calculation should be exact, i.e. with decimals. It divides the number of days of [year-to-date](https://en.wikipedia.org/wiki/Year-to-date) (YTD) of `x` by the number of days in the year of `reference` (either 365 or 366).
#' @param na.rm a [logical] to indicate whether missing values should be removed
#' @param ... arguments passed on to [as.POSIXlt()], such as `origin`
#' @details Ages below 0 will be returned as `NA` with a warning. Ages above 120 will only give a warning.
#' @return An [integer] (no decimals) if `exact = FALSE`, a [double] (with decimals) otherwise
@ -105,7 +105,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) { @@ -105,7 +105,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
#' @param na.rm a [logical] to indicate whether missing values should be removed
#' @details To split ages, the input for the `split_at` argument can be:
#'
#' * A numeric vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
#' * A [numeric] vector. A value of e.g. `c(10, 20)` will split `x` on 0-9, 10-19 and 20+. A value of only `50` will split `x` on 0-49 and 50+.
#' The default is to split on young children (0-11), youth (12-24), young adults (25-54), middle-aged adults (55-74) and elderly (75+).
#' * A character:
#' - `"children"` or `"kids"`, equivalent of: `c(0, 1, 2, 4, 6, 13, 18)`. This will split on 0, 1, 2-3, 4-5, 6-12, 13-17 and 18+.

2
R/atc_online.R

@ -27,7 +27,7 @@ @@ -27,7 +27,7 @@
#'
#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic), such as the name, defined daily dose (DDD) or standard unit.
#' @inheritSection lifecycle Stable Lifecycle
#' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
#' @param atc_code a [character] or [character] vector with ATC code(s) of antibiotic(s)
#' @param property property of an ATC code. Valid values are `"ATC"`, `"Name"`, `"DDD"`, `"U"` (`"unit"`), `"Adm.R"`, `"Note"` and `groups`. For this last option, all hierarchical groups of an ATC code will be returned, see *Examples*.
#' @param administration type of administration when using `property = "Adm.R"`, see *Details*
#' @param url url of website of the WHOCC. The sign `%s` can be used as a placeholder for ATC codes.

10
R/bug_drug_combinations.R

@ -28,11 +28,11 @@ @@ -28,11 +28,11 @@
#' Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use [format()] on the result to prettify it to a publicable/printable format, see *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @inheritParams eucast_rules
#' @param combine_IR logical to indicate whether values R and I should be summed
#' @param add_ab_group logical to indicate where the group of the antimicrobials must be included as a first column
#' @param remove_intrinsic_resistant logical to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
#' @param FUN function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
#' @param translate_ab character of length 1 containing column names of the [antibiotics] data set
#' @param combine_IR a [logical] to indicate whether values R and I should be summed
#' @param add_ab_group a [logical] to indicate where the group of the antimicrobials must be included as a first column
#' @param remove_intrinsic_resistant [logical] to indicate that rows and columns with 100% resistance for all tested antimicrobials must be removed from the table
#' @param FUN the function to call on the `mo` column to transform the microorganism IDs, defaults to [mo_shortname()]
#' @param translate_ab a [character] of length 1 containing column names of the [antibiotics] data set
#' @param ... arguments passed on to `FUN`
#' @inheritParams rsi_df
#' @inheritParams base::formatC

14
R/data.R

@ -178,9 +178,9 @@ @@ -178,9 +178,9 @@
#' @format A [data.frame] with `r format(nrow(example_isolates), big.mark = ",")` observations and `r ncol(example_isolates)` variables:
#' - `date`\cr date of receipt at the laboratory
#' - `hospital_id`\cr ID of the hospital, from A to D
#' - `ward_icu`\cr logical to determine if ward is an intensive care unit
#' - `ward_clinical`\cr logical to determine if ward is a regular clinical ward
#' - `ward_outpatient`\cr logical to determine if ward is an outpatient clinic
#' - `ward_icu`\cr [logical] to determine if ward is an intensive care unit
#' - `ward_clinical`\cr [logical] to determine if ward is a regular clinical ward
#' - `ward_outpatient`\cr [logical] to determine if ward is an outpatient clinic
#' - `age`\cr age of the patient
#' - `gender`\cr gender of the patient
#' - `patient_id`\cr ID of the patient
@ -217,8 +217,8 @@ @@ -217,8 +217,8 @@
#' - `Sex`\cr Fictitious gender of patient
#' - `Age`\cr Fictitious age of patient
#' - `Age category`\cr Age group, can also be looked up using [age_groups()]
#' - `Date of admission`\cr Date of hospital admission
#' - `Specimen date`\cr Date when specimen was received at laboratory
#' - `Date of admission`\cr [Date] of hospital admission
#' - `Specimen date`\cr [Date] when specimen was received at laboratory
#' - `Specimen type`\cr Specimen type or group
#' - `Specimen type (Numeric)`\cr Translation of `"Specimen type"`
#' - `Reason`\cr Reason of request with Differential Diagnosis
@ -231,7 +231,7 @@ @@ -231,7 +231,7 @@
#' - `MRSA screening test`\cr Microorganism is possible MRSA?
#' - `Inducible clindamycin resistance`\cr Clindamycin can be induced?
#' - `Comment`\cr Other comments
#' - `Date of data entry`\cr Date this data was entered in WHONET
#' - `Date of data entry`\cr [Date] this data was entered in WHONET
#' - `AMP_ND10:CIP_EE`\cr `r sum(vapply(FUN.VALUE = logical(1), WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()].
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!
@ -250,7 +250,7 @@ @@ -250,7 +250,7 @@
#' - `disk_dose`\cr Dose of the used disk diffusion method
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
#' - `uti`\cr A logical value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' - `uti`\cr A [logical] value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
#' @details The repository of this `AMR` package contains a file comprising this exact data set: <https://github.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt>. This file **allows for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. The file is updated automatically.
#' @inheritSection AMR Reference Data Publicly Available
#' @inheritSection AMR Read more on Our Website!

2
R/disk.R

@ -29,7 +29,7 @@ @@ -29,7 +29,7 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.disk
#' @param x vector
#' @param na.rm a logical indicating whether missing values should be removed
#' @param na.rm a [logical] indicating whether missing values should be removed
#' @details Interpret disk values as RSI values with [as.rsi()]. It supports guidelines from EUCAST and CLSI.
#' @return An [integer] with additional class [`disk`]
#' @aliases disk

20
R/eucast_rules.R

@ -50,16 +50,16 @@ format_eucast_version_nr <- function(version, markdown = TRUE) { @@ -50,16 +50,16 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
#' To improve the interpretation of the antibiogram before EUCAST rules are applied, some non-EUCAST rules can applied at default, see *Details*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x data with antibiotic columns, such as `amox`, `AMX` and `AMC`
#' @param info a logical to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions
#' @param rules a character vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
#' @param info a [logical] to indicate whether progress should be printed to the console, defaults to only print while in interactive sessions
#' @param rules a [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expert")`. The default value can be set to another value, e.g. using `options(AMR_eucastrules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
#' @param version_breakpoints the version number to use for the EUCAST Clinical Breakpoints guideline. Can be either `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), reverse = TRUE)`.
#' @param version_expertrules the version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be either `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), reverse = TRUE)`.
#' @param ampc_cephalosporin_resistance a character value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three agents. A value of `NA` (the default) for this argument will remove results for these three agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` or `FALSE` to not alter results for these three agents of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
#' @param ampc_cephalosporin_resistance a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants, defaults to `NA`. Currently only works when `version_expertrules` is `3.2`; '*EUCAST Expert Rules v3.2 on Enterobacterales*' states that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three agents. A value of `NA` (the default) for this argument will remove results for these three agents, while e.g. a value of `"R"` will make the results for these agents resistant. Use `NULL` or `FALSE` to not alter results for these three agents of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(eucast_rules_file[which(eucast_rules_file$reference.version == 3.2 & eucast_rules_file$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
#' @param ... column name of an antibiotic, see section *Antibiotics* below
#' @param ab any (vector of) text that can be coerced to a valid antibiotic code with [as.ab()]
#' @param administration route of administration, either `r vector_or(dosage$administration)`
#' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param custom_rules custom rules to apply, created with [custom_eucast_rules()]
#' @inheritParams first_isolate
#' @details
@ -398,7 +398,7 @@ eucast_rules <- function(x, @@ -398,7 +398,7 @@ eucast_rules <- function(x,
paste0(x, collapse = "")
})
# save original table, with the new .rowid column
# save original [table], with the new .rowid column
x.bak <- x
# keep only unique rows for MO and ABx
x <- x %pm>%
@ -902,9 +902,9 @@ eucast_rules <- function(x, @@ -902,9 +902,9 @@ eucast_rules <- function(x,
cat(paste0(font_grey(strrep("-", 0.95 * options()$width)), "\n"))
if (verbose == FALSE & total_n_added + total_n_changed > 0) {
cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a data.frame with all specified edits instead."), "\n\n", sep = "")
cat("\n", word_wrap("Use ", font_bold("eucast_rules(..., verbose = TRUE)"), " (on your original data) to get a [data.frame] with all specified edits instead."), "\n\n", sep = "")
} else if (verbose == TRUE) {
cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a data.frame with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "")
cat("\n", word_wrap("Used 'Verbose mode' (", font_bold("verbose = TRUE"), "), which returns a [data.frame] with all specified edits.\nUse ", font_bold("verbose = FALSE"), " to apply the rules on your data."), "\n\n", sep = "")
}
}
@ -936,7 +936,7 @@ eucast_rules <- function(x, @@ -936,7 +936,7 @@ eucast_rules <- function(x,
}
}
# helper function for editing the table ----
# helper function for editing the [table] ----
edit_rsi <- function(x,
to,
rule,
@ -975,14 +975,14 @@ edit_rsi <- function(x, @@ -975,14 +975,14 @@ edit_rsi <- function(x,
# insert into original table
new_edits[rows, cols] <- to,
warning = function(w) {
if (w$message %like% "invalid factor level") {
if (w$message %like% "invalid [factor] level") {
xyz <- vapply(FUN.VALUE = logical(1), cols, function(col) {
new_edits[, col] <<- factor(x = as.character(pm_pull(new_edits, col)),
levels = unique(c(to, levels(pm_pull(new_edits, col)))))
TRUE
})
suppressWarnings(new_edits[rows, cols] <<- to)
warning_('Value "', to, '" added to the factor levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing factor level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE)
warning_('Value "', to, '" added to the [factor] levels of column(s) `', paste(cols, collapse = "`, `"), "` because this value was not an existing [factor] level. A better way is to use as.rsi() on beforehand on antimicrobial columns to guarantee the right structure.", call = FALSE)
txt_warning()
warned <- FALSE
} else {

2
R/filter_ab_class.R

@ -31,7 +31,7 @@ @@ -31,7 +31,7 @@
#' @param ab_class an antimicrobial class, like `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
#' @param result an antibiotic result: S, I or R (or a combination of more of them)
#' @param scope the scope to check which variables to check, can be `"any"` (default) or `"all"`
#' @param only_rsi_columns a logical to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param ... arguments passed on to [filter_ab_class()]
#' @details All columns of `x` will be searched for known antibiotic names, abbreviations, brand names and codes (ATC, EARS-Net, WHO, etc.). This means that a filter function like e.g. [filter_aminoglycosides()] will include column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
#' @rdname filter_ab_class

10
R/first_isolate.R

@ -36,16 +36,16 @@ @@ -36,16 +36,16 @@
#' @param col_icu column name of the logicals (`TRUE`/`FALSE`) whether a ward or department is an Intensive Care Unit (ICU)
#' @param col_keyantimicrobials (only useful when `method = "phenotype-based"`) column name of the key antimicrobials to determine first (weighted) isolates, see [key_antimicrobials()]. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' or 'antimicrobials' (case insensitive). Use `col_keyantimicrobials = FALSE` to prevent this. Can also be the output of [key_antimicrobials()].
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see *Source*.
#' @param testcodes_exclude character vector with test codes that should be excluded (case-insensitive)
#' @param icu_exclude logical to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
#' @param testcodes_exclude a [character] vector with test codes that should be excluded (case-insensitive)
#' @param icu_exclude a [logical] to indicate whether ICU isolates should be excluded (rows with value `TRUE` in the column set with `col_icu`)
#' @param specimen_group value in the column set with `col_specimen` to filter on
#' @param type type to determine weighed isolates; can be `"keyantimicrobials"` or `"points"`, see *Details*
#' @param method the method to apply, either `"phenotype-based"`, `"episode-based"`, `"patient-based"` or `"isolate-based"` (can be abbreviated), see *Details*. The default is `"phenotype-based"` if antimicrobial test results are present in the data, and `"episode-based"` otherwise.
#' @param ignore_I logical to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*
#' @param ignore_I [logical] to indicate whether antibiotic interpretations with `"I"` will be ignored when `type = "keyantimicrobials"`, see *Details*
#' @param points_threshold minimum number of points to require before differences in the antibiogram will lead to inclusion of an isolate when `type = "points"`, see *Details*
#' @param info a [logical] to indicate info should be printed, defaults to `TRUE` only in interactive mode
#' @param include_unknown logical to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
#' @param include_untested_rsi logical to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
#' @param include_unknown a [logical] to indicate whether 'unknown' microorganisms should be included too, i.e. microbial code `"UNKNOWN"`, which defaults to `FALSE`. For WHONET users, this means that all records with organism code `"con"` (*contamination*) will be excluded at default. Isolates with a microbial ID of `NA` will always be excluded as first isolate.
#' @param include_untested_rsi a [logical] to indicate whether also rows without antibiotic results are still eligible for becoming a first isolate. Use `include_untested_rsi = FALSE` to always return `FALSE` for such rows. This checks the data set for columns of class `<rsi>` and consequently requires transforming columns with antibiotic results using [as.rsi()] first.
#' @param ... arguments passed on to [first_isolate()] when using [filter_first_isolate()], otherwise arguments passed on to [key_antimicrobials()] (such as `universal`, `gram_negative`, `gram_positive`)
#' @details
#' To conduct epidemiological analyses on antimicrobial resistance data, only so-called first isolates should be included to prevent overestimation and underestimation of antimicrobial resistance. Different methods can be used to do so, see below.

4
R/g.test.R

@ -28,9 +28,9 @@ @@ -28,9 +28,9 @@
#' [g.test()] performs chi-squared contingency table tests and goodness-of-fit tests, just like [chisq.test()] but is more reliable (1). A *G*-test can be used to see whether the number of observations in each category fits a theoretical expectation (called a ***G*-test of goodness-of-fit**), or to see whether the proportions of one variable are different for different values of the other variable (called a ***G*-test of independence**).
#' @inheritSection lifecycle Questioning Lifecycle
#' @inherit stats::chisq.test params return
#' @details If `x` is a matrix with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
#' @details If `x` is a [matrix] with one row or column, or if `x` is a vector and `y` is not given, then a *goodness-of-fit test* is performed (`x` is treated as a one-dimensional contingency table). The entries of `x` must be non-negative integers. In this case, the hypothesis tested is whether the population probabilities equal those in `p`, or are all equal if `p` is not given.
#'
#' If `x` is a matrix with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
#' If `x` is a [matrix] with at least two rows and columns, it is taken as a two-dimensional contingency table: the entries of `x` must be non-negative integers. Otherwise, `x` and `y` must be vectors or factors of the same length; cases with missing values are removed, the objects are coerced to factors, and the contingency table is computed from these. Then Pearson's chi-squared test is performed of the null hypothesis that the joint distribution of the cell counts in a 2-dimensional contingency table is the product of the row and column marginals.
#'
#' The p-value is computed from the asymptotic chi-squared distribution of the test statistic.
#'

6
R/ggplot_pca.R

@ -33,18 +33,18 @@ @@ -33,18 +33,18 @@
#' @param labels_textsize the size of the text used for the labels
#' @param labels_text_placement adjustment factor the placement of the variable names (`>=1` means further away from the arrow head)
#' @param groups an optional vector of groups for the labels, with the same length as `labels`. If set, the points and labels will be coloured according to these groups. When using the [pca()] function as input for `x`, this will be determined automatically based on the attribute `non_numeric_cols`, see [pca()].
#' @param ellipse a logical to indicate whether a normal data ellipse should be drawn for each group (set with `groups`)
#' @param ellipse a [logical] to indicate whether a normal data ellipse should be drawn for each group (set with `groups`)
#' @param ellipse_prob statistical size of the ellipse in normal probability
#' @param ellipse_size the size of the ellipse line
#' @param ellipse_alpha the alpha (transparency) of the ellipse line
#' @param points_size the size of the points
#' @param points_alpha the alpha (transparency) of the points
#' @param arrows a logical to indicate whether arrows should be drawn
#' @param arrows a [logical] to indicate whether arrows should be drawn
#' @param arrows_textsize the size of the text for variable names
#' @param arrows_colour the colour of the arrow and their text
#' @param arrows_size the size (thickness) of the arrow lines
#' @param arrows_textsize the size of the text at the end of the arrows
#' @param arrows_textangled a logical whether the text at the end of the arrows should be angled
#' @param arrows_textangled a [logical] whether the text at the end of the arrows should be angled
#' @param arrows_alpha the alpha (transparency) of the arrows and their text
#' @param base_textsize the text size for all plot elements except the labels and arrows
#' @param ... arguments passed on to functions

4
R/ggplot_rsi.R

@ -31,8 +31,8 @@ @@ -31,8 +31,8 @@
#' @param position position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`
#' @param x variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable
#' @param fill variable to categorise using the plots legend, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable
#' @param breaks numeric vector of positions
#' @param limits numeric vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum
#' @param breaks a [numeric] vector of positions
#' @param limits a [numeric] vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum
#' @param facet variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable
#' @inheritParams proportion
#' @param nrow (when using `facet`) number of rows

4
R/guess_ab_col.R

@ -29,8 +29,8 @@ @@ -29,8 +29,8 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame]
#' @param search_string a text to search `x` for, will be checked with [as.ab()] if this value is not a column in `x`
#' @param verbose a logical to indicate whether additional info should be printed
#' @param only_rsi_columns a logical to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param verbose a [logical] to indicate whether additional info should be printed
#' @param only_rsi_columns a [logical] to indicate whether only antibiotic columns must be detected that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @details You can look for an antibiotic (trade) name or abbreviation and it will search `x` and the [antibiotics] data set for any column containing a name or code of that antibiotic. **Longer columns names take precedence over shorter column names.**
#' @return A column name of `x`, or `NULL` when no result is found.
#' @export

11
R/italicise_taxonomy.R

@ -27,7 +27,7 @@ @@ -27,7 +27,7 @@
#'
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.
#' @inheritSection lifecycle Maturing Lifecycle
#' @param string a character (vector)
#' @param string a [character] (vector)
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
#' @details
#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set.
@ -42,6 +42,15 @@ @@ -42,6 +42,15 @@
#' italicise_taxonomy("An overview of S. aureus isolates")
#'
#' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
#'
#' # since ggplot2 supports no markdown (yet), use
#' # italicise_taxonomy() and the `ggtext` pkg for titles:
#'
#' if (require("ggplot2") && require("ggtext")) {
#' ggplot(example_isolates$AMC,
#' title = italicise_taxonomy("Amoxi/clav in E. coli")) +
#' theme(plot.title = ggtext::element_markdown())
#' }
italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
if (missing(type)) {
type <- "markdown"

225
R/join_microorganisms.R

@ -25,23 +25,24 @@ @@ -25,23 +25,24 @@
#' Join [microorganisms] to a Data Set
#'
#' Join the data set [microorganisms] easily to an existing table or character vector.
#' Join the data set [microorganisms] easily to an existing data set or to a [character] vector.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname join
#' @name join
#' @aliases join inner_join
#' @param x existing table to join, or character vector
#' @param x existing data set to join, or [character] vector. In case of a [character] vector, the resulting [data.frame] will contain a column 'x' with these values.
#' @param by a variable to join by - if left empty will search for a column with class [`mo`] (created with [as.mo()]) or will be `"mo"` if that column name exists in `x`, could otherwise be a column name of `x` with values that exist in `microorganisms$mo` (such as `by = "bacteria_id"`), or another column in [microorganisms] (but then it should be named, like `by = c("bacteria_id" = "fullname")`)
#' @param suffix if there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.
#' @param suffix if there are non-joined duplicate variables in `x` and `y`, these suffixes will be added to the output to disambiguate them. Should be a [character] vector of length 2.
#' @param ... ignored, only in place to allow future extensions
#' @details **Note:** As opposed to the `join()` functions of `dplyr`, [character] vectors are supported and at default existing columns will get a suffix `"2"` and the newly joined columns will not get a suffix.
#'
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] function from base R will be used.
#' If the `dplyr` package is installed, their join functions will be used. Otherwise, the much slower [merge()] and [interaction()] functions from base R will be used.
#' @inheritSection AMR Read more on Our Website!
#' @return a [data.frame]
#' @export
#' @examples
#' left_join_microorganisms(as.mo("K. pneumoniae"))
#' left_join_microorganisms("B_KLBSL_PNE")
#' left_join_microorganisms("B_KLBSL_PNMN")
#'
#' \donttest{
#' if (require("dplyr")) {
@ -65,28 +66,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { @@ -65,28 +66,7 @@ inner_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
check_dataset_integrity()
x <- check_groups_before_join(x, "inner_join_microorganisms")
checked <- joins_check_df(x, by)
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_inner <- import_fn("inner_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_inner)) {
join <- suppressWarnings(
dplyr_inner(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_inner_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
class(join) <- x_class
join
join_microorganisms(type = "inner_join", x = x, by = by, suffix = suffix, ...)
}
#' @rdname join
@ -96,28 +76,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { @@ -96,28 +76,7 @@ left_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
check_dataset_integrity()
x <- check_groups_before_join(x, "left_join_microorganisms")
checked <- joins_check_df(x, by)
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_left <- import_fn("left_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_left)) {
join <- suppressWarnings(
dplyr_left(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_left_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
class(join) <- x_class
join
join_microorganisms(type = "left_join", x = x, by = by, suffix = suffix, ...)
}
#' @rdname join
@ -127,28 +86,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { @@ -127,28 +86,7 @@ right_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
check_dataset_integrity()
x <- check_groups_before_join(x, "right_join_microorganisms")
checked <- joins_check_df(x, by)
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_right <- import_fn("right_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_right)) {
join <- suppressWarnings(
dplyr_right(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_right_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
class(join) <- x_class
join
join_microorganisms(type = "right_join", x = x, by = by, suffix = suffix, ...)
}
#' @rdname join
@ -158,28 +96,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) { @@ -158,28 +96,7 @@ full_join_microorganisms <- function(x, by = NULL, suffix = c("2", ""), ...) {
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
meet_criteria(suffix, allow_class = "character", has_length = 2)
check_dataset_integrity()
x <- check_groups_before_join(x, "full_join_microorganisms")
checked <- joins_check_df(x, by)
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_full <- import_fn("full_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_full)) {
join <- suppressWarnings(
dplyr_full(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
} else {
join <- suppressWarnings(
pm_full_join(x = x, y = microorganisms, by = by, suffix = suffix, ...)
)
}
if (NROW(join) > NROW(x)) {
warning_("The newly joined tbl contains ", nrow(join) - nrow(x), " rows more that its original.")
}
class(join) <- x_class
join
join_microorganisms(type = "full_join", x = x, by = by, suffix = suffix, ...)
}
#' @rdname join
@ -188,25 +105,7 @@ semi_join_microorganisms <- function(x, by = NULL, ...) { @@ -188,25 +105,7 @@ semi_join_microorganisms <- function(x, by = NULL, ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
check_dataset_integrity()
x <- check_groups_before_join(x, "semi_join_microorganisms")
x_class <- get_prejoined_class(x)
checked <- joins_check_df(x, by)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_semi <- import_fn("semi_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_semi)) {
join <- suppressWarnings(
dplyr_semi(x = x, y = microorganisms, by = by, ...)
)
} else {
join <- suppressWarnings(
pm_semi_join(x = x, y = microorganisms, by = by, ...)
)
}
class(join) <- x_class
join
join_microorganisms(type = "semi_join", x = x, by = by, suffix = suffix, ...)
}
#' @rdname join
@ -215,72 +114,60 @@ anti_join_microorganisms <- function(x, by = NULL, ...) { @@ -215,72 +114,60 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
meet_criteria(x, allow_class = c("data.frame", "character"))
meet_criteria(by, allow_class = "character", allow_NULL = TRUE)
check_dataset_integrity()
x <- check_groups_before_join(x, "anti_join_microorganisms")
checked <- joins_check_df(x, by)
x_class <- get_prejoined_class(x)
x <- checked$x
by <- checked$by
# use dplyr if available - it's much faster
dplyr_anti <- import_fn("anti_join", "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_anti)) {
join <- suppressWarnings(
dplyr_anti(x = x, y = microorganisms, by = by, ...)
)
} else {
join <- suppressWarnings(
pm_anti_join(x = x, y = microorganisms, by = by, ...)
)
}
class(join) <- x_class
join
join_microorganisms(type = "anti_join", x = x, by = by, suffix = suffix, ...)
}
joins_check_df <- function(x, by) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(mo = as.mo(x), stringsAsFactors = FALSE)
if (is.null(by)) {
by <- "mo"
}
join_microorganisms <- function(type, x, by, suffix, ...) {
check_dataset_integrity()
if (!is.data.frame(x)) {
x <- data.frame(mo = x, stringsAsFactors = FALSE)
by <- "mo"
}
x <- as.data.frame(x, stringsAsFactors = FALSE)
if (is.null(by)) {
# search for column with class `mo` and return first one found
by <- colnames(x)[lapply(x, is.mo) == TRUE][1]
if (is.na(by)) {
if ("mo" %in% colnames(x)) {
by <- "mo"
x[, "mo"] <- as.mo(x[, "mo"])
} else {
stop("Cannot join - no column found with name 'mo' or with class <mo>.", call. = FALSE)
}
}
message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
by <- search_type_in_df(x, "mo", info = FALSE)
stop_if(is.null(by), "cannot join - no column with microorganism names or codes found")
# message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
}
if (!all(x[, by, drop = TRUE] %in% MO_lookup$mo, na.rm = TRUE)) {
x$join.mo <- as.mo(x[, by, drop = TRUE])
by <- c("join.mo" = "mo")
} else {
x[, by] <- as.mo(x[, by, drop = TRUE])
}
if (is.null(names(by))) {
joinby <- colnames(microorganisms)[1]
names(joinby) <- by
# will always be joined to microorganisms$mo, so add name to that
by <- stats::setNames("mo", by)
}
# use dplyr if available - it's much faster than poorman alternatives
dplyr_join <- import_fn(name = type, pkg = "dplyr", error_on_fail = FALSE)
if (!is.null(dplyr_join)) {
join_fn <- dplyr_join
} else {
joinby <- by
# otherwise use poorman, see R/aa_helper_pm_functions.R
join_fn <- get(paste0("pm_", type), envir = asNamespace("AMR"))
}
list(x = x,
by = joinby)
}
get_prejoined_class <- function(x) {
if (is.data.frame(x)) {
class(x)
if (type %like% "full|left|right|inner") {
joined <- join_fn(x = x, y = AMR::microorganisms, by = by, suffix = suffix, ...)
} else {
"data.frame"
joined <- join_fn(x = x, y = AMR::microorganisms, by = by, ...)
}
}
check_groups_before_join <- function(x, fn) {
if (is.data.frame(x) && !is.null(attributes(x)$groups)) {
x <- pm_ungroup(x)
attr(x, "groups") <- NULL
class(x) <- class(x)[class(x) %unlike% "group"]
warning_("Groups are dropped, since the ", fn, "() function relies on merge() from base R.", call = FALSE)
if ("join.mo" %in% colnames(joined)) {
if ("mo" %in% colnames(joined)) {
ind_mo <- which(colnames(joined) %in% c("mo", "join.mo"))
colnames(joined)[ind_mo[1L]] <- paste0("mo", suffix[1L])
colnames(joined)[ind_mo[2L]] <- paste0("mo", suffix[2L])
} else {
colnames(joined)[colnames(joined) == "join.mo"] <- "mo"
}
}
x
if (type %like% "full|left|right|inner" && NROW(joined) > NROW(x)) {
warning_("The newly joined tbl contains ", nrow(joined) - nrow(x), " rows more that its original.", call = FALSE)
}
joined
}

12
R/key_antimicrobials.R

@ -28,18 +28,18 @@ @@ -28,18 +28,18 @@
#' These functions can be used to determine first weighted isolates by considering the phenotype for isolate selection (see [first_isolate()]). Using a phenotype-based method to determine first isolates is more reliable than methods that disregard phenotypes.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] with antibiotics columns, like `AMX` or `amox`. Can be left blank to determine automatically
#' @param y,z character vectors to compare
#' @param y,z [character] vectors to compare
#' @inheritParams first_isolate
#' @param universal names of **broad-spectrum** antimicrobial agents, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param gram_negative names of antibiotic agents for **Gram-positives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param gram_positive names of antibiotic agents for **Gram-negatives**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param antifungal names of antifungal agents for **fungi**, case-insensitive. Set to `NULL` to ignore. See *Details* for the default agents.
#' @param only_rsi_columns a logical to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param only_rsi_columns a [logical] to indicate whether only columns must be included that were transformed to class `<rsi>` (see [as.rsi()]) on beforehand (defaults to `FALSE`)
#' @param ... ignored, only in place to allow future extensions
#' @details
#' The [key_antimicrobials()] and [all_antimicrobials()] functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
#'
#' The function [key_antimicrobials()] returns a character vector with 12 antimicrobial results for every isolate. The function [all_antimicrobials()] returns a character vector with all antimicrobial results for every isolate. These vectors can then be compared using [antimicrobials_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antimicrobials()] and ignored by [antimicrobials_equal()].
#' The function [key_antimicrobials()] returns a [character] vector with 12 antimicrobial results for every isolate. The function [all_antimicrobials()] returns a [character] vector with all antimicrobial results for every isolate. These vectors can then be compared using [antimicrobials_equal()], to check if two isolates have generally the same antibiogram. Missing and invalid values are replaced with a dot (`"."`) by [key_antimicrobials()] and ignored by [antimicrobials_equal()].
#'
#' Please see the [first_isolate()] function how these important functions enable the 'phenotype-based' method for determination of first isolates.
#'
@ -96,7 +96,7 @@ @@ -96,7 +96,7 @@
#' # TRUE, because I is ignored (as well as missing values)
#'
#' antimicrobials_equal(strainA, strainB, type = "keyantimicrobials", ignore_I = FALSE)
#' # FALSE, because I is not ignored and so the 4th character differs
#' # FALSE, because I is not ignored and so the 4th [character] differs
#'
#' \donttest{
#' if (require("dplyr")) {
@ -140,7 +140,7 @@ key_antimicrobials <- function(x = NULL, @@ -140,7 +140,7 @@ key_antimicrobials <- function(x = NULL,
meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular data.frame, not a tibble or data.table
# force regular [data.frame], not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, info = FALSE, only_rsi_columns = only_rsi_columns)
@ -237,7 +237,7 @@ all_antimicrobials <- function(x = NULL, @@ -237,7 +237,7 @@ all_antimicrobials <- function(x = NULL,
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1)
# force regular data.frame, not a tibble or data.table
# force regular [data.frame], not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
cols <- get_column_abx(x, only_rsi_columns = only_rsi_columns, info = FALSE, sort = FALSE)

4
R/kurtosis.R

@ -28,8 +28,8 @@ @@ -28,8 +28,8 @@
#' @description Kurtosis is a measure of the "tailedness" of the probability distribution of a real-valued random variable. A normal distribution has a kurtosis of 3 and a excess kurtosis of 0.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a vector of values, a [matrix] or a [data.frame]
#' @param na.rm a logical to indicate whether `NA` values should be stripped before the computation proceeds
#' @param excess a logical to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
#' @param na.rm a [logical] to indicate whether `NA` values should be stripped before the computation proceeds
#' @param excess a [logical] to indicate whether the *excess kurtosis* should be returned, defined as the kurtosis minus 3.
#' @seealso [skewness()]
#' @rdname kurtosis
#' @inheritSection AMR Read more on Our Website!

4
R/like.R

@ -27,8 +27,8 @@ @@ -27,8 +27,8 @@
#'
#' Convenient wrapper around [grepl()] to match a pattern: `x %like% pattern`. It always returns a [`logical`] vector and is always case-insensitive (use `x %like_case% pattern` for case-sensitive matching). Also, `pattern` can be as long as `x` to compare items of each index in both vectors, or they both can have the same length to iterate over all cases.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a character vector where matches are sought, or an object which can be coerced by [as.character()] to a character vector.
#' @param pattern a character vector containing regular expressions (or a [character] string for `fixed = TRUE`) to be matched in the given character vector. Coerced by [as.character()] to a character string if possible.
#' @param x a [character] vector where matches are sought, or an object which can be coerced by [as.character()] to a [character] vector.
#' @param pattern a [character] vector containing regular expressions (or a [character] string for `fixed = TRUE`) to be matched in the given [character] vector. Coerced by [as.character()] to a [character] string if possible.
#' @param ignore.case if `FALSE`, the pattern matching is *case sensitive* and if `TRUE`, case is ignored during matching.
#' @return A [logical] vector
#' @name like

22
R/mdro.R

@ -34,7 +34,7 @@ @@ -34,7 +34,7 @@
#' @inheritParams eucast_rules
#' @param pct_required_classes minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
#' @param verbose a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
#' @param verbose a [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
#' @inheritSection eucast_rules Antibiotics
#' @details
#' These functions are context-aware. This means that then the `x` argument can be left blank, see *Examples*.
@ -136,7 +136,7 @@ @@ -136,7 +136,7 @@
#' @export
#' @inheritSection AMR Read more on Our Website!
#' @source
#' See the supported guidelines above for the list of publications used for this function.
#' See the supported guidelines above for the [list] of publications used for this function.
#' @examples
#' mdro(example_isolates, guideline = "EUCAST")
#'
@ -232,7 +232,7 @@ mdro <- function(x = NULL, @@ -232,7 +232,7 @@ mdro <- function(x = NULL,
}
}
# force regular data.frame, not a tibble or data.table
# force regular [data.frame], not a tibble or data.table
x <- as.data.frame(x, stringsAsFactors = FALSE)
if (pct_required_classes > 1) {
@ -252,7 +252,7 @@ mdro <- function(x = NULL, @@ -252,7 +252,7 @@ mdro <- function(x = NULL,
if (info == TRUE) {
txt <- paste0("Determining MDROs based on custom rules",
ifelse(isTRUE(attributes(guideline)$as_factor),
paste0(", resulting in factor levels: ", paste0(attributes(guideline)$values, collapse = " < ")),
paste0(", resulting in [factor] levels: ", paste0(attributes(guideline)$values, collapse = " < ")),
""),
".")
txt <- word_wrap(txt)
@ -361,7 +361,7 @@ mdro <- function(x = NULL, @@ -361,7 +361,7 @@ mdro <- function(x = NULL,
if (guideline$code == "cmi2012") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c(
# table 1 (S aureus):
# [table] 1 (S aureus):
"GEN",
"RIF",
"CPT",
@ -384,7 +384,7 @@ mdro <- function(x = NULL, @@ -384,7 +384,7 @@ mdro <- function(x = NULL,
"TCY",
"DOX",
"MNO",
# table 2 (Enterococcus)
# [table] 2 (Enterococcus)
"GEH",
"STH",
"IPM",
@ -402,7 +402,7 @@ mdro <- function(x = NULL, @@ -402,7 +402,7 @@ mdro <- function(x = NULL,
"QDA",
"DOX",
"MNO",
# table 3 (Enterobacteriaceae)
# [table] 3 (Enterobacteriaceae)
"GEN",
"TOB",
"AMK",
@ -434,7 +434,7 @@ mdro <- function(x = NULL, @@ -434,7 +434,7 @@ mdro <- function(x = NULL,
"TCY",
"DOX",
"MNO",
# table 4 (Pseudomonas)
# [table] 4 (Pseudomonas)
"GEN",
"TOB",
"AMK",
@ -452,7 +452,7 @@ mdro <- function(x = NULL, @@ -452,7 +452,7 @@ mdro <- function(x = NULL,
"FOS",
"COL",
"PLB",
# table 5 (Acinetobacter)
# [table] 5 (Acinetobacter)
"GEN",
"TOB",
"AMK",
@ -1340,7 +1340,7 @@ mdro <- function(x = NULL, @@ -1340,7 +1340,7 @@ mdro <- function(x = NULL,
ab
}
drug_is_R <- function(ab) {
# returns logical vector
# returns [logical] vector
ab <- prepare_drug(ab)
if (length(ab) == 0) {
rep(FALSE, NROW(x))
@ -1351,7 +1351,7 @@ mdro <- function(x = NULL, @@ -1351,7 +1351,7 @@ mdro <- function(x = NULL,
}
}
drug_is_not_R <- function(ab) {
# returns logical vector
# returns [logical] vector
ab <- prepare_drug(ab)
if (length(ab) == 0) {
rep(TRUE, NROW(x))

25
R/mic.R

@ -28,11 +28,11 @@ @@ -28,11 +28,11 @@
#' This ransforms vectors to a new class [`mic`], which treats the input as decimal numbers, while maintaining operators (such as ">=") and only allowing valid MIC values known to the field of (medical) microbiology.
#' @inheritSection lifecycle Stable Lifecycle
#' @rdname as.mic
#' @param x character or numeric vector
#' @param na.rm a logical indicating whether missing values should be removed
#' @param x a [character] or [numeric] vector
#' @param na.rm a [logical] indicating whether missing values should be removed
#' @details To interpret MIC values as RSI values, use [as.rsi()] on MIC values. It supports guidelines from EUCAST and CLSI.
#'
#' This class for MIC values is a quite a special data type: formally it is an ordered factor with valid MIC values as factor levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
#' This class for MIC values is a quite a special data type: formally it is an ordered [factor] with valid MIC values as [factor] levels (to make sure only valid MIC values are retained), but for any mathematical operation it acts as decimal numbers:
#'
#' ```
#' x <- random_mic(10)
@ -50,7 +50,7 @@ @@ -50,7 +50,7 @@
#' #> [1] 26
#' ```
#'
#' This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using numeric values in data analysis, e.g.:
#' This makes it possible to maintain operators that often come with MIC values, such ">=" and "<=", even when filtering using [numeric] values in data analysis, e.g.:
#'
#' ```
#' x[x > 4]
@ -69,7 +69,7 @@ @@ -69,7 +69,7 @@
#' ```
#'
#' The following [generic functions][groupGeneric()] are implemented for the MIC class: `!`, `!=`, `%%`, `%/%`, `&`, `*`, `+`, `-`, `/`, `<`, `<=`, `==`, `>`, `>=`, `^`, `|`, [abs()], [acos()], [acosh()], [all()], [any()], [asin()], [asinh()], [atan()], [atanh()], [ceiling()], [cos()], [cosh()], [cospi()], [cummax()], [cummin()], [cumprod()], [cumsum()], [digamma()], [exp()], [expm1()], [floor()], [gamma()], [lgamma()], [log()], [log1p()], [log2()], [log10()], [max()], [mean()], [min()], [prod()], [range()], [round()], [sign()], [signif()], [sin()], [sinh()], [sinpi()], [sqrt()], [sum()], [tan()], [tanh()], [tanpi()], [trigamma()] and [trunc()]. Some functions of the `stats` package are also implemented: [median()], [quantile()], [mad()], [IQR()], [fivenum()]. Also, [boxplot.stats()] is supported. Since [sd()] and [var()] are non-generic functions, these could not be extended. Use [mad()] as an alternative, or use e.g. `sd(as.numeric(x))` where `x` is your vector of MIC values.
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a numeric value.
#' @return Ordered [factor] with additional class [`mic`], that in mathematical operations acts as decimal numbers. Bare in mind that the outcome of any mathematical operation on MICs will return a [numeric] value.
#' @aliases mic
#' @export
#' @seealso [as.rsi()]
@ -81,7 +81,7 @@ @@ -81,7 +81,7 @@
#' # this can also coerce combined MIC/RSI values:
#' as.mic("<=0.002; S") # will return <=0.002
#'
#' # mathematical processing treats MICs as numeric values
#' # mathematical processing treats MICs as [numeric] values
#' fivenum(mic_data)
#' quantile(mic_data)
#' all(mic_data < 512)
@ -149,7 +149,7 @@ as.mic <- function(x, na.rm = FALSE) { @@ -149,7 +149,7 @@ as.mic <- function(x, na.rm = FALSE) {
## previously unempty values now empty - should return a warning later on
x[x.bak != "" & x == ""] <- "invalid"
# these are allowed MIC values and will become factor levels
# these are allowed MIC values and will become [factor] levels
ops <- c("<", "<=", "", ">=", ">")
lvls <- c(c(t(vapply(FUN.VALUE = character(9), ops, function(x) paste0(x, "0.00", 1:9)))),
unique(c(t(vapply(FUN.VALUE = character(104), ops, function(x) paste0(x, sort(as.double(paste0("0.0",
@ -345,11 +345,12 @@ hist.mic <- function(x, ...) { @@ -345,11 +345,12 @@ hist.mic <- function(x, ...) {
get_skimmers.mic <- function(column) {
skimr::sfl(
skim_type = "mic",
min = ~min(., na.rm = TRUE),
max = ~max(., na.rm = TRUE),
median = ~stats::median(., na.rm = TRUE),
n_unique = ~length(unique(stats::na.omit(.))),
hist_log2 = ~skimr::inline_hist(log2(stats::na.omit(.)))
p0 = ~stats::quantile(., probs = 0, na.rm = TRUE, names = FALSE),
p25 = ~stats::quantile(., probs = 0.25, na.rm = TRUE, names = FALSE),
p50 = ~stats::quantile(., probs = 0.5, na.rm = TRUE, names = FALSE),
p75 = ~stats::quantile(., probs = 0.75, na.rm = TRUE, names = FALSE),
p100 = ~stats::quantile(., probs = 1, na.rm = TRUE, names = FALSE),
hist = ~skimr::inline_hist(log2(stats::na.omit(.)), 5)
)
}

16
R/mo.R

@ -27,11 +27,11 @@ @@ -27,11 +27,11 @@
#'
#' Use this function to determine a valid microorganism ID ([`mo`]). Determination is done using intelligent rules and the complete taxonomic kingdoms Bacteria, Chromista, Protozoa, Archaea and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a character vector or a [data.frame] with one or two columns
#' @param Becker a logical to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (1,2,3).
#' @param x a [character] vector or a [data.frame] with one or two columns
#' @param Becker a [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (1,2,3).
#'
#' This excludes *Staphylococcus aureus* at default, use `Becker = "all"` to also categorise *S. aureus* as "CoPS".
#' @param Lancefield a logical to indicate whether beta-haemolytic *Streptococci* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (4). These *Streptococci* will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L.
#' @param Lancefield a [logical] to indicate whether beta-haemolytic *Streptococci* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (4). These *Streptococci* will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L.
#'
#' This excludes *Enterococci* at default (who are in group D), use `Lancefield = "all"` to also categorise all *Enterococci* as group D.
#' @param allow_uncertain a number between `0` (or `"none"`) and `3` (or `"all"`), or `TRUE` (= `2`) or `FALSE` (= `0`) to indicate whether the input should be checked for less probable results, see *Details*
@ -245,10 +245,10 @@ is.mo <- function(x) { @@ -245,10 +245,10 @@ is.mo <- function(x) {
}
# param property a column name of microorganisms
# param initial_search logical - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too
# param dyslexia_mode logical - also check for characters that resemble others
# param debug logical - show different lookup texts while searching
# param reference_data_to_use data.frame - the data set to check for
# param initial_search [logical] - is FALSE when coming from uncertain tries, which uses exec_as.mo internally too
# param dyslexia_mode [logical] - also check for characters that resemble others
# param debug [logical] - show different lookup texts while searching
# param reference_data_to_use [data.frame] - the data set to check for
# param actual_uncertainty - (only for initial_search = FALSE) the actual uncertainty level used in the function for score calculation (sometimes passed as 2 or 3 by uncertain_fn())
# param actual_input - (only for initial_search = FALSE) the actual, original input
# param language - used for translating "no growth", etc.
@ -304,7 +304,7 @@ exec_as.mo <- function(x, @@ -304,7 +304,7 @@ exec_as.mo <- function(x,
}
# `column` can be NULL for all columns, or a selection
# returns a character (vector) - if `column` > length 1 then with columns as names
# returns a [character] (vector) - if `column` > length 1 then with columns as names
if (isTRUE(debug_mode)) {
cat(font_silver("Looking up: ", substitute(needle), collapse = ""),
"\n ", time_track())

2
R/mo_property.R

@ -27,7 +27,7 @@ @@ -27,7 +27,7 @@
#'
#' Use these functions to return a specific property of a microorganism based on the latest accepted taxonomy. All input values will be evaluated internally with [as.mo()], which makes it possible to use microbial abbreviations, codes and names as input. See *Examples*.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x any character (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param x any [character] (vector) that can be coerced to a valid microorganism code with [as.mo()]. Can be left blank for auto-guessing the column containing microorganism codes if used in a data set, see *Examples*.
#' @param property one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`, or must be `"shortname"`
#' @param language language of the returned text, 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]. Also used to translate text like "no growth". Use `language = NULL` or `language = ""` to prevent translation.
#' @param ... other arguments passed on to [as.mo()], such as 'allow_uncertain' and 'ignore_pattern'

8
R/pca.R

@ -27,12 +27,12 @@ @@ -27,12 +27,12 @@
#'
#' Performs a principal component analysis (PCA) based on a data set with automatic determination for afterwards plotting the groups and labels, and automatic filtering on only suitable (i.e. non-empty and numeric) variables.
#' @inheritSection lifecycle Stable Lifecycle
#' @param x a [data.frame] containing numeric columns
#' @param x a [data.frame] containing [numeric] columns
#' @param ... columns of `x` to be selected for PCA, can be unquoted since it supports quasiquotation.
#' @inheritParams stats::prcomp
#' @details The [pca()] function takes a [data.frame] as input and performs the actual PCA with the \R function [prcomp()].
#'
#' The result of the [pca()] function is a [prcomp] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain numeric values. These are probably the groups and labels, and will be used by [ggplot_pca()].
#' The result of the [pca()] function is a [prcomp] object, with an additional attribute `non_numeric_cols` which is a vector with the column names of all columns that do not contain [numeric] values. These are probably the groups and labels, and will be used by [ggplot_pca()].
#' @return An object of classes [pca] and [prcomp]
#' @importFrom stats prcomp
#' @export
@ -99,14 +99,14 @@ pca <- function(x, @@ -99,14 +99,14 @@ pca <- function(x,
x <- as.data.frame(new_list, stringsAsFactors = FALSE)
if (any(vapply(FUN.VALUE = logical(1), x, function(y) !is.numeric(y)))) {
warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with numeric variables only. See Examples in ?pca.", call = FALSE)
warning_("Be sure to first calculate the resistance (or susceptibility) of variables with antimicrobial test results, since PCA works with [numeric] variables only. See Examples in ?pca.", call = FALSE)
}
# set column names
tryCatch(colnames(x) <- as.character(dots)[2:length(dots)],
error = function(e) warning("column names could not be set"))
# keep only numeric columns
# keep only [numeric] columns
x <- x[, vapply(FUN.VALUE = logical(1), x, function(y) is.numeric(y))]
# bind the data set with the non-numeric columns
x <- cbind(x.bak[, vapply(FUN.VALUE = logical(1), x.bak, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE], x)

4
R/plot.R

@ -37,7 +37,7 @@ @@ -37,7 +37,7 @@
#' @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.
#' @param expand a [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.
#'
@ -656,6 +656,8 @@ ggplot.rsi <- function(data, @@ -656,6 +656,8 @@ ggplot.rsi <- function(data,
}
plot_prepare_table <- function(x, expand) {
x <- x[!is.na(x)]
stop_if(length(x) == 0, "no observations to plot", call = FALSE)
if (is.mic(x)) {
if (expand == TRUE) {
# expand range for MIC by adding factors of 2 from lowest to highest so all MICs in between also print

10
R/proportion.R

@ -31,18 +31,18 @@ @@ -31,18 +31,18 @@
#' @inheritSection lifecycle Stable Lifecycle
#' @param ... one or more vectors (or columns) with antibiotic interpretations. They will be transformed internally with [as.rsi()] if needed. Use multiple columns to calculate (the lack of) co-resistance: the probability where one of two drugs have a resistant or susceptible result. See *Examples*.
#' @param minimum the minimum allowed number of available (tested) isolates. Any isolate count lower than `minimum` will return `NA` with a warning. The default number of `30` isolates is advised by the Clinical and Laboratory Standards Institute (CLSI) as best practice, see *Source*.
#' @param as_percent a logical to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a logical to indicate that isolates must be tested for all antibiotics, see section *Combination Therapy* below
#' @param as_percent a [logical] to indicate whether the output must be returned as a hundred fold with % sign (a character). A value of `0.123456` will then be returned as `"12.3%"`.
#' @param only_all_tested (for combination therapies, i.e. using more than one variable for `...`): a [logical] to indicate that isolates must be tested for all antibiotics, see section *Combination Therapy* below
#' @param data a [data.frame] containing columns with class [`rsi`] (see [as.rsi()])
#' @param translate_ab a column name of the [antibiotics] data set to translate the antibiotic abbreviations to, using [ab_property()]
#' @inheritParams ab_property
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
#' @param combine_IR a logical to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
#' @param combine_SI a [logical] to indicate whether all values of S and I must be merged into one, so the output only consists of S+I vs. R (susceptible vs. resistant). This used to be the argument `combine_IR`, but this now follows the redefinition by EUCAST about the interpretation of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. Default is `TRUE`.
#' @param combine_IR a [logical] to indicate whether all values of I and R must be merged into one, so the output only consists of S vs. I+R (susceptible vs. non-susceptible). This is outdated, see argument `combine_SI`.
#' @inheritSection as.rsi Interpretation of R and S/I
#' @details
#' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
#'
#' **Remember that you should filter your table to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
#' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set.
#'