mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 18:46:11 +01:00
breaks param, tidyr dep change, freq markdown
This commit is contained in:
parent
ec15b82fd6
commit
c2a93b46db
15
DESCRIPTION
15
DESCRIPTION
@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 0.4.0.9005
|
Version: 0.4.0.9006
|
||||||
Date: 2018-10-19
|
Date: 2018-10-22
|
||||||
Title: Antimicrobial Resistance Analysis
|
Title: Antimicrobial Resistance Analysis
|
||||||
Authors@R: c(
|
Authors@R: c(
|
||||||
person(
|
person(
|
||||||
@ -38,10 +38,9 @@ Authors@R: c(
|
|||||||
email = "b.sinha@umcg.nl",
|
email = "b.sinha@umcg.nl",
|
||||||
role = "ths",
|
role = "ths",
|
||||||
comment = c(ORCID = "0000-0003-1634-0010")))
|
comment = c(ORCID = "0000-0003-1634-0010")))
|
||||||
Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR)
|
Description: Functions to simplify the analysis and prediction of Antimicrobial
|
||||||
of microbial isolates, by using new S3 classes and applying EUCAST expert rules
|
Resistance (AMR) and work with microbial and antimicrobial properties by using
|
||||||
on antibiograms according to Leclercq (2013)
|
evidence-based methods.
|
||||||
<doi:10.1111/j.1469-0691.2011.03703.x>.
|
|
||||||
Depends:
|
Depends:
|
||||||
R (>= 3.1.0)
|
R (>= 3.1.0)
|
||||||
Imports:
|
Imports:
|
||||||
@ -54,14 +53,14 @@ Imports:
|
|||||||
knitr (>= 1.0.0),
|
knitr (>= 1.0.0),
|
||||||
rlang (>= 0.2.0),
|
rlang (>= 0.2.0),
|
||||||
rvest (>= 0.3.2),
|
rvest (>= 0.3.2),
|
||||||
|
tidyr (>= 0.7.0),
|
||||||
xml2 (>= 1.0.0)
|
xml2 (>= 1.0.0)
|
||||||
Suggests:
|
Suggests:
|
||||||
covr (>= 3.0.1),
|
covr (>= 3.0.1),
|
||||||
ggplot2,
|
ggplot2,
|
||||||
rmarkdown,
|
rmarkdown,
|
||||||
rstudioapi,
|
rstudioapi,
|
||||||
testthat (>= 1.0.2),
|
testthat (>= 1.0.2)
|
||||||
tidyr
|
|
||||||
VignetteBuilder: knitr
|
VignetteBuilder: knitr
|
||||||
URL: https://github.com/msberends/AMR
|
URL: https://github.com/msberends/AMR
|
||||||
BugReports: https://github.com/msberends/AMR/issues
|
BugReports: https://github.com/msberends/AMR/issues
|
||||||
|
8
NEWS.md
8
NEWS.md
@ -17,25 +17,29 @@
|
|||||||
* Fix for `portion_*(..., as_percent = TRUE)` when minimal amount of isolates would not be met
|
* Fix for `portion_*(..., as_percent = TRUE)` when minimal amount of isolates would not be met
|
||||||
* Added parameter `also_single_tested` for `portion_*` and `count_*` functions to also include cases where not all antibiotics were tested but at least one of the tested antibiotics includes the target antimicribial interpretation, see `?portion`
|
* Added parameter `also_single_tested` for `portion_*` and `count_*` functions to also include cases where not all antibiotics were tested but at least one of the tested antibiotics includes the target antimicribial interpretation, see `?portion`
|
||||||
* Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum`
|
* Using `portion_*` functions now throws a warning when total available isolate is below parameter `minimum`
|
||||||
* Functions `as.mo`, `as.rsi` and `as.mic` will not set package name as attribute anymore
|
* Functions `as.mo`, `as.rsi`, `as.mic` and `as.atc` will not set package name as attribute anymore
|
||||||
* Data set `septic_patients` is now a `data.frame`, not a tibble anymore
|
* Data set `septic_patients` is now a `data.frame`, not a tibble anymore
|
||||||
* Check for `hms::is.hms` in frequency tables (`freq()`)
|
* Check for `hms::is.hms` in frequency tables (`freq()`)
|
||||||
* New parameter `header` for frequency tables to turn them off (default when `markdown = TRUE`)
|
* New parameter `header` for frequency tables to turn them off (default when `markdown = TRUE`)
|
||||||
|
* Freq now prints in markdown at default in non-interactive sessions
|
||||||
* Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters
|
* Removed diacritics from all authors (columns `microorganisms$ref` and `microorganisms.old$ref`) to comply with CRAN policy to only allow ASCII characters
|
||||||
* Fix for `mo_property` not working properly
|
* Fix for `mo_property` not working properly
|
||||||
* Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5
|
* Fix for `EUCAST_rules` where some Streptococci would become ceftazidime R in EUCAST rule 4.5
|
||||||
* Support for class `difftime` in frequency tables
|
* Support for class `difftime` in frequency tables
|
||||||
* Support for named vectors of class `mo`, useful for `top_freq()`
|
* Support for named vectors of class `mo`, useful for `top_freq()`
|
||||||
|
* `ggplot_rsi` and `scale_y_percent` have `breaks` parameter
|
||||||
* AI improvements for `as.mo`:
|
* AI improvements for `as.mo`:
|
||||||
* `"CRS"` -> *Stenotrophomonas maltophilia*
|
* `"CRS"` -> *Stenotrophomonas maltophilia*
|
||||||
* `"CRSM"` -> *Stenotrophomonas maltophilia*
|
* `"CRSM"` -> *Stenotrophomonas maltophilia*
|
||||||
* `"MSSA"` -> *Staphylococcus aureus*
|
* `"MSSA"` -> *Staphylococcus aureus*
|
||||||
* `"MSSE"` -> *Staphylococcus epidermidis*
|
* `"MSSE"` -> *Staphylococcus epidermidis*
|
||||||
* Fix for `join` functions
|
* Fix for `join` functions
|
||||||
* In `g.test`, when `sum(x)` is below 1000, suggest Fisher's Exact Test
|
* In `g.test`, when `sum(x)` is below 1000 or any of the expected values is below 5, Fisher's Exact Test will be suggested
|
||||||
|
* `ab_name` will try to fall back on `as.atc` when no results are found
|
||||||
|
|
||||||
#### Other
|
#### Other
|
||||||
* New dependency on package `crayon`, to support formatted text in the console
|
* New dependency on package `crayon`, to support formatted text in the console
|
||||||
|
* Dependency `tidyr` is now mandatory (went to `Import` field) since `portion_df` and `count_df` rely on it
|
||||||
* Updated vignettes to comply with README
|
* Updated vignettes to comply with README
|
||||||
|
|
||||||
|
|
||||||
|
23
R/abname.R
23
R/abname.R
@ -133,18 +133,19 @@ abname <- function(abcode,
|
|||||||
abcode[i] <- abx[which(abx[,from] == abcode[i]),] %>% pull(to) %>% .[1]
|
abcode[i] <- abx[which(abx[,from] == abcode[i]),] %>% pull(to) %>% .[1]
|
||||||
}
|
}
|
||||||
|
|
||||||
# when nothing found, try first chars of official name
|
|
||||||
# if (is.na(abcode[i])) {
|
|
||||||
# abcode[i] <- antibiotics %>%
|
|
||||||
# filter(official %like% paste0('^', abcode.bak[i])) %>%
|
|
||||||
# pull(to) %>%
|
|
||||||
# .[1]
|
|
||||||
# next
|
|
||||||
# }
|
|
||||||
|
|
||||||
if (is.na(abcode[i]) | length(abcode[i] == 0)) {
|
if (is.na(abcode[i]) | length(abcode[i] == 0)) {
|
||||||
abcode[i] <- abcode.bak[i]
|
# try as.atc
|
||||||
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
|
try(suppressWarnings(
|
||||||
|
abcode[i] <- as.atc(abcode[i])
|
||||||
|
), silent = TRUE)
|
||||||
|
if (is.na(abcode[i])) {
|
||||||
|
# still not found
|
||||||
|
abcode[i] <- abcode.bak[i]
|
||||||
|
warning('Code "', abcode.bak[i], '" not found in antibiotics list.', call. = FALSE)
|
||||||
|
} else {
|
||||||
|
# fill in the found ATC code
|
||||||
|
abcode[i] <- abname(abcode[i], from = "atc", to = to)
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
8
R/atc.R
8
R/atc.R
@ -37,6 +37,7 @@
|
|||||||
#' as.atc("J01FA01")
|
#' as.atc("J01FA01")
|
||||||
#' as.atc("Erythromycin")
|
#' as.atc("Erythromycin")
|
||||||
#' as.atc("eryt")
|
#' as.atc("eryt")
|
||||||
|
#' as.atc(" eryt 123")
|
||||||
#' as.atc("ERYT")
|
#' as.atc("ERYT")
|
||||||
#' as.atc("ERY")
|
#' as.atc("ERY")
|
||||||
#' as.atc("Erythrocin") # Trade name
|
#' as.atc("Erythrocin") # Trade name
|
||||||
@ -50,6 +51,10 @@
|
|||||||
as.atc <- function(x) {
|
as.atc <- function(x) {
|
||||||
|
|
||||||
x.new <- rep(NA_character_, length(x))
|
x.new <- rep(NA_character_, length(x))
|
||||||
|
x <- trimws(x, which = "both")
|
||||||
|
# keep only a-z when it's not an ATC code
|
||||||
|
x[!x %like% "[A-Z][0-9]{2}[A-Z]{2}[0-9]{2}"] <- gsub("[^a-zA-Z]+", "", x[!x %like% "[A-Z][0-9]{2}[A-Z]{2}[0-9]{2}"])
|
||||||
|
|
||||||
x.bak <- x
|
x.bak <- x
|
||||||
x <- unique(x[!is.na(x)])
|
x <- unique(x[!is.na(x)])
|
||||||
failures <- character(0)
|
failures <- character(0)
|
||||||
@ -64,7 +69,7 @@ as.atc <- function(x) {
|
|||||||
x.new[is.na(x.new) & x.bak == x[i]] <- found[1L]
|
x.new[is.na(x.new) & x.bak == x[i]] <- found[1L]
|
||||||
}
|
}
|
||||||
|
|
||||||
# try ATC in code form, even if it does not exist in the antibiotics data set YET
|
# try ATC in ATC code form, even if it does not exist in the antibiotics data set YET
|
||||||
if (length(found) == 0 & x[i] %like% '[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]') {
|
if (length(found) == 0 & x[i] %like% '[A-Z][0-9][0-9][A-Z][A-Z][0-9][0-9]') {
|
||||||
warning("ATC code ", x[i], " is not yet in the `antibiotics` data set.")
|
warning("ATC code ", x[i], " is not yet in the `antibiotics` data set.")
|
||||||
fail <- FALSE
|
fail <- FALSE
|
||||||
@ -134,7 +139,6 @@ as.atc <- function(x) {
|
|||||||
call. = FALSE)
|
call. = FALSE)
|
||||||
}
|
}
|
||||||
class(x.new) <- "atc"
|
class(x.new) <- "atc"
|
||||||
attr(x.new, 'package') <- 'AMR'
|
|
||||||
x.new
|
x.new
|
||||||
}
|
}
|
||||||
|
|
||||||
|
111
R/freq.R
111
R/freq.R
@ -23,10 +23,10 @@
|
|||||||
#' @param ... up to nine different columns of \code{x} when \code{x} is a \code{data.frame} or \code{tibble}, to calculate frequencies from - see Examples
|
#' @param ... up to nine different columns of \code{x} when \code{x} is a \code{data.frame} or \code{tibble}, to calculate frequencies from - see Examples
|
||||||
#' @param sort.count sort on count, i.e. frequencies. This will be \code{TRUE} at default for everything except for factors.
|
#' @param sort.count sort on count, i.e. frequencies. This will be \code{TRUE} at default for everything except for factors.
|
||||||
#' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.
|
#' @param nmax number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.
|
||||||
#' @param na.rm a logical value indicating whether \code{NA} values should be removed from the frequency table. The header_txt will always print the amount of \code{NA}s.
|
#' @param na.rm a logical value indicating whether \code{NA} values should be removed from the frequency table. The header will always print the amount of \code{NA}s.
|
||||||
#' @param row.names a logical value indicating whether row indices should be printed as \code{1:nrow(x)}
|
#' @param row.names a logical value indicating whether row indices should be printed as \code{1:nrow(x)}
|
||||||
#' @param markdown print table in markdown format (this forces \code{nmax = NA})
|
#' @param markdown a logical value indicating whether the frequency table should be printed in markdown format. This will print all rows and is default behaviour in non-interactive R sessions (like when knitting RMarkdown files).
|
||||||
#' @param digits how many significant digits are to be used for numeric values in the header_txt (not for the items themselves, that depends on \code{\link{getOption}("digits")})
|
#' @param digits how many significant digits are to be used for numeric values in the header (not for the items themselves, that depends on \code{\link{getOption}("digits")})
|
||||||
#' @param quote a logical value indicating whether or not strings should be printed with surrounding quotes
|
#' @param quote a logical value indicating whether or not strings should be printed with surrounding quotes
|
||||||
#' @param header a logical value indicating whether an informative header should be printed
|
#' @param header a logical value indicating whether an informative header should be printed
|
||||||
#' @param sep a character string to separate the terms when selecting multiple columns
|
#' @param sep a character string to separate the terms when selecting multiple columns
|
||||||
@ -34,7 +34,7 @@
|
|||||||
#' @param n number of top \emph{n} items to return, use -n for the bottom \emph{n} items. It will include more than \code{n} rows if there are ties.
|
#' @param n number of top \emph{n} items to return, use -n for the bottom \emph{n} items. It will include more than \code{n} rows if there are ties.
|
||||||
#' @details Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
|
#' @details Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
|
||||||
#'
|
#'
|
||||||
#' For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header_txt:
|
#' For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header:
|
||||||
#' \itemize{
|
#' \itemize{
|
||||||
#' \item{Mean, using \code{\link[base]{mean}}}
|
#' \item{Mean, using \code{\link[base]{mean}}}
|
||||||
#' \item{Standard Deviation, using \code{\link[stats]{sd}}}
|
#' \item{Standard Deviation, using \code{\link[stats]{sd}}}
|
||||||
@ -46,7 +46,7 @@
|
|||||||
#' \item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
|
#' \item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
|
||||||
#' }
|
#' }
|
||||||
#'
|
#'
|
||||||
#' For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header_txt:
|
#' For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header:
|
||||||
#' \itemize{
|
#' \itemize{
|
||||||
#' \item{Oldest, using \code{\link{min}}}
|
#' \item{Oldest, using \code{\link{min}}}
|
||||||
#' \item{Newest, using \code{\link{max}}, with difference between newest and oldest}
|
#' \item{Newest, using \code{\link{max}}, with difference between newest and oldest}
|
||||||
@ -140,21 +140,13 @@
|
|||||||
#' # check differences between frequency tables
|
#' # check differences between frequency tables
|
||||||
#' diff(freq(septic_patients$trim),
|
#' diff(freq(septic_patients$trim),
|
||||||
#' freq(septic_patients$trsu))
|
#' freq(septic_patients$trsu))
|
||||||
#'
|
|
||||||
#' \dontrun{
|
|
||||||
#' # send frequency table to clipboard (e.g. for pasting in Excel)
|
|
||||||
#' septic_patients %>%
|
|
||||||
#' freq(age) %>%
|
|
||||||
#' format() %>% # this will format the percentages
|
|
||||||
#' clipboard_export()
|
|
||||||
#' }
|
|
||||||
frequency_tbl <- function(x,
|
frequency_tbl <- function(x,
|
||||||
...,
|
...,
|
||||||
sort.count = TRUE,
|
sort.count = TRUE,
|
||||||
nmax = getOption("max.print.freq"),
|
nmax = getOption("max.print.freq"),
|
||||||
na.rm = TRUE,
|
na.rm = TRUE,
|
||||||
row.names = TRUE,
|
row.names = TRUE,
|
||||||
markdown = FALSE,
|
markdown = !interactive(),
|
||||||
digits = 2,
|
digits = 2,
|
||||||
quote = FALSE,
|
quote = FALSE,
|
||||||
header = !markdown,
|
header = !markdown,
|
||||||
@ -201,17 +193,14 @@ frequency_tbl <- function(x,
|
|||||||
cols <- NULL
|
cols <- NULL
|
||||||
}
|
}
|
||||||
} else if (any(class(x) == 'table')) {
|
} else if (any(class(x) == 'table')) {
|
||||||
if (!"tidyr" %in% rownames(installed.packages())) {
|
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||||
stop('transformation from `table` to frequency table requires the tidyr package.', call. = FALSE)
|
# now this DF contains 3 columns: the 2 vars and a Freq column
|
||||||
}
|
# paste the first 2 cols and repeat them Freq times:
|
||||||
x <- x %>%
|
x <- rep(x = do.call(paste, c(x[colnames(x)[1:2]], sep = sep)),
|
||||||
as.data.frame(stringsAsFactors = FALSE) %>%
|
times = x$Freq)
|
||||||
# paste first two columns
|
|
||||||
tidyr::unite(col = "Pasted", 1:2, sep = sep, remove = TRUE)
|
|
||||||
x <- rep(x %>% pull(Pasted), x %>% pull(Freq))
|
|
||||||
x.name <- "a `table` object"
|
x.name <- "a `table` object"
|
||||||
cols <- NULL
|
cols <- NULL
|
||||||
mult.columns <- 2
|
#mult.columns <- 2
|
||||||
} else {
|
} else {
|
||||||
x.name <- NULL
|
x.name <- NULL
|
||||||
cols <- NULL
|
cols <- NULL
|
||||||
@ -221,74 +210,8 @@ frequency_tbl <- function(x,
|
|||||||
if (ncol(x) == 1 & any(class(x) == 'data.frame')) {
|
if (ncol(x) == 1 & any(class(x) == 'data.frame')) {
|
||||||
x <- x %>% pull(1)
|
x <- x %>% pull(1)
|
||||||
} else if (ncol(x) < 10) {
|
} else if (ncol(x) < 10) {
|
||||||
|
|
||||||
mult.columns <- ncol(x)
|
mult.columns <- ncol(x)
|
||||||
|
x <- do.call(paste, c(x[colnames(x)], sep = sep))
|
||||||
colnames(x) <- LETTERS[1:ncol(x)]
|
|
||||||
if (ncol(x) == 2) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 3) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 4) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 5) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
x$E %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 6) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
x$E %>% as.character(),
|
|
||||||
x$F %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 7) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
x$E %>% as.character(),
|
|
||||||
x$F %>% as.character(),
|
|
||||||
x$G %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 8) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
x$E %>% as.character(),
|
|
||||||
x$F %>% as.character(),
|
|
||||||
x$G %>% as.character(),
|
|
||||||
x$H %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
} else if (ncol(x) == 9) {
|
|
||||||
x$total <- paste(x$A %>% as.character(),
|
|
||||||
x$B %>% as.character(),
|
|
||||||
x$C %>% as.character(),
|
|
||||||
x$D %>% as.character(),
|
|
||||||
x$E %>% as.character(),
|
|
||||||
x$F %>% as.character(),
|
|
||||||
x$G %>% as.character(),
|
|
||||||
x$H %>% as.character(),
|
|
||||||
x$I %>% as.character(),
|
|
||||||
sep = sep)
|
|
||||||
}
|
|
||||||
|
|
||||||
x <- x$total
|
|
||||||
|
|
||||||
} else {
|
} else {
|
||||||
stop('A maximum of 9 columns can be analysed at the same time.', call. = FALSE)
|
stop('A maximum of 9 columns can be analysed at the same time.', call. = FALSE)
|
||||||
}
|
}
|
||||||
@ -585,7 +508,7 @@ diff.frequency_tbl <- function(x, y, ...) {
|
|||||||
#' @exportMethod print.frequency_tbl
|
#' @exportMethod print.frequency_tbl
|
||||||
#' @importFrom knitr kable
|
#' @importFrom knitr kable
|
||||||
#' @importFrom dplyr n_distinct
|
#' @importFrom dplyr n_distinct
|
||||||
#' @importFrom crayon bold
|
#' @importFrom crayon bold silver
|
||||||
#' @export
|
#' @export
|
||||||
print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default = 15), ...) {
|
print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default = 15), ...) {
|
||||||
|
|
||||||
@ -629,6 +552,9 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
if (!is.null(opt$header_txt)) {
|
if (!is.null(opt$header_txt)) {
|
||||||
cat(opt$header_txt)
|
cat(opt$header_txt)
|
||||||
}
|
}
|
||||||
|
} else if (opt$tbl_format == "markdown") {
|
||||||
|
# do print title as caption in markdown
|
||||||
|
cat("\n", title, sep = "")
|
||||||
}
|
}
|
||||||
|
|
||||||
if (NROW(x) == 0) {
|
if (NROW(x) == 0) {
|
||||||
@ -671,6 +597,9 @@ print.frequency_tbl <- function(x, nmax = getOption("max.print.freq", default =
|
|||||||
' (',
|
' (',
|
||||||
(x.unprinted / (x.unprinted + x.printed)) %>% percent(force_zero = TRUE),
|
(x.unprinted / (x.unprinted + x.printed)) %>% percent(force_zero = TRUE),
|
||||||
') ]\n', sep = '')
|
') ]\n', sep = '')
|
||||||
|
if (opt$tbl_format == "pandoc") {
|
||||||
|
footer <- silver(footer) # only silver in regular printing
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
footer <- NULL
|
footer <- NULL
|
||||||
}
|
}
|
||||||
|
@ -23,6 +23,7 @@
|
|||||||
#' @param position position adjustment of bars, either \code{"fill"} (default when \code{fun} is \code{\link{count_df}}), \code{"stack"} (default when \code{fun} is \code{\link{portion_df}}) or \code{"dodge"}
|
#' @param position position adjustment of bars, either \code{"fill"} (default when \code{fun} is \code{\link{count_df}}), \code{"stack"} (default when \code{fun} is \code{\link{portion_df}}) or \code{"dodge"}
|
||||||
#' @param x variable to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
|
#' @param x variable to show on x axis, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
|
||||||
#' @param fill variable to categorise using the plots legend, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
|
#' @param fill variable to categorise using the plots legend, either \code{"Antibiotic"} (default) or \code{"Interpretation"} or a grouping variable
|
||||||
|
#' @param breaks numeric vector of positions
|
||||||
#' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable
|
#' @param facet variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable
|
||||||
#' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.
|
#' @param translate_ab a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.
|
||||||
#' @param fun function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}}
|
#' @param fun function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}}
|
||||||
@ -136,6 +137,7 @@ ggplot_rsi <- function(data,
|
|||||||
fill = "Interpretation",
|
fill = "Interpretation",
|
||||||
# params = list(),
|
# params = list(),
|
||||||
facet = NULL,
|
facet = NULL,
|
||||||
|
breaks = seq(0, 1, 0.1),
|
||||||
translate_ab = "official",
|
translate_ab = "official",
|
||||||
fun = count_df,
|
fun = count_df,
|
||||||
nrow = NULL,
|
nrow = NULL,
|
||||||
@ -189,7 +191,7 @@ ggplot_rsi <- function(data,
|
|||||||
if (fun_name == "portion_df"
|
if (fun_name == "portion_df"
|
||||||
| (fun_name == "count_df" & position == "fill")) {
|
| (fun_name == "count_df" & position == "fill")) {
|
||||||
# portions, so use y scale with percentage
|
# portions, so use y scale with percentage
|
||||||
p <- p + scale_y_percent()
|
p <- p + scale_y_percent(breaks = breaks)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (fun_name == "count_df" & datalabels == TRUE) {
|
if (fun_name == "count_df" & datalabels == TRUE) {
|
||||||
@ -281,9 +283,9 @@ facet_rsi <- function(facet = c("Interpretation", "Antibiotic"), nrow = NULL) {
|
|||||||
|
|
||||||
#' @rdname ggplot_rsi
|
#' @rdname ggplot_rsi
|
||||||
#' @export
|
#' @export
|
||||||
scale_y_percent <- function() {
|
scale_y_percent <- function(breaks = seq(0, 1, 0.1)) {
|
||||||
ggplot2::scale_y_continuous(breaks = seq(0, 1, 0.1),
|
ggplot2::scale_y_continuous(breaks = breaks,
|
||||||
labels = percent(seq(0, 1, 0.1)))
|
labels = percent(breaks))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname ggplot_rsi
|
#' @rdname ggplot_rsi
|
||||||
|
14
README.md
14
README.md
@ -3,15 +3,17 @@
|
|||||||
|
|
||||||
This R package was created for academic research by PhD students of the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the Medical Microbiology & Infection Prevention (MMBI) department of the [University Medical Center Groningen (UMCG)](https://www.umcg.nl).
|
This R package was created for academic research by PhD students of the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the Medical Microbiology & Infection Prevention (MMBI) department of the [University Medical Center Groningen (UMCG)](https://www.umcg.nl).
|
||||||
|
|
||||||
:arrow_forward: Get it with `install.packages("AMR")` or see below for other possibilities. Read all changes and new functions in **[NEWS.md](https://github.com/msberends/AMR/blob/master/NEWS.md)**.
|
:arrow_forward: Get it with `install.packages("AMR")` or see below for other possibilities.
|
||||||
|
|
||||||
|
:arrow_forward: Read the [changelog here](https://github.com/msberends/AMR/blob/master/NEWS.md).
|
||||||
|
|
||||||
## Authors
|
## Authors
|
||||||
<a href="https://orcid.org/0000-0001-7620-1800"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> Matthijs S. Berends<sup>1,2,a</sup>,
|
Matthijs S. Berends <a href="https://orcid.org/0000-0001-7620-1800"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> <sup>1,2,a</sup>,
|
||||||
<a href="https://orcid.org/0000-0001-5809-5995"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> Christian F. Luz<sup>1,a</sup>,
|
Christian F. Luz <a href="https://orcid.org/0000-0001-5809-5995"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> <sup>1,a</sup>,
|
||||||
Erwin E.A. Hassing<sup>2</sup>,
|
Erwin E.A. Hassing<sup>2</sup>,
|
||||||
<a href="https://orcid.org/0000-0003-1241-1328"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> Corinna Glasner<sup>1,b</sup>,
|
Corinna Glasner <a href="https://orcid.org/0000-0003-1241-1328"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> <sup>1,b</sup>,
|
||||||
<a href="https://orcid.org/0000-0003-4881-038X"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> Alex W. Friedrich<sup>1,b</sup>,
|
Alex W. Friedrich <a href="https://orcid.org/0000-0003-4881-038X"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> <sup>1,b</sup>,
|
||||||
<a href="https://orcid.org/0000-0003-1634-0010"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> Bhanu Sinha<sup>1,b</sup>
|
Bhanu Sinha <a href="https://orcid.org/0000-0003-1634-0010"><img src="https://cran.r-project.org/web/orcid.svg" height="16px"></a> <sup>1,b</sup>
|
||||||
|
|
||||||
<sup>1</sup> Department of Medical Microbiology, University of Groningen, University Medical Center Groningen, Groningen, the Netherlands - [rug.nl](http://www.rug.nl) [umcg.nl](http://www.umcg.nl)<br>
|
<sup>1</sup> Department of Medical Microbiology, University of Groningen, University Medical Center Groningen, Groningen, the Netherlands - [rug.nl](http://www.rug.nl) [umcg.nl](http://www.umcg.nl)<br>
|
||||||
<sup>2</sup> Certe Medical Diagnostics & Advice, Groningen, the Netherlands - [certe.nl](http://www.certe.nl)<br>
|
<sup>2</sup> Certe Medical Diagnostics & Advice, Groningen, the Netherlands - [certe.nl](http://www.certe.nl)<br>
|
||||||
|
@ -33,6 +33,7 @@ In the ATC classification system, the active substances are classified in a hier
|
|||||||
as.atc("J01FA01")
|
as.atc("J01FA01")
|
||||||
as.atc("Erythromycin")
|
as.atc("Erythromycin")
|
||||||
as.atc("eryt")
|
as.atc("eryt")
|
||||||
|
as.atc(" eryt 123")
|
||||||
as.atc("ERYT")
|
as.atc("ERYT")
|
||||||
as.atc("ERY")
|
as.atc("ERY")
|
||||||
as.atc("Erythrocin") # Trade name
|
as.atc("Erythrocin") # Trade name
|
||||||
|
26
man/freq.Rd
26
man/freq.Rd
@ -9,12 +9,12 @@
|
|||||||
\usage{
|
\usage{
|
||||||
frequency_tbl(x, ..., sort.count = TRUE,
|
frequency_tbl(x, ..., sort.count = TRUE,
|
||||||
nmax = getOption("max.print.freq"), na.rm = TRUE, row.names = TRUE,
|
nmax = getOption("max.print.freq"), na.rm = TRUE, row.names = TRUE,
|
||||||
markdown = FALSE, digits = 2, quote = FALSE, header = !markdown,
|
markdown = !interactive(), digits = 2, quote = FALSE,
|
||||||
sep = " ")
|
header = !markdown, sep = " ")
|
||||||
|
|
||||||
freq(x, ..., sort.count = TRUE, nmax = getOption("max.print.freq"),
|
freq(x, ..., sort.count = TRUE, nmax = getOption("max.print.freq"),
|
||||||
na.rm = TRUE, row.names = TRUE, markdown = FALSE, digits = 2,
|
na.rm = TRUE, row.names = TRUE, markdown = !interactive(),
|
||||||
quote = FALSE, header = !markdown, sep = " ")
|
digits = 2, quote = FALSE, header = !markdown, sep = " ")
|
||||||
|
|
||||||
top_freq(f, n)
|
top_freq(f, n)
|
||||||
|
|
||||||
@ -30,13 +30,13 @@ top_freq(f, n)
|
|||||||
|
|
||||||
\item{nmax}{number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.}
|
\item{nmax}{number of row to print. The default, \code{15}, uses \code{\link{getOption}("max.print.freq")}. Use \code{nmax = 0}, \code{nmax = Inf}, \code{nmax = NULL} or \code{nmax = NA} to print all rows.}
|
||||||
|
|
||||||
\item{na.rm}{a logical value indicating whether \code{NA} values should be removed from the frequency table. The header_txt will always print the amount of \code{NA}s.}
|
\item{na.rm}{a logical value indicating whether \code{NA} values should be removed from the frequency table. The header will always print the amount of \code{NA}s.}
|
||||||
|
|
||||||
\item{row.names}{a logical value indicating whether row indices should be printed as \code{1:nrow(x)}}
|
\item{row.names}{a logical value indicating whether row indices should be printed as \code{1:nrow(x)}}
|
||||||
|
|
||||||
\item{markdown}{print table in markdown format (this forces \code{nmax = NA})}
|
\item{markdown}{a logical value indicating whether the frequency table should be printed in markdown format. This will print all rows and is default behaviour in non-interactive R sessions (like when knitting RMarkdown files).}
|
||||||
|
|
||||||
\item{digits}{how many significant digits are to be used for numeric values in the header_txt (not for the items themselves, that depends on \code{\link{getOption}("digits")})}
|
\item{digits}{how many significant digits are to be used for numeric values in the header (not for the items themselves, that depends on \code{\link{getOption}("digits")})}
|
||||||
|
|
||||||
\item{quote}{a logical value indicating whether or not strings should be printed with surrounding quotes}
|
\item{quote}{a logical value indicating whether or not strings should be printed with surrounding quotes}
|
||||||
|
|
||||||
@ -57,7 +57,7 @@ Create a frequency table of a vector with items or a data frame. Supports quasiq
|
|||||||
\details{
|
\details{
|
||||||
Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
|
Frequency tables (or frequency distributions) are summaries of the distribution of values in a sample. With the `freq` function, you can create univariate frequency tables. Multiple variables will be pasted into one variable, so it forces a univariate distribution. This package also has a vignette available to explain the use of this function further, run \code{browseVignettes("AMR")} to read it.
|
||||||
|
|
||||||
For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header_txt:
|
For numeric values of any class, these additional values will all be calculated with \code{na.rm = TRUE} and shown into the header:
|
||||||
\itemize{
|
\itemize{
|
||||||
\item{Mean, using \code{\link[base]{mean}}}
|
\item{Mean, using \code{\link[base]{mean}}}
|
||||||
\item{Standard Deviation, using \code{\link[stats]{sd}}}
|
\item{Standard Deviation, using \code{\link[stats]{sd}}}
|
||||||
@ -69,7 +69,7 @@ For numeric values of any class, these additional values will all be calculated
|
|||||||
\item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
|
\item{Outliers (total count and unique count), using \code{\link[grDevices]{boxplot.stats}}}
|
||||||
}
|
}
|
||||||
|
|
||||||
For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header_txt:
|
For dates and times of any class, these additional values will be calculated with \code{na.rm = TRUE} and shown into the header:
|
||||||
\itemize{
|
\itemize{
|
||||||
\item{Oldest, using \code{\link{min}}}
|
\item{Oldest, using \code{\link{min}}}
|
||||||
\item{Newest, using \code{\link{max}}, with difference between newest and oldest}
|
\item{Newest, using \code{\link{max}}, with difference between newest and oldest}
|
||||||
@ -153,14 +153,6 @@ table(septic_patients$gender,
|
|||||||
# check differences between frequency tables
|
# check differences between frequency tables
|
||||||
diff(freq(septic_patients$trim),
|
diff(freq(septic_patients$trim),
|
||||||
freq(septic_patients$trsu))
|
freq(septic_patients$trsu))
|
||||||
|
|
||||||
\dontrun{
|
|
||||||
# send frequency table to clipboard (e.g. for pasting in Excel)
|
|
||||||
septic_patients \%>\%
|
|
||||||
freq(age) \%>\%
|
|
||||||
format() \%>\% # this will format the percentages
|
|
||||||
clipboard_export()
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
\keyword{freq}
|
\keyword{freq}
|
||||||
\keyword{frequency}
|
\keyword{frequency}
|
||||||
|
@ -11,9 +11,10 @@
|
|||||||
\title{AMR bar plots with \code{ggplot}}
|
\title{AMR bar plots with \code{ggplot}}
|
||||||
\usage{
|
\usage{
|
||||||
ggplot_rsi(data, position = NULL, x = "Antibiotic",
|
ggplot_rsi(data, position = NULL, x = "Antibiotic",
|
||||||
fill = "Interpretation", facet = NULL, translate_ab = "official",
|
fill = "Interpretation", facet = NULL, breaks = seq(0, 1, 0.1),
|
||||||
fun = count_df, nrow = NULL, datalabels = TRUE,
|
translate_ab = "official", fun = count_df, nrow = NULL,
|
||||||
datalabels.size = 3, datalabels.colour = "grey15", ...)
|
datalabels = TRUE, datalabels.size = 3,
|
||||||
|
datalabels.colour = "grey15", ...)
|
||||||
|
|
||||||
geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"),
|
geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"),
|
||||||
fill = "Interpretation", translate_ab = "official", fun = count_df,
|
fill = "Interpretation", translate_ab = "official", fun = count_df,
|
||||||
@ -21,7 +22,7 @@ geom_rsi(position = NULL, x = c("Antibiotic", "Interpretation"),
|
|||||||
|
|
||||||
facet_rsi(facet = c("Interpretation", "Antibiotic"), nrow = NULL)
|
facet_rsi(facet = c("Interpretation", "Antibiotic"), nrow = NULL)
|
||||||
|
|
||||||
scale_y_percent()
|
scale_y_percent(breaks = seq(0, 1, 0.1))
|
||||||
|
|
||||||
scale_rsi_colours()
|
scale_rsi_colours()
|
||||||
|
|
||||||
@ -41,6 +42,8 @@ labels_rsi_count(position = NULL, x = "Antibiotic",
|
|||||||
|
|
||||||
\item{facet}{variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable}
|
\item{facet}{variable to split plots by, either \code{"Interpretation"} (default) or \code{"Antibiotic"} or a grouping variable}
|
||||||
|
|
||||||
|
\item{breaks}{numeric vector of positions}
|
||||||
|
|
||||||
\item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.}
|
\item{translate_ab}{a column name of the \code{\link{antibiotics}} data set to translate the antibiotic abbreviations into, using \code{\link{abname}}. Default behaviour is to translate to official names according to the WHO. Use \code{translate_ab = FALSE} to disable translation.}
|
||||||
|
|
||||||
\item{fun}{function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}}}
|
\item{fun}{function to transform \code{data}, either \code{\link{count_df}} (default) or \code{\link{portion_df}}}
|
||||||
|
@ -13,7 +13,10 @@ test_that("abname works", {
|
|||||||
|
|
||||||
expect_error(abname("AMOX", to = c(1:3)))
|
expect_error(abname("AMOX", to = c(1:3)))
|
||||||
expect_error(abname("AMOX", to = "test"))
|
expect_error(abname("AMOX", to = "test"))
|
||||||
expect_warning(abname("TEST
|
expect_warning(abname("NOTEXISTING
|
||||||
"))
|
"))
|
||||||
expect_warning(abname("AMOX or GENT"))
|
expect_warning(abname("AMOX or GENT"))
|
||||||
|
|
||||||
|
# this one is being found with as.atc internally
|
||||||
|
expect_equal(abname("flu_clox123"), "Flucloxacillin")
|
||||||
})
|
})
|
||||||
|
Loading…
Reference in New Issue
Block a user