Browse Source

fix for as.mo and freq

new-mo-algorithm
parent
commit
31e977937d
  1. 9
      .gitlab-ci.yml
  2. 4
      DESCRIPTION
  3. 2
      R/freq.R
  4. 40
      R/mo.R
  5. BIN
      data/microorganisms.certe.rda
  6. 4
      tests/testthat/test-eucast_rules.R
  7. 8
      tests/testthat/test-mo.R

9
.gitlab-ci.yml

@ -13,11 +13,14 @@ R 3: @@ -13,11 +13,14 @@ R 3:
- apt-get update
# install dependencies for package
- apt-get install --yes --no-install-recommends libxml2-dev libssl-dev libcurl4-openssl-dev zlib1g-dev
- R -e 'install.packages(c("devtools", "rlang"))'
- R -e 'devtools::install_deps(dependencies = c("Depends", "Imports", "Suggests"), repos = "https://cran.rstudio.com")'
- Rscript -e 'install.packages(c("devtools", "rlang"))'
- Rscript -e 'devtools::install_deps(dependencies = c("Depends", "Imports", "Suggests"), repos = "https://cran.rstudio.com")'
# remove vignettes folder and get VignetteBuilder field out of DESCRIPTION file
- rm -rf vignettes
- R -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
- Rscript -e 'd <- read.dcf("DESCRIPTION"); d[, colnames(d) == "VignetteBuilder"] <- NA; write.dcf(d, "DESCRIPTION")'
# set environmental variable
- Rscript -e 'Sys.setenv(NOT_CRAN = "true")'
# build package
- R CMD build . --no-build-vignettes --no-manual
- PKG_FILE_NAME=$(ls -1t *.tar.gz | head -n 1)
- R CMD check "${PKG_FILE_NAME}" --no-build-vignettes --no-manual --as-cran

4
DESCRIPTION

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
Package: AMR
Version: 0.4.0.9013
Date: 2018-11-24
Version: 0.4.0.9014
Date: 2018-11-30
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(

2
R/freq.R

@ -337,7 +337,7 @@ frequency_tbl <- function(x, @@ -337,7 +337,7 @@ frequency_tbl <- function(x,
header_txt <- header_txt %>% paste0(markdown_line, '\nLongest: ', x %>% base::nchar() %>% base::max(na.rm = TRUE))
}
if (NROW(x) > 0 & any(class(x) == "difftime")) {
if (NROW(x) > 0 & any(class(x) == "difftime") & !is.hms(x)) {
header_txt <- header_txt %>% paste0('\n')
header_txt <- header_txt %>% paste(markdown_line, '\nUnits: ', attributes(x)$units)
x <- as.double(x)

40
R/mo.R

@ -192,7 +192,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = @@ -192,7 +192,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
x_input <- x
# only check the uniques, which is way faster
x <- unique(x)
# remove empty values (to later fill them in again)
# remove empty values (to later fill them in again with NAs)
x <- x[!is.na(x) & !is.null(x) & !identical(x, "")]
# defined df to check for
@ -270,27 +270,24 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = @@ -270,27 +270,24 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
# check if search term was like "A. species", then return first genus found with ^A
if (x_backup[i] %like% "species" | x_backup[i] %like% "spp[.]?") {
# get mo code of first hit
found <- microorganismsDT[fullname %like% x_withspaces_start[i], mo][[1]]
mo_code <- found[1L] %>% strsplit("_") %>% unlist() %>% .[1:2] %>% paste(collapse = "_")
found <- microorganismsDT[mo == mo_code, ..property][[1]]
# return first genus that begins with x_trimmed, e.g. when "E. spp."
found <- microorganismsDT[fullname %like% x_withspaces_start[i], mo]
if (length(found) > 0) {
x[i] <- found[1L]
next
} else {
# fewer than 3 chars, add as failure
x[i] <- NA_character_
failures <- c(failures, x_backup[i])
next
mo_code <- found[1L] %>% strsplit("_") %>% unlist() %>% .[1:2] %>% paste(collapse = "_")
found <- microorganismsDT[mo == mo_code, ..property][[1]]
# return first genus that begins with x_trimmed, e.g. when "E. spp."
if (length(found) > 0) {
x[i] <- found[1L]
next
}
}
} else {
# fewer than 3 chars, add as failure
x[i] <- NA_character_
failures <- c(failures, x_backup[i])
next
}
# fewer than 3 chars and not looked for species, add as failure
x[i] <- NA_character_
failures <- c(failures, x_backup[i])
next
}
# translate known trivial abbreviations to genus + species ----
if (!is.na(x_trimmed[i])) {
if (toupper(x_trimmed[i]) == 'MRSA'
@ -377,9 +374,16 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = @@ -377,9 +374,16 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain =
}
# TRY OTHER SOURCES ----
if (toupper(x_backup[i]) %in% microorganisms.certe[, 1]) {
mo_found <- microorganisms.certe[toupper(x_backup[i]) == microorganisms.certe[, 1], 2][1L]
if (length(mo_found) > 0) {
x[i] <- microorganismsDT[mo == mo_found, ..property][[1]][1L]
next
}
}
if (x_backup[i] %in% microorganisms.umcg[, 1]) {
mo_umcg <- microorganisms.umcg[microorganisms.umcg[, 1] == x_backup[i], 2]
mo_found <- microorganisms.certe[microorganisms.certe[, 1] == mo_umcg, 2]
mo_found <- microorganisms.certe[microorganisms.certe[, 1] == mo_umcg, 2][1L]
if (length(mo_found) == 0) {
# not found
x[i] <- NA_character_

BIN
data/microorganisms.certe.rda

Binary file not shown.

4
tests/testthat/test-eucast_rules.R

@ -73,6 +73,10 @@ test_that("EUCAST rules work", { @@ -73,6 +73,10 @@ test_that("EUCAST rules work", {
, info = FALSE))$amox,
"S")
# also test norf
expect_output(suppressWarnings(eucast_rules(septic_patients %>% mutate(norf = "S", nali = "S"))))
# check verbose output
expect_output(suppressWarnings(eucast_rules(septic_patients, verbose = TRUE)))
})

8
tests/testthat/test-mo.R

@ -77,6 +77,9 @@ test_that("as.mo works", { @@ -77,6 +77,9 @@ test_that("as.mo works", {
# too few characters
expect_warning(as.mo("ab"))
expect_equal(suppressWarnings(as.character(as.mo(c("Qq species", "", "CRS", "K. pneu rhino", "esco")))),
c(NA_character_, NA_character_, "B_STNTR_MAL", "B_KLBSL_PNE_RHI", "B_ESCHR_COL"))
# check for Becker classification
expect_identical(as.character(guess_mo("S. epidermidis", Becker = FALSE)), "B_STPHY_EPI")
expect_identical(as.character(guess_mo("S. epidermidis", Becker = TRUE)), "B_STPHY_CNS")
@ -202,4 +205,9 @@ test_that("as.mo works", { @@ -202,4 +205,9 @@ test_that("as.mo works", {
"E. species")),
rep("Escherichia species", 3))
# from different sources
expect_equal(as.character(as.mo(
c("PRTMIR", "bclcer", "B_ESCHR_COL"))),
c("B_PROTS_MIR", "B_BCLLS_CER", "B_ESCHR_COL"))
})

Loading…
Cancel
Save