From 6f7730dcaaedbda6f7a05bb5bdf6c1c82de09f00 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Tue, 27 Mar 2018 17:43:42 +0200 Subject: [PATCH] add tests using testthat --- DESCRIPTION | 3 ++- R/EUCAST.R | 4 +-- R/classes.R | 2 +- R/clipboard.R | 9 ++++--- R/first_isolates.R | 12 ++++++--- R/join.R | 6 ++++- R/rsi_analysis.R | 9 ++++--- man/clipboard.Rd | 5 +++- man/rsi_predict.Rd | 3 +-- tests/testthat.R | 4 +++ tests/testthat/Rplots.pdf | Bin 0 -> 4854 bytes tests/testthat/test-atc.R | 15 +++++++++++ tests/testthat/test-classes.R | 37 ++++++++++++++++++++++++++ tests/testthat/test-clipboard.R | 9 +++++++ tests/testthat/test-eucast.R | 31 ++++++++++++++++++++++ tests/testthat/test-first_isolates.R | 23 ++++++++++++++++ tests/testthat/test-joins.R | 18 +++++++++++++ tests/testthat/test-misc.R | 20 ++++++++++++++ tests/testthat/test-rsi_analysis.R | 38 +++++++++++++++++++++++++++ 19 files changed, 231 insertions(+), 17 deletions(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/Rplots.pdf create mode 100644 tests/testthat/test-atc.R create mode 100644 tests/testthat/test-classes.R create mode 100644 tests/testthat/test-clipboard.R create mode 100644 tests/testthat/test-eucast.R create mode 100644 tests/testthat/test-first_isolates.R create mode 100644 tests/testthat/test-joins.R create mode 100644 tests/testthat/test-misc.R create mode 100644 tests/testthat/test-rsi_analysis.R diff --git a/DESCRIPTION b/DESCRIPTION index ac9a1b5c..32b2b224 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR Version: 0.1.2 -Date: 2018-03-23 +Date: 2018-03-27 Title: Antimicrobial Resistance Analysis Authors@R: c( person( @@ -26,6 +26,7 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR . Depends: R (>= 3.0) Imports: dplyr (>= 0.7.0), knitr, reshape2 (>= 1.4.0), xml2, rvest +Suggests: testthat URL: https://cran.r-project.org/package=AMR BugReports: https://github.com/msberends/AMR/issues License: GPL-2 | file LICENSE diff --git a/R/EUCAST.R b/R/EUCAST.R index ef70190a..4021fe7d 100644 --- a/R/EUCAST.R +++ b/R/EUCAST.R @@ -188,7 +188,7 @@ EUCAST_rules <- function(tbl, teic, tetr, tica, tige, tobr, trim, trsu, vanc) col.list <- col.list[!is.na(col.list)] col.list.bak <- col.list - # are they available as upper case then? + # are they available as upper case or lower case then? for (i in 1:length(col.list)) { if (toupper(col.list[i]) %in% colnames(tbl)) { col.list[i] <- toupper(col.list[i]) @@ -708,7 +708,7 @@ mo_property <- function(bactid, property = 'fullname') { result = tryCatch({ mocode[i] <- AMR::microorganisms %>% - filter(bactid == bactid) %>% + filter(bactid == bug) %>% select(property) %>% unlist() %>% as.character() diff --git a/R/classes.R b/R/classes.R index 88a392ce..795d1f2b 100644 --- a/R/classes.R +++ b/R/classes.R @@ -364,7 +364,7 @@ summary.mic <- function(object, ...) { x <- x[!is.na(x)] n <- x %>% length() return(c("Mode" = 'mic', - "NA" = n_total - n, + "" = n_total - n, "Min." = sort(x)[1] %>% as.character(), "Max." = sort(x)[n] %>% as.character() )) diff --git a/R/clipboard.R b/R/clipboard.R index d58556de..c719d114 100644 --- a/R/clipboard.R +++ b/R/clipboard.R @@ -7,6 +7,7 @@ #' @inheritParams utils::write.table #' @param startrow \emph{n}th row to start importing from. For \code{clipboard_import}, when \code{header = TRUE} the import will start on row \code{startrow} \emph{below} the header. #' @param as_vector a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header. +#' @param info print info about copying #' @keywords clipboard clipboard_import clipboard_export import export #' @importFrom dplyr %>% pull as_tibble #' @importFrom utils read.delim write.table object.size @@ -54,7 +55,8 @@ clipboard_export <- function(x, sep = '\t', dec = ".", na = "", - header = TRUE) { + header = TRUE, + info = TRUE) { x <- deparse(substitute(x)) size <- x %>% @@ -75,6 +77,7 @@ clipboard_export <- function(x, dec = dec, quote = FALSE) - cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n") - + if (info == TRUE) { + cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n") + } } diff --git a/R/first_isolates.R b/R/first_isolates.R index a32cff0b..907db5dc 100644 --- a/R/first_isolates.R +++ b/R/first_isolates.R @@ -448,6 +448,8 @@ key_antibiotics <- function(tbl, clin, clox, doxy, gent, line, mero, peni, pita, rifa, teic, trsu, vanc) col.list <- col.list[!is.na(col.list)] + col.list.bak <- col.list + # are they available as upper case or lower case then? for (i in 1:length(col.list)) { if (toupper(col.list[i]) %in% colnames(tbl)) { col.list[i] <- toupper(col.list[i]) @@ -459,8 +461,8 @@ key_antibiotics <- function(tbl, } if (!all(col.list %in% colnames(tbl))) { if (info == TRUE) { - warning('These columns do not exist and will be ignored:\n', - col.list[!(col.list %in% colnames(tbl))] %>% toString(), + warning('These columns do not exist and will be ignored: ', + col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(), immediate. = TRUE, call. = FALSE) } @@ -647,9 +649,13 @@ guess_bactid <- function(x) { for (i in 1:length(x)) { if (tolower(x[i]) == '^e.*coli$') { - # avoid detection of Entamoeba coli in case of Escherichia coli + # avoid detection of Entamoeba coli in case of E. coli x[i] <- 'Escherichia coli' } + if (tolower(x[i]) == '^h.*influenzae$') { + # avoid detection of Haematobacter influenzae in case of H. influenzae + x[i] <- 'Haemophilus influenzae' + } if (tolower(x[i]) == '^st.*au$' | tolower(x[i]) == '^stau$' | tolower(x[i]) == '^staaur$') { diff --git a/R/join.R b/R/join.R index dc474eb3..9dfc516b 100644 --- a/R/join.R +++ b/R/join.R @@ -96,7 +96,11 @@ full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) } else { joinby <- by } - dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...) + join <- dplyr::full_join(x = x, y = AMR::microorganisms, by = joinby, suffix = c("2", ""), ...) + if (nrow(join) > nrow(x)) { + warning('the newly joined tbl contains ', nrow(join) - nrow(x), ' rows more that its original') + } + join } #' @rdname join diff --git a/R/rsi_analysis.R b/R/rsi_analysis.R index 55edab3b..dc1a9dbd 100644 --- a/R/rsi_analysis.R +++ b/R/rsi_analysis.R @@ -67,7 +67,7 @@ rsi_df <- function(tbl, stop('Invalid `interpretation`; must be "S", "SI", "I", "IR", or "R".') } if ('is_ic' %in% colnames(tbl)) { - if (n_distinct(tbl$is_ic) > 1) { + if (n_distinct(tbl$is_ic) > 1 & warning == TRUE) { warning('Dataset contains isolates from the Intensive Care. Exclude them from proper epidemiological analysis.') } } @@ -280,8 +280,7 @@ rsi <- function(ab1, ab2 = NA, interpretation = 'IR', minimum = 30, percent = FA #' first_isolate(., #' "date", #' "patient_id", -#' "genus", -#' "species", +#' "bactid", #' col_specimen = NA, #' col_icu = NA)) %>% #' # filter on first E. coli isolates @@ -304,6 +303,10 @@ rsi_predict <- function(tbl, preserve_measurements = TRUE, info = TRUE) { + if (nrow(tbl) == 0) { + stop('This table does not contain any observations.') + } + col_ab <- quasiquotate(deparse(substitute(col_ab)), col_ab) if (!col_ab %in% colnames(tbl)) { stop('Column ', col_ab, ' not found.') diff --git a/man/clipboard.Rd b/man/clipboard.Rd index 2ac96484..15239f67 100644 --- a/man/clipboard.Rd +++ b/man/clipboard.Rd @@ -9,7 +9,8 @@ clipboard_import(sep = "\\t", header = TRUE, dec = ".", na = c("", "NA", "NULL"), startrow = 1, as_vector = TRUE) -clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE) +clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE, + info = TRUE) } \arguments{ \item{sep}{the field separator character. Values on each line of the @@ -33,6 +34,8 @@ clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE) \item{x}{the object to be written, preferably a matrix or data frame. If not, it is attempted to coerce \code{x} to a data frame.} + +\item{info}{print info about copying} } \value{ data.frame diff --git a/man/rsi_predict.Rd b/man/rsi_predict.Rd index 5caa6c67..ce9e70df 100644 --- a/man/rsi_predict.Rd +++ b/man/rsi_predict.Rd @@ -59,8 +59,7 @@ septic_patients \%>\% first_isolate(., "date", "patient_id", - "genus", - "species", + "bactid", col_specimen = NA, col_icu = NA)) \%>\% # filter on first E. coli isolates diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..42204d8a --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(AMR) + +test_check("AMR") diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..e73617d64e40efcf71003eb808339c26b3044b7a GIT binary patch literal 4854 zcmb7I2{@E(+ZG{OWKYCHgu<9H21R7Xl6}ig#u%EnF*BK&EE)Tj?ah*X&7RkXkS!u1 zWC!78nwiHp&dp@jw!;U{FNBm`oy&Nwi@m9(Wfr3hhDvsvrlIgVM0QTzEPp&3^to zI~wOgUj^j*Y5oN9|!sCBLzL( z@cbKsm-LoG)So-vtM)k_O*mpmz*^*X*Du8v0lX@(N4!s4H0$KE+L%63{#ep8yA!sg z9?RQ2sDBq3KKW7yee-0~gFEVP>~}#;a_^|(neqNEERCv>N?H*8q;}yYQbTpiiIi>C zuF5P_nz`krk1kkkR23&QYhXSZ`SO?@swWK)Qa$zicDyS8_(`?=&%AMsLl{qgU( zzEnqisxEYrSF*7;h;qsN+I{(?`-to9>jdOM%UJ2n7d`Jh%V{DM)RH`!mY<$+lmgS-97tx3jP7M*Lhs+02C&S0AK(?-brr1BKGhdejcT{4 zy`*HzKcupqWXKwVV`I9J$AzBQC7xL~2=geB>(-_!ztB7F{HUggn0d{`_tBq2^)mKu z+_;^$S-;&}eB-UtToS|KqIDjm3q!0+Hl;6$PAFK%OuR=o7Ozr6Y_v+}K37Zr{;qAK zmGT$^>%GUCn8$sB#Oxh*ljr@4QS(x@)frA@ebQoiTvUExiqd_193TEwyU*9uv9)sd zO=iq8pGW9@=eG?j2Rj-oN~~(i{05e(N*NWq6+Ns%PH<5j0*^B)V4~Jsr(Q;S@-yf1 zF#mC{H{HLSKV2vOI;|hip9p~TF)l>F4xsCX89--=8Q?%u89bS$77zerh<3psHSu16 z9i0)1@=*HE;RnH?3&uAZ&~y!DjwS(iAeyq$@}Rv)4(uRpn%DrUsvvC$0H*7i8I2NYowzBAV%F0*ZShXM&sAc`um|CYY=HGLPh%p^|> z^HIL={wAd+llY^Ni33-!m@(=eZqkjDI}K(#s@HOhK@5hlARtWR3J*Y}rULTdag}0` zq5DiL7xxPwhOZHL1d}ehlnG2e@LuUnpA^~jyPDn9|JrSZGSa|sYbTibk%2W^z@c1g zp6R*vh?pohC)Rz3RvDPE3{!-vDowsEZN^ka-d~zXyV;5L zHez4~la%PWk6WYm0{mUdYE~H%wZ>g3_o0S;@_Kz@HbD@}1mZ^-JKv2|G>6I>Bt%u9 zhuAlRUVSqzIUA$G)f^q?B)~s+V5=U|dfqzpe;A;e9kcuCddrLHT!OEiI zr657Fv)&9-x?Pu72SL_P`?-5K+WVf`%5jMoMF^a-HxG+R;EtN^?>C%_YJVz!L@DOv z4ESZLfQ`_!2ZL+>jt!5uyTCoMb1#)ul;z!J-J7L`{T+7F<2SD-IfnQz3m`4VuZE>`H%^$5#x;eJRIgn({SRi^_!%vt&>NF?7 zcEjb&zzXGHhYr){-l%7(DVf{-L0>6Wbp~Ib@QM4!qI3|DIxf?`_h~z}j8K3`%{ghA)!x>@|uN{0QeK3d!g311m7?*!#Pca5)Vkg zHFX(zH5PNsiiPfmE#$h++s#XnjyEtIhS%npUg4th`mmmqXDe*At>DBmS2-CgABYX% zZ|z!zD2vDi)wbLwF!>%`4l!;^p5nA-R}U=W3^>Yp_D+;MC*LD&%{VV{HcrvfTU_~! z7>%)8!ucZgk-Bk3PwaSDw6wq`28jo|MR-GJ?j+?}=ECysnzEW?7M~x!G%WQS`zKCA z?W=cspY_c%kYvsZWJbwpTjit=oS3hg=Ui8&^0EZyqN2gE$NUY1PVrVTRtZ!I4#ld3 z3Uovx3oEVvI6ES=7rzR!N+=nbwL%;#b$!6#=(g!{^u?NyB;&OE*}WlNAG zSP{7E1Riir99@a#XkT0H`GDTi_T}(9pdOnoD#abm_OB3K&C^KP-1q@)W&JvRuM6T_ zpCXJN6Yd1mg;`%zMW`AJNi<8C>bi=<6LpWZLE%42zESc-Jo-qfow!U}4!ZejmNO1X8e7vh@khY~KwF5R1Dk4Se@4^PFA(uwARV-BC-c=q^ADREu;gM;Nn1N55MoMi7^@hiuYY$J9C=64EhlXoQJWD2rG%zWckgIQgd;d(i^aJUL zdu)%;az?yL_}utNh+;4FB-HB4@{rI##>n8v$D!`QyMt%*K3SyyYbiJLZWDYvWF!B` zrA|YgoGSQSejh4~y)7ZGuh?ZBTu4$Re<4dWd};`8Q1I#SG4%=cS@PLjXQRq|5&v?6 z+C(*HIm;r-!pu^}QhWGAm`oc_n?u-_u=1Gb80To%F|vRf#8Tmie4i3dvH7Yd?3$8| z>!6cIFAu64VyN)i-DmU=tV&5ATnZM1g!i6!%KWymH(Yjr&xlVmiX}?WfNLlrwGE4o zwH=fVmOUujD3fg?VBK!#UbRq5z2c6~#J#>k=?rt`zG8l52(?yPmMZ(=e#gd`{YU%B z`qH`U{S=%VuCw+P%5x~|HxcKDt<5jK1_$Q_KgsPy4nAuEKdT)1z!KHLj&gU+^wd1( ztx|UV?A!H`(N>%HzAr!X^B3x;=|}bCd3UUBtsS3>sb8q~uwQg2z#XbZ)HdPFJRLk^ zZv<~MaZot2bP_s4ib~w>&Rytta~yFLD?d{H0_(P+w;_#x{Hnk4@r{A-8SX#Lmxz;A z{Ys;?&po^QC-9+@(*D){w{~H>g8OXujR(99DADL_xgAKkke|bR;rRuQpxz*@Ry9$A zuG5o^Ta9an=MK(!h6W7;3@qhtK8kKj3Z;m|vT+|sEIQ&&(DbGcZP zSdZ8WA{BA*j!zzM9`~K}yvvj97CwuESw+;Mk%DHUgNCoNH>A~0HK{Qr z$E94e(B&*-+lJIAtUoOx<@aPHFWJK+*trzZ@X@GyjqT9U{^5YfhN!Cdv1s+N-h`PR$1IvB@UK1;h(`N?n5E{Zo&t6d3Jhb?{;F(&m=xel{j zc-K%w-%EmDzfAv(-X#7lu6gTruhs3#l(G0~bj8zLY`^7G%juEDSL3xOq^#unK_ah& z?==xwQ950*$>);aKQKXBnbt;C=-<<~6|f(5K%3OmEKtaLpLAoa3~!XVE)|ZwX!LF@ zfB)g-kY&*&E89(6xzkFo&qHb-OI}zcC5580Eez9E+VJnCHq>9tE2)0h<~Qy4E--?L z(i_{`E1M>ZE+drYlRr8=YVDcy@*jHLfi1-s)g}uwhKq*_`=@U$eQLW9e&hFw*lLQ~ zmV-NMO=Z||;*LD^Z&EDu)*%TR4vn1O8={3ss=;j^nY@@f? z8Ru`47v8;lGlXi=_gTrfsYWaVJ;1MG2S(TCeET!sZN69cp7^v=d9aT^*3re`eZw0< z39-d5XO?wa3Kc)6f)?icQcG{+(AM{J5!vdgoenIW*s#9z5In;Qiq&j+c z-S5G?=x1bmNFQSDPv})2H0QVgO!)RvW-!U)*Ml&owVG2;1!TAY;D$zX2Pne=S&073BCJ&*P z`DaY!S4;^?yE6GHP8sq`UMPgNgP-D{5S3r@LKReg*c-_MiNT^hXqQs}$Qxzjr`tCA|2@-!^dRk36$({>u}es38Edou7x_jde*gdg literal 0 HcmV?d00001 diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R new file mode 100644 index 00000000..53970a04 --- /dev/null +++ b/tests/testthat/test-atc.R @@ -0,0 +1,15 @@ +context("atc.R") + + +test_that("atc_property works", { + expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin") + expect_equivalent(atc_property("J01CA04", "DDD"), 1) +}) + +test_that("abname works", { + expect_equal(abname("AMOX"), "Amoxicillin") + expect_equal(abname(c("AMOX", "GENT")), c("Amoxicillin", "Gentamicin")) + expect_equal(abname("AMOX", from = 'umcg'), "Amoxicillin") + expect_equal(abname("amox", from = 'molis'), "Amoxicillin") + expect_equal(abname("J01CA04", from = 'atc'), "Amoxicillin") +}) diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R new file mode 100644 index 00000000..cc4f7d92 --- /dev/null +++ b/tests/testthat/test-classes.R @@ -0,0 +1,37 @@ +context("classes.R") + +test_that("rsi works", { + expect_true(as.rsi("S") < as.rsi("I")) + expect_true(as.rsi("I") < as.rsi("R")) + expect_true(as.rsi("R") > as.rsi("S")) + expect_true(is.rsi(as.rsi("S"))) + + expect_equal(suppressWarnings(as.logical(as.rsi("INVALID VALUE"))), NA) + + expect_equal(class(barplot(as.rsi(c("S", "I", "R")))), "numeric") + + expect_equal(summary(as.rsi(c("S", "R"))), c("Mode" = 'rsi', + "" = "0", + "Sum S" = "1", + "Sum IR" = "1", + "Sum R" = "1", + "Sum I" = "0")) +}) + +test_that("mic works", { + expect_true(as.mic(8) == as.mic("8")) + expect_true(as.mic("1") > as.mic("<=0.0625")) + expect_true(as.mic("1") < as.mic(">=32")) + expect_true(is.mic(as.mic(8))) + + expect_equal(as.double(as.mic(">=32")), 32) + expect_equal(as.integer(as.mic(">=32")), 32) + expect_equal(suppressWarnings(as.logical(as.mic("INVALID VALUE"))), NA) + + expect_equal(class(plot(as.mic(c(1, 2, 4, 8)))), "numeric") + + expect_equal(summary(as.mic(c(2, 8))), c("Mode" = 'mic', + "" = "0", + "Min." = "2", + "Max." = "8")) +}) diff --git a/tests/testthat/test-clipboard.R b/tests/testthat/test-clipboard.R new file mode 100644 index 00000000..30123564 --- /dev/null +++ b/tests/testthat/test-clipboard.R @@ -0,0 +1,9 @@ +context("clipboard.R") + +test_that("clipboard works", { + # why is the <<- needed? Won't work without it... + t1 <<- AMR::antibiotics + clipboard_export(t1, info = FALSE) + t2 <- clipboard_import() + expect_equal(t1, t2) +}) diff --git a/tests/testthat/test-eucast.R b/tests/testthat/test-eucast.R new file mode 100644 index 00000000..da9aea7a --- /dev/null +++ b/tests/testthat/test-eucast.R @@ -0,0 +1,31 @@ +context("EUCAST.R") + +test_that("EUCAST rules work", { + a <- data.frame(bactid = c("KLEPNE", # Klebsiella pneumoniae + "PSEAER", # Pseudomonas aeruginosa + "ENTAER"), # Enterobacter aerogenes + amox = "-", # Amoxicillin + stringsAsFactors = FALSE) + b <- data.frame(bactid = c("KLEPNE", # Klebsiella pneumoniae + "PSEAER", # Pseudomonas aeruginosa + "ENTAER"), # Enterobacter aerogenes + amox = "R", # Amoxicillin + stringsAsFactors = FALSE) + expect_equal(EUCAST_rules(a, info = FALSE), b) + expect_equal(interpretive_reading(a, info = FALSE), b) + + a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus + "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) + coli = "-", # Colistin + stringsAsFactors = FALSE) + b <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus + "STCGRA"), # Streptococcus pyognenes (Lancefield Group A) + coli = "R", # Colistin + stringsAsFactors = FALSE) + expect_equal(EUCAST_rules(a, info = FALSE), b) +}) + +test_that("MO properties work", { + expect_equal(mo_property("ESCCOL"), "Escherichia coli") + expect_equal(mo_property("STAAUR"), "Staphylococcus aureus") +}) diff --git a/tests/testthat/test-first_isolates.R b/tests/testthat/test-first_isolates.R new file mode 100644 index 00000000..31437bf0 --- /dev/null +++ b/tests/testthat/test-first_isolates.R @@ -0,0 +1,23 @@ +context("first_isolates.R") + +test_that("keyantibiotics work", { + expect_equal(length(key_antibiotics(septic_patients, info = FALSE)), nrow(septic_patients)) + expect_true(key_antibiotics_equal("SSS", "SSS")) + expect_true(key_antibiotics_equal("SSS", "SIS", ignore_I = TRUE)) + expect_false(key_antibiotics_equal("SSS", "SIS", ignore_I = FALSE)) +}) + + +test_that("guess_bactid works", { + expect_equal(guess_bactid("E. coli"), "ESCCOL") + expect_equal(guess_bactid("Escherichia coli"), "ESCCOL") +}) + +test_that("first isolates work", { + # septic_patients contains 1960 out of 2000 first isolates + expect_equal(sum(first_isolate(septic_patients, + "date", + "patient_id", + "bactid", + info = FALSE)), 1960) +}) diff --git a/tests/testthat/test-joins.R b/tests/testthat/test-joins.R new file mode 100644 index 00000000..cd23b49a --- /dev/null +++ b/tests/testthat/test-joins.R @@ -0,0 +1,18 @@ +context("joins.R") + +test_that("joins work", { + unjoined <- septic_patients + inner <- septic_patients %>% inner_join_microorganisms() + left <- septic_patients %>% left_join_microorganisms() + suppressWarnings(right <- septic_patients %>% right_join_microorganisms()) + suppressWarnings(full <- septic_patients %>% full_join_microorganisms()) + + expect_true(ncol(unjoined) < ncol(inner)) + expect_true(nrow(unjoined) == nrow(inner)) + + expect_true(ncol(unjoined) < ncol(left)) + expect_true(nrow(unjoined) == nrow(left)) + + expect_true(nrow(unjoined) < nrow(right)) + expect_true(nrow(unjoined) < nrow(full)) +}) diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R new file mode 100644 index 00000000..9aaf428b --- /dev/null +++ b/tests/testthat/test-misc.R @@ -0,0 +1,20 @@ +context("misc.R") + +test_that("`like` works", { + expect_true("test" %like% "^t") + expect_true("test" %like% "test") + expect_true("test" %like% "TEST") + expect_true(as.factor("test") %like% "TEST") +}) + +test_that("percentages works", { + expect_equal(percent(0.25), "25%") + expect_equal(percent(0.5), "50%") + expect_equal(percent(0.1234), "12.3%") +}) + +test_that("quasiquotation works", { + expect_equal(quasiquotate(deparse(substitute("test")), "test"), "test") + expect_equal(quasiquotate(deparse(substitute('test')), "'test'"), "test") + expect_equal(quasiquotate(deparse(substitute(test)), test), "test") +}) diff --git a/tests/testthat/test-rsi_analysis.R b/tests/testthat/test-rsi_analysis.R new file mode 100644 index 00000000..fb5623f8 --- /dev/null +++ b/tests/testthat/test-rsi_analysis.R @@ -0,0 +1,38 @@ +context("rsi_analysis.R") + +test_that("rsi works", { + # amox resistance in `septic_patients` should be around 53.86% + amox_R <- septic_patients %>% summarise(amox = rsi(amox)) %>% pull(amox) + expect_equal(amox_R, 0.5386, tolerance = 0.0001) + expect_equal(rsi_df(septic_patients, + ab = "amox", + info = FALSE), 0.5386, tolerance = 0.0001) + # and pita+genta susceptibility around 98.09% + expect_equal(rsi_df(septic_patients, + ab = c("pita", "gent"), + interpretation = "S", + info = FALSE), 0.9809, tolerance = 0.0001) +}) + +test_that("prediction of rsi works", { + amox_R <- rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),], + col_ab = "amox", + col_date = "date", + info = FALSE) + amox_R <- amox_R %>% pull("probR") + # amox resistance will decrease according to `septic_patients` + expect_true(amox_R[2] > amox_R[20]) + expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),], + model = "INVALID MODEL", + col_ab = "amox", + col_date = "date", + info = FALSE)) + expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),], + col_ab = "NOT EXISTING COLUMN", + col_date = "date", + info = FALSE)) + expect_error(rsi_predict(tbl = septic_patients[which(septic_patients$bactid == "ESCCOL"),], + col_ab = "amox", + col_date = "NOT EXISTING COLUMN", + info = FALSE)) +})