1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 20:06:12 +01:00

import from graphics

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-03-13 15:40:10 +01:00
parent 53959d40c7
commit 46db3f7b13
No known key found for this signature in database
GPG Key ID: AE86720DBCDA4567
4 changed files with 44 additions and 33 deletions

View File

@ -65,6 +65,8 @@ importFrom(dplyr,slice)
importFrom(dplyr,summarise) importFrom(dplyr,summarise)
importFrom(dplyr,tibble) importFrom(dplyr,tibble)
importFrom(dplyr,vars) importFrom(dplyr,vars)
importFrom(graphics,axis)
importFrom(graphics,barplot)
importFrom(graphics,plot) importFrom(graphics,plot)
importFrom(graphics,text) importFrom(graphics,text)
importFrom(reshape2,dcast) importFrom(reshape2,dcast)

View File

@ -28,7 +28,8 @@
#' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370))) #' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
#' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C")) #' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
#' is.rsi(rsi_data) #' is.rsi(rsi_data)
#' plot(rsi_data) #' plot(rsi_data) # for percentages
#' barplot(rsi_data) # for frequencies
#' #'
#' \donttest{ #' \donttest{
#' library(dplyr) #' library(dplyr)
@ -166,17 +167,18 @@ plot.rsi <- function(x, ...) {
#' @exportMethod barplot.rsi #' @exportMethod barplot.rsi
#' @export #' @export
#' @importFrom dplyr %>% group_by summarise filter mutate if_else n_distinct #' @importFrom dplyr %>% group_by summarise filter mutate if_else n_distinct
#' @importFrom graphics plot text #' @importFrom graphics barplot axis
#' @noRd #' @noRd
barplot.rsi <- function(x, ...) { barplot.rsi <- function(height, ...) {
x_name <- deparse(substitute(x)) x <- height
x_name <- deparse(substitute(height))
data <- data.frame(rsi = x, cnt = 1) %>% data <- data.frame(rsi = x, cnt = 1) %>%
group_by(rsi) %>% group_by(rsi) %>%
summarise(cnt = sum(cnt)) %>% summarise(cnt = sum(cnt)) %>%
droplevels() droplevels()
barplot(table(rsi_data), barplot(table(x),
col = c('green3', 'orange2', 'red3'), col = c('green3', 'orange2', 'red3'),
xlab = 'Antimicrobial Interpretation', xlab = 'Antimicrobial Interpretation',
main = paste('Susceptibilty Analysis of', x_name), main = paste('Susceptibilty Analysis of', x_name),
@ -395,13 +397,14 @@ plot.mic <- function(x, ...) {
#' @exportMethod barplot.mic #' @exportMethod barplot.mic
#' @export #' @export
#' @importFrom dplyr %>% group_by summarise #' @importFrom dplyr %>% group_by summarise
#' @importFrom graphics plot text #' @importFrom graphics barplot axis
#' @noRd #' @noRd
barplot.mic <- function(x, ...) { barplot.mic <- function(height, ...) {
x_name <- deparse(substitute(x)) x_name <- deparse(substitute(height))
create_barplot_mic(x, x_name, ...) create_barplot_mic(height, x_name, ...)
} }
#' @importFrom graphics barplot axis
create_barplot_mic <- function(x, x_name, ...) { create_barplot_mic <- function(x, x_name, ...) {
data <- data.frame(mic = x, cnt = 1) %>% data <- data.frame(mic = x, cnt = 1) %>%
group_by(mic) %>% group_by(mic) %>%

View File

@ -13,28 +13,29 @@ EUCAST Expert Rules Version 2.0: \cr
\url{http://www.eucast.org/expert_rules_and_intrinsic_resistance} \url{http://www.eucast.org/expert_rules_and_intrinsic_resistance}
} }
\usage{ \usage{
EUCAST_rules(tbl, col_bactcode, info = TRUE, amcl = "amcl", amik = "amik", EUCAST_rules(tbl, col_bactcode = "bactid", info = TRUE, amcl = "amcl",
amox = "amox", ampi = "ampi", azit = "azit", aztr = "aztr", amik = "amik", amox = "amox", ampi = "ampi", azit = "azit",
cefa = "cefa", cfra = "cfra", cfep = "cfep", cfot = "cfot", aztr = "aztr", cefa = "cefa", cfra = "cfra", cfep = "cfep",
cfox = "cfox", cfta = "cfta", cftr = "cftr", cfur = "cfur", cfot = "cfot", cfox = "cfox", cfta = "cfta", cftr = "cftr",
chlo = "chlo", cipr = "cipr", clar = "clar", clin = "clin", cfur = "cfur", chlo = "chlo", cipr = "cipr", clar = "clar",
clox = "clox", coli = "coli", czol = "czol", dapt = "dapt", clin = "clin", clox = "clox", coli = "coli", czol = "czol",
doxy = "doxy", erta = "erta", eryt = "eryt", fosf = "fosf", dapt = "dapt", doxy = "doxy", erta = "erta", eryt = "eryt",
fusi = "fusi", gent = "gent", imip = "imip", kana = "kana", fosf = "fosf", fusi = "fusi", gent = "gent", imip = "imip",
levo = "levo", linc = "linc", line = "line", mero = "mero", kana = "kana", levo = "levo", linc = "linc", line = "line",
mino = "mino", moxi = "moxi", nali = "nali", neom = "neom", mero = "mero", mino = "mino", moxi = "moxi", nali = "nali",
neti = "neti", nitr = "nitr", novo = "novo", norf = "norf", neom = "neom", neti = "neti", nitr = "nitr", novo = "novo",
oflo = "oflo", peni = "peni", pita = "pita", poly = "poly", norf = "norf", oflo = "oflo", peni = "peni", pita = "pita",
qida = "qida", rifa = "rifa", roxi = "roxi", siso = "siso", poly = "poly", qida = "qida", rifa = "rifa", roxi = "roxi",
teic = "teic", tetr = "tetr", tica = "tica", tige = "tige", siso = "siso", teic = "teic", tetr = "tetr", tica = "tica",
tobr = "tobr", trim = "trim", trsu = "trsu", vanc = "vanc") tige = "tige", tobr = "tobr", trim = "trim", trsu = "trsu",
vanc = "vanc")
interpretive_reading(...) interpretive_reading(...)
} }
\arguments{ \arguments{
\item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}} \item{tbl}{table with antibiotic columns, like e.g. \code{amox} and \code{amcl}}
\item{col_bactcode}{column name of the bacteria ID in \code{tbl} - should also be present in \code{bactlist$bactid}, see \code{\link{bactlist}}.} \item{col_bactcode}{column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{bactlist$bactid}, see \code{\link{bactlist}}}
\item{info}{print progress} \item{info}{print progress}
@ -49,15 +50,19 @@ table with edited variables of antibiotics.
Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}. Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}.
} }
\examples{ \examples{
a <- data.frame(bactid = c("STAAUR", "ESCCOL", "KLEPNE", "PSEAER"), a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
vanc = "-", "ENCFAE", # Enterococcus faecalis
amox = "-", "ESCCOL", # Escherichia coli
coli = "-", "KLEPNE", # Klebsiella pneumoniae
cfta = "-", "PSEAER"), # Pseudomonas aeruginosa
cfur = "-", vanc = "-", # Vancomycin
amox = "-", # Amoxicillin
coli = "-", # Colistin
cfta = "-", # Ceftazidime
cfur = "-", # Cefuroxime
stringsAsFactors = FALSE) stringsAsFactors = FALSE)
a a
b <- EUCAST_rules(a, "bactid") b <- EUCAST_rules(a)
b b
} }

View File

@ -22,7 +22,8 @@ This transforms a vector to a new class \code{rsi}, which is an ordered factor w
rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370))) rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C")) rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
is.rsi(rsi_data) is.rsi(rsi_data)
plot(rsi_data) plot(rsi_data) # for percentages
barplot(rsi_data) # for frequencies
\donttest{ \donttest{
library(dplyr) library(dplyr)