mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 18:46:11 +01:00
rsi for freq
This commit is contained in:
parent
d8f70a74de
commit
edd2dd09dc
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 0.2.0.9018
|
||||
Date: 2018-07-30
|
||||
Version: 0.2.0.9019
|
||||
Date: 2018-08-01
|
||||
Title: Antimicrobial Resistance Analysis
|
||||
Authors@R: c(
|
||||
person(
|
||||
|
5
NEWS.md
5
NEWS.md
@ -17,6 +17,7 @@
|
||||
* Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS. These functions use the `clipr` package, but are a little altered to also support headless Linux servers (so you can use it in RStudio Server)
|
||||
* New for frequency tables (function `freq`):
|
||||
* A vignette to explain its usage
|
||||
* Support for `rsi` (antimicrobial resistance) to use as input
|
||||
* Support for `table` to use as input: `freq(table(x, y))`
|
||||
* Support for existing functions `hist` and `plot` to use a frequency table as input: `hist(freq(df$age))`
|
||||
* Support for `as.vector`, `as.data.frame`, `as_tibble` and `format`
|
||||
@ -30,9 +31,9 @@
|
||||
* More antibiotics for EUCAST rules
|
||||
* Updated version of the `septic_patients` data set to better reflect the reality
|
||||
* Pretty printing for tibbles removed as it is not really the scope of this package
|
||||
* Printing of `mic` and `rsi` classes now returns all values - use `freq` to check distributions
|
||||
* Improved speed of key antibiotics comparison for determining first isolates
|
||||
* Column names for the `key_antibiotics` function are now generic: 6 for broadspectrum ABs, 6 for Gram-positive specific and 6 for Gram-negative specific ABs
|
||||
* Printing of class `mic` now shows all MIC values
|
||||
* `%like%` now supports multiple patterns
|
||||
* Frequency tables are now actual `data.frame`s with altered console printing to make it look like a frequency table. Because of this, the parameter `toConsole` is not longer needed.
|
||||
* Fix for `freq` where the class of an item would be lost
|
||||
@ -52,7 +53,7 @@
|
||||
* Other small fixes
|
||||
|
||||
#### Other
|
||||
* Unit testing for all Linux and macOS release of R 3.1 and higher: https://travis-ci.org/msberends/AMR
|
||||
* Unit testing for all Linux and macOS releases of R 3.1 and higher: https://travis-ci.org/msberends/AMR
|
||||
|
||||
# 0.2.0 (latest stable version)
|
||||
**Published on CRAN: 2018-05-03**
|
||||
|
44
R/classes.R
44
R/classes.R
@ -36,6 +36,7 @@
|
||||
#'
|
||||
#' plot(rsi_data) # for percentages
|
||||
#' barplot(rsi_data) # for frequencies
|
||||
#' freq(rsi_data) # frequency table with informative header
|
||||
as.rsi <- function(x) {
|
||||
if (is.rsi(x)) {
|
||||
x
|
||||
@ -92,39 +93,17 @@ is.rsi <- function(x) {
|
||||
#' @importFrom dplyr %>%
|
||||
#' @noRd
|
||||
print.rsi <- function(x, ...) {
|
||||
n_total <- x %>% length()
|
||||
x <- x[!is.na(x)]
|
||||
n <- x %>% length()
|
||||
S <- x[x == 'S'] %>% length()
|
||||
I <- x[x == 'I'] %>% length()
|
||||
R <- x[x == 'R'] %>% length()
|
||||
IR <- x[x %in% c('I', 'R')] %>% length()
|
||||
cat("Class 'rsi'\n")
|
||||
cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n_total, force_zero = TRUE), ')\n', sep = "")
|
||||
if (n > 0) {
|
||||
cat('\n')
|
||||
cat('Sum of S: ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('Sum of IR: ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('- Sum of I: ', I, ' (', percent(I / n, force_zero = TRUE), ')\n', sep = "")
|
||||
}
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @exportMethod summary.rsi
|
||||
#' @export
|
||||
#' @importFrom dplyr %>%
|
||||
#' @noRd
|
||||
summary.rsi <- function(object, ...) {
|
||||
x <- object
|
||||
n_total <- x %>% length()
|
||||
x <- x[!is.na(x)]
|
||||
n <- x %>% length()
|
||||
S <- x[x == 'S'] %>% length()
|
||||
I <- x[x == 'I'] %>% length()
|
||||
R <- x[x == 'R'] %>% length()
|
||||
IR <- x[x %in% c('I', 'R')] %>% length()
|
||||
lst <- c('rsi', n_total - n, S, IR, R, I)
|
||||
names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "Sum R", "Sum I")
|
||||
lst <- c('rsi', sum(is.na(x)), sum(x == "S"), sum(x %in% c("I", "R")), sum(x == "R"), sum(x == "I"))
|
||||
names(lst) <- c("Mode", "<NA>", "Sum S", "Sum IR", "-Sum R", "-Sum I")
|
||||
lst
|
||||
}
|
||||
|
||||
@ -213,6 +192,7 @@ barplot.rsi <- function(height, ...) {
|
||||
#'
|
||||
#' plot(mic_data)
|
||||
#' barplot(mic_data)
|
||||
#' freq(mic_data)
|
||||
as.mic <- function(x, na.rm = FALSE) {
|
||||
if (is.mic(x)) {
|
||||
x
|
||||
@ -363,18 +343,8 @@ as.numeric.mic <- function(x, ...) {
|
||||
#' @importFrom dplyr %>% tibble group_by summarise pull
|
||||
#' @noRd
|
||||
print.mic <- function(x, ...) {
|
||||
n_total <- x %>% length()
|
||||
x <- x[!is.na(x)]
|
||||
n <- x %>% length()
|
||||
cat("Class 'mic'\n")
|
||||
cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n_total, force_zero = TRUE), ')\n', sep = "")
|
||||
if (n > 0) {
|
||||
cat('\n')
|
||||
tibble(MIC = x, y = 1) %>%
|
||||
group_by(MIC) %>%
|
||||
summarise(n = sum(y)) %>%
|
||||
base::print.data.frame(row.names = FALSE)
|
||||
}
|
||||
print(as.character(x), quote = FALSE)
|
||||
}
|
||||
|
||||
#' @exportMethod summary.mic
|
||||
@ -406,7 +376,6 @@ plot.mic <- function(x, ...) {
|
||||
|
||||
#' @exportMethod barplot.mic
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% group_by summarise
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @noRd
|
||||
barplot.mic <- function(height, ...) {
|
||||
@ -415,6 +384,7 @@ barplot.mic <- function(height, ...) {
|
||||
}
|
||||
|
||||
#' @importFrom graphics barplot axis
|
||||
#' @importFrom dplyr %>% group_by summarise
|
||||
create_barplot_mic <- function(x, x_name, ...) {
|
||||
data <- data.frame(mic = x, cnt = 1) %>%
|
||||
group_by(mic) %>%
|
||||
|
13
R/freq.R
13
R/freq.R
@ -305,7 +305,7 @@ frequency_tbl <- function(x,
|
||||
|
||||
header <- header %>% paste0(markdown_line, '\nLength: ', (NAs %>% length() + x %>% length()) %>% format(),
|
||||
' (of which NA: ', NAs %>% length() %>% format(),
|
||||
' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE) %>% sub('NaN', '0', ., fixed = TRUE), ')')
|
||||
' = ', (NAs %>% length() / (NAs %>% length() + x %>% length())) %>% percent(force_zero = TRUE, round = digits) %>% sub('NaN', '0', ., fixed = TRUE), ')')
|
||||
header <- header %>% paste0(markdown_line, '\nUnique: ', x %>% n_distinct() %>% format())
|
||||
|
||||
if (NROW(x) > 0 & any(class(x) %in% c('double', 'integer', 'numeric', 'raw', 'single'))) {
|
||||
@ -326,6 +326,17 @@ frequency_tbl <- function(x,
|
||||
header <- header %>% paste0(' (unique: ', boxplot.stats(x)$out %>% n_distinct(), ')')
|
||||
}
|
||||
}
|
||||
if (any(class(x) == "rsi")) {
|
||||
header <- header %>% paste0('\n')
|
||||
cnt_S <- sum(x == "S")
|
||||
cnt_I <- sum(x == "I")
|
||||
cnt_R <- sum(x == "R")
|
||||
header <- header %>% paste(markdown_line, '\n%IR: ',
|
||||
((cnt_I + cnt_R) / sum(!is.na(x))) %>% percent(force_zero = TRUE, round = digits))
|
||||
header <- header %>% paste0(markdown_line, '\nRatio SIR: 1.0 : ',
|
||||
(cnt_I / cnt_S) %>% format(digits = 1, nsmall = 1), " : ",
|
||||
(cnt_R / cnt_S) %>% format(digits = 1, nsmall = 1))
|
||||
}
|
||||
|
||||
formatdates <- "%e %B %Y" # = d mmmm yyyy
|
||||
if (any(class(x) == 'hms')) {
|
||||
|
@ -29,6 +29,7 @@ as.mic("<=0.002; S") # will return <=0.002
|
||||
|
||||
plot(mic_data)
|
||||
barplot(mic_data)
|
||||
freq(mic_data)
|
||||
}
|
||||
\seealso{
|
||||
\code{\link{as.rsi}}
|
||||
|
@ -28,6 +28,7 @@ as.rsi("<= 0.002; S") # will return S
|
||||
|
||||
plot(rsi_data) # for percentages
|
||||
barplot(rsi_data) # for frequencies
|
||||
freq(rsi_data) # frequency table with informative header
|
||||
}
|
||||
\seealso{
|
||||
\code{\link{as.mic}}
|
||||
|
@ -17,8 +17,8 @@ test_that("rsi works", {
|
||||
"<NA>" = "0",
|
||||
"Sum S" = "1",
|
||||
"Sum IR" = "1",
|
||||
"Sum R" = "1",
|
||||
"Sum I" = "0"))
|
||||
"-Sum R" = "1",
|
||||
"-Sum I" = "0"))
|
||||
})
|
||||
|
||||
test_that("mic works", {
|
||||
|
@ -19,6 +19,8 @@ test_that("frequency table works", {
|
||||
expect_output(print(freq(septic_patients$hospital_id)))
|
||||
# table
|
||||
expect_output(print(freq(table(septic_patients$sex, septic_patients$age))))
|
||||
# rsi
|
||||
expect_output(print(freq(septic_patients$amcl)))
|
||||
|
||||
library(dplyr)
|
||||
expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())
|
||||
|
Loading…
Reference in New Issue
Block a user