diff --git a/NEWS.md b/NEWS.md index f2a712ea..ec01cb5a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -30,6 +30,7 @@ * Changed default settings for `age_groups()`, to let groups of fives and tens end with 100+ instead of 120+ * Fix for `freq()` for when all values are `NA` * Fix for `first_isolate()` for when dates are missing +* Improved speed of `guess_ab_col()` #### Other * Support for R 3.6.0 diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index 70e542d6..95489d3b 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -69,13 +69,18 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) { if (search_string %in% colnames(x)) { ab_result <- search_string } else { - # sort colnames on length - longest first - cols <- colnames(x[, x %>% colnames() %>% nchar() %>% order() %>% rev()]) - df_trans <- data.frame(cols = cols, - abs = suppressWarnings(as.ab(cols)), - stringsAsFactors = FALSE) - ab_result <- df_trans[which(df_trans$abs == as.ab(search_string)), "cols"] - ab_result <- ab_result[!is.na(ab_result)][1L] + search_string.ab <- suppressWarnings(as.ab(search_string)) + if (search_string.ab %in% colnames(x)) { + ab_result <- colnames(x)[colnames(x) == search_string.ab][1L] + } else { + # sort colnames on length - longest first + cols <- colnames(x[, x %>% colnames() %>% nchar() %>% order() %>% rev()]) + df_trans <- data.frame(cols = cols, + abs = suppressWarnings(as.ab(cols)), + stringsAsFactors = FALSE) + ab_result <- df_trans[which(df_trans$abs == search_string.ab), "cols"] + ab_result <- ab_result[!is.na(ab_result)][1L] + } } if (length(ab_result) == 0) { diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 3b3dc83d..00b42277 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -320,7 +320,9 @@ rsi_predict <- resistance_predict #' @importFrom dplyr filter #' @importFrom graphics plot axis arrows points #' @rdname resistance_predict -plot.resistance_predict <- function(x, main = paste("Resistance prediction of", attributes(x)$ab), ...) { +plot.resistance_predict <- function(x, main = paste("Resistance Prediction of", x_name), ...) { + x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") + if (attributes(x)$I_as_S == TRUE) { ylab <- "%R" } else { @@ -359,14 +361,15 @@ plot.resistance_predict <- function(x, main = paste("Resistance prediction of", #' @importFrom dplyr filter #' @export ggplot_rsi_predict <- function(x, - main = paste("Resistance prediction of", attributes(x)$ab), + main = paste("Resistance Prediction of", x_name), ribbon = TRUE, ...) { - if (!"resistance_predict" %in% class(x)) { stop("`x` must be a resistance prediction model created with resistance_predict().") } + x_name <- paste0(ab_name(attributes(x)$ab), " (", attributes(x)$ab, ")") + if (attributes(x)$I_as_S == TRUE) { ylab <- "%R" } else { diff --git a/docs/articles/resistance_predict.html b/docs/articles/resistance_predict.html index 9e37ea09..2fb4ec24 100644 --- a/docs/articles/resistance_predict.html +++ b/docs/articles/resistance_predict.html @@ -192,7 +192,7 @@

How to predict antimicrobial resistance

Matthijs S. Berends

-

12 May 2019

+

13 May 2019

@@ -240,52 +240,52 @@ #> #> Deviance Residuals: #> Min 1Q Median 3Q Max -#> -2.9203 -1.3066 0.0166 0.7641 3.1984 +#> -2.6817 -1.4087 -0.5657 0.9672 3.5728 #> #> Coefficients: #> Estimate Std. Error z value Pr(>|z|) -#> (Intercept) -222.51053 45.94675 -4.843 1.28e-06 *** -#> year 0.10973 0.02284 4.805 1.55e-06 *** +#> (Intercept) -224.39872 48.03354 -4.672 2.99e-06 *** +#> year 0.11061 0.02388 4.633 3.61e-06 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 #> #> (Dispersion parameter for binomial family taken to be 1) #> -#> Null deviance: 59.763 on 14 degrees of freedom -#> Residual deviance: 35.261 on 13 degrees of freedom -#> AIC: 93.537 +#> Null deviance: 61.512 on 14 degrees of freedom +#> Residual deviance: 38.692 on 13 degrees of freedom +#> AIC: 95.212 #> #> Number of Fisher Scoring iterations: 4

This text is only a printed summary - the actual result (output) of the function is a data.frame containing for each year: the number of observations, the actual observed resistance, the estimated resistance and the standard error below and above the estimation:

predict_TZP
 #>    year      value    se_min    se_max observations   observed  estimated
-#> 1  2003 0.06250000        NA        NA           32 0.06250000 0.06179057
-#> 2  2004 0.08536585        NA        NA           82 0.08536585 0.06846623
-#> 3  2005 0.10000000        NA        NA           60 0.10000000 0.07580483
-#> 4  2006 0.05084746        NA        NA           59 0.05084746 0.08385921
-#> 5  2007 0.12121212        NA        NA           66 0.12121212 0.09268356
-#> 6  2008 0.04166667        NA        NA           72 0.04166667 0.10233276
-#> 7  2009 0.01639344        NA        NA           61 0.01639344 0.11286156
-#> 8  2010 0.09433962        NA        NA           53 0.09433962 0.12432363
-#> 9  2011 0.18279570        NA        NA           93 0.18279570 0.13677030
-#> 10 2012 0.30769231        NA        NA           65 0.30769231 0.15024926
-#> 11 2013 0.08620690        NA        NA           58 0.08620690 0.16480299
-#> 12 2014 0.15000000        NA        NA           60 0.15000000 0.18046706
-#> 13 2015 0.27272727        NA        NA           55 0.27272727 0.19726831
-#> 14 2016 0.25000000        NA        NA           84 0.25000000 0.21522295
-#> 15 2017 0.16279070        NA        NA           86 0.16279070 0.23433471
-#> 16 2018 0.25459302 0.2223385 0.2868476           NA         NA 0.25459302
-#> 17 2019 0.27597143 0.2381174 0.3138255           NA         NA 0.27597143
-#> 18 2020 0.29842630 0.2545398 0.3423128           NA         NA 0.29842630
-#> 19 2021 0.32189595 0.2716308 0.3721611           NA         NA 0.32189595
-#> 20 2022 0.34630028 0.2894072 0.4031934           NA         NA 0.34630028
-#> 21 2023 0.37154107 0.3078773 0.4352048           NA         NA 0.37154107
-#> 22 2024 0.39750288 0.3270414 0.4679643           NA         NA 0.39750288
-#> 23 2025 0.42405472 0.3468903 0.5012191           NA         NA 0.42405472
-#> 24 2026 0.45105237 0.3674044 0.5347004           NA         NA 0.45105237
-#> 25 2027 0.47834130 0.3885523 0.5681303           NA         NA 0.47834130
-#> 26 2028 0.50576012 0.4102900 0.6012302           NA         NA 0.50576012
-#> 27 2029 0.53314434 0.4325600 0.6337287           NA         NA 0.53314434
+#> 1 2003 0.06250000 NA NA 32 0.06250000 0.05486389 +#> 2 2004 0.08536585 NA NA 82 0.08536585 0.06089002 +#> 3 2005 0.05000000 NA NA 60 0.05000000 0.06753075 +#> 4 2006 0.05084746 NA NA 59 0.05084746 0.07483801 +#> 5 2007 0.12121212 NA NA 66 0.12121212 0.08286570 +#> 6 2008 0.04166667 NA NA 72 0.04166667 0.09166918 +#> 7 2009 0.01639344 NA NA 61 0.01639344 0.10130461 +#> 8 2010 0.05660377 NA NA 53 0.05660377 0.11182814 +#> 9 2011 0.18279570 NA NA 93 0.18279570 0.12329488 +#> 10 2012 0.30769231 NA NA 65 0.30769231 0.13575768 +#> 11 2013 0.06896552 NA NA 58 0.06896552 0.14926576 +#> 12 2014 0.10000000 NA NA 60 0.10000000 0.16386307 +#> 13 2015 0.23636364 NA NA 55 0.23636364 0.17958657 +#> 14 2016 0.22619048 NA NA 84 0.22619048 0.19646431 +#> 15 2017 0.16279070 NA NA 86 0.16279070 0.21451350 +#> 16 2018 0.23373852 0.2021578 0.2653193 NA NA 0.23373852 +#> 17 2019 0.25412909 0.2168525 0.2914057 NA NA 0.25412909 +#> 18 2020 0.27565854 0.2321869 0.3191302 NA NA 0.27565854 +#> 19 2021 0.29828252 0.2481942 0.3483709 NA NA 0.29828252 +#> 20 2022 0.32193804 0.2649008 0.3789753 NA NA 0.32193804 +#> 21 2023 0.34654311 0.2823269 0.4107593 NA NA 0.34654311 +#> 22 2024 0.37199700 0.3004860 0.4435080 NA NA 0.37199700 +#> 23 2025 0.39818127 0.3193839 0.4769787 NA NA 0.39818127 +#> 24 2026 0.42496142 0.3390173 0.5109056 NA NA 0.42496142 +#> 25 2027 0.45218939 0.3593720 0.5450068 NA NA 0.45218939 +#> 26 2028 0.47970658 0.3804212 0.5789920 NA NA 0.47970658 +#> 27 2029 0.50734745 0.4021241 0.6125708 NA NA 0.50734745

The function plot is available in base R, and can be extended by other packages to depend the output based on the type of input. We extended its function to cope with resistance predictions:

plot(predict_TZP)

@@ -362,9 +362,9 @@ #> Link function: logit summary(model)$coefficients -#> Estimate Std. Error z value Pr(>|z|) -#> (Intercept) -222.5105288 45.94675125 -4.842791 1.280277e-06 -#> year 0.1097306 0.02283874 4.804581 1.550761e-06 +#> Estimate Std. Error z value Pr(>|z|) +#> (Intercept) -224.3987194 48.0335384 -4.671709 2.987038e-06 +#> year 0.1106102 0.0238753 4.632831 3.606990e-06 diff --git a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-4-1.png b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-4-1.png index e1f15617..12921bf2 100644 Binary files a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-4-1.png and b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-4-1.png differ diff --git a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-1.png b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-1.png index 2b6fd35f..aba809bf 100644 Binary files a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-1.png and b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-1.png differ diff --git a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-2.png b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-2.png index 168ba95b..c001b6ab 100644 Binary files a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-2.png and b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-5-2.png differ diff --git a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-6-1.png b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-6-1.png index 635cd44e..96b631b8 100644 Binary files a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-6-1.png and b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-6-1.png differ diff --git a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-7-1.png b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-7-1.png index 8a9f72c7..60d23c9e 100644 Binary files a/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-7-1.png and b/docs/articles/resistance_predict_files/figure-html/unnamed-chunk-7-1.png differ diff --git a/docs/news/index.html b/docs/news/index.html index 17f27bc3..26c844b2 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -284,6 +284,8 @@ Please create an issue in one of our repositories if you want additions in this
  • Fix for freq() for when all values are NA
  • Fix for first_isolate() for when dates are missing
    • +
  • Improved speed of guess_ab_col() +
    • diff --git a/docs/reference/resistance_predict.html b/docs/reference/resistance_predict.html index 52ee3a39..d02d4d91 100644 --- a/docs/reference/resistance_predict.html +++ b/docs/reference/resistance_predict.html @@ -253,10 +253,10 @@ # S3 method for resistance_predict plot(x, - main = paste("Resistance prediction of", attributes(x)$ab), ...) + main = paste("Resistance Prediction of", x_name), ...) -ggplot_rsi_predict(x, main = paste("Resistance prediction of", - attributes(x)$ab), ribbon = TRUE, ...) +ggplot_rsi_predict(x, main = paste("Resistance Prediction of", x_name), + ribbon = TRUE, ...)

    Arguments

    diff --git a/man/resistance_predict.Rd b/man/resistance_predict.Rd index 7d79f451..61f72fae 100644 --- a/man/resistance_predict.Rd +++ b/man/resistance_predict.Rd @@ -18,10 +18,10 @@ rsi_predict(x, col_ab, col_date = NULL, year_min = NULL, info = TRUE, ...) \method{plot}{resistance_predict}(x, - main = paste("Resistance prediction of", attributes(x)$ab), ...) + main = paste("Resistance Prediction of", x_name), ...) -ggplot_rsi_predict(x, main = paste("Resistance prediction of", - attributes(x)$ab), ribbon = TRUE, ...) +ggplot_rsi_predict(x, main = paste("Resistance Prediction of", x_name), + ribbon = TRUE, ...) } \arguments{ \item{x}{a \code{data.frame} containing isolates.} diff --git a/tests/testthat/test-resistance_predict.R b/tests/testthat/test-resistance_predict.R index b48ded4e..f0da07cd 100644 --- a/tests/testthat/test-resistance_predict.R +++ b/tests/testthat/test-resistance_predict.R @@ -39,37 +39,37 @@ test_that("prediction of rsi works", { library(dplyr) - expect_output(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_output(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), model = "binomial", col_ab = "AMX", col_date = "date", info = TRUE)) - expect_output(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_output(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), model = "loglin", col_ab = "AMX", col_date = "date", info = TRUE)) - expect_output(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_output(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), model = "lin", col_ab = "AMX", col_date = "date", info = TRUE)) - expect_error(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_error(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), model = "INVALID MODEL", col_ab = "AMX", col_date = "date", info = TRUE)) - expect_error(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_error(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), col_ab = "NOT EXISTING COLUMN", col_date = "date", info = TRUE)) - expect_error(rsi_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_error(rsi_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), col_ab = "AMX", col_date = "NOT EXISTING COLUMN", info = TRUE)) # almost all E. coli are MEM S in the Netherlands :) - expect_error(resistance_predict(tbl = filter(septic_patients, mo == "B_ESCHR_COL"), + expect_error(resistance_predict(x = filter(septic_patients, mo == "B_ESCHR_COL"), col_ab = "MEM", col_date = "date", info = TRUE))