fix txt export of microorganisms

This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-10-29 16:08:18 +02:00
parent 6ad7857d39
commit afdc48db1e
6 changed files with 48898 additions and 12 deletions

View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 1.8.2.9034 Version: 1.8.2.9035
Date: 2022-10-29 Date: 2022-10-29
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)

View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9034 # AMR 1.8.2.9035
This version will eventually become v2.0! We're happy to reach a new major milestone soon! This version will eventually become v2.0! We're happy to reach a new major milestone soon!

17
R/rsi.R
View File

@ -622,7 +622,7 @@ as.rsi.data.frame <- function(x,
# only print message if class not already set # only print message if class not already set
message_("=> Assigning class 'rsi' to already clean column '", font_bold(ab), "' (", message_("=> Assigning class 'rsi' to already clean column '", font_bold(ab), "' (",
ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""), ifelse(ab_coerced != toupper(ab), paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ")... ", ab_name(ab_coerced, tolower = TRUE, language = NULL), ")... ",
appendLF = FALSE, appendLF = FALSE,
as_note = FALSE as_note = FALSE
) )
@ -872,12 +872,13 @@ as_rsi_method <- function(method_short,
lookup_lancefield[i], lookup_lancefield[i],
lookup_other[i] lookup_other[i]
)) ))
if (NROW(get_record) == 0) { if (NROW(get_record) == 0) {
warning_("No ", method_param, " breakpoints available for ", warning_("No ", method_param, " breakpoints available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))), font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "), paste0(" / "),
suppressMessages(suppressWarnings(ab_name(ab, language = NULL, tolower = TRUE)))) suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
" (", ab_param, ")")
rise_warning <- TRUE rise_warning <- TRUE
next next
} }
@ -899,18 +900,18 @@ as_rsi_method <- function(method_short,
# uti not set as TRUE, but there are only a UTI breakpoints available, so throw warning # uti not set as TRUE, but there are only a UTI breakpoints available, so throw warning
warning_("in `as.rsi()`: interpretation of ", font_bold(ab_name(ab_param, tolower = TRUE)), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms, thus assuming `uti = TRUE`. See ?as.rsi.") warning_("in `as.rsi()`: interpretation of ", font_bold(ab_name(ab_param, tolower = TRUE)), " is only available for (uncomplicated) urinary tract infections (UTI) for some microorganisms, thus assuming `uti = TRUE`. See ?as.rsi.")
rise_warning <- TRUE rise_warning <- TRUE
} else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && uti[i] == FALSE && all(c(TRUE, FALSE) %in% records_same_mo$uti, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteUTI", records_same_mo$mo[1], records_same_mo$ab[1])) { } else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && is.na(uti[i]) && all(c(TRUE, FALSE) %in% records_same_mo$uti, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteUTI", records_same_mo$mo[1], ab_param)) {
# uti not set and both UTI and non-UTI breakpoints available, so throw warning # uti not set and both UTI and non-UTI breakpoints available, so throw warning
warning_("in `as.rsi()`: breakpoints for UTI ", font_underline("and"), " non-UTI available for ", warning_("in `as.rsi()`: breakpoints for UTI ", font_underline("and"), " non-UTI available for ",
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))), font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
paste0(" / "), " / ",
suppressMessages(suppressWarnings(ab_name(records_same_mo$ab[1], language = NULL, tolower = TRUE))), suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
paste0(" - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi. '"), " (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.",
call = FALSE) call = FALSE)
get_record <- get_record %pm>% get_record <- get_record %pm>%
pm_filter(uti == FALSE) pm_filter(uti == FALSE)
rise_warning <- TRUE rise_warning <- TRUE
} else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && all(records_same_mo$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.rsi", "site", records_same_mo$mo[1], records_same_mo$ab[1])) { } else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && all(records_same_mo$uti == FALSE, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteOther", records_same_mo$mo[1], ab_param)) {
# breakpoints for multiple body sites available, so throw warning # breakpoints for multiple body sites available, so throw warning
site <- get_record[1L, "site", drop = FALSE] site <- get_record[1L, "site", drop = FALSE]
if (is.na(site)) { if (is.na(site)) {

View File

@ -391,7 +391,6 @@ if (changed_md5(microorganisms)) {
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('data-raw/')}")) usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('data-raw/')}"))
write_md5(microorganisms) write_md5(microorganisms)
try(saveRDS(microorganisms, "data-raw/microorganisms.rds", version = 2, compress = "xz"), silent = TRUE) try(saveRDS(microorganisms, "data-raw/microorganisms.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(mo, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
max_50_snomed <- sapply(microorganisms$snomed, function(x) paste(x[seq_len(min(50, length(x), na.rm = TRUE))], collapse = " ")) max_50_snomed <- sapply(microorganisms$snomed, function(x) paste(x[seq_len(min(50, length(x), na.rm = TRUE))], collapse = " "))
mo <- microorganisms mo <- microorganisms
mo$snomed <- max_50_snomed mo$snomed <- max_50_snomed
@ -400,6 +399,8 @@ if (changed_md5(microorganisms)) {
try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE) try(haven::write_sav(mo, "data-raw/microorganisms.sav"), silent = TRUE)
try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE) try(haven::write_dta(mo, "data-raw/microorganisms.dta"), silent = TRUE)
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE) try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
mo_all_snomed <- microorganisms %>% mutate_if(is.list, function(x) sapply(x, paste, collapse = ","))
try(write.table(mo_all_snomed, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(arrow::write_feather(microorganisms, "data-raw/microorganisms.feather"), silent = TRUE) try(arrow::write_feather(microorganisms, "data-raw/microorganisms.feather"), silent = TRUE)
try(arrow::write_parquet(microorganisms, "data-raw/microorganisms.parquet"), silent = TRUE) try(arrow::write_parquet(microorganisms, "data-raw/microorganisms.parquet"), silent = TRUE)
} }

File diff suppressed because one or more lines are too long

View File

@ -125,6 +125,8 @@ This data set is in R available as `microorganisms`, after you load the `AMR` pa
**NOTE: The exported files for Excel, SAS, SPSS and Stata contain only the first 50 SNOMED codes per record, as their file size would otherwise exceed 100 MB; the file size limit of GitHub.** Advice? Use R instead. **NOTE: The exported files for Excel, SAS, SPSS and Stata contain only the first 50 SNOMED codes per record, as their file size would otherwise exceed 100 MB; the file size limit of GitHub.** Advice? Use R instead.
The tab-separated text file contains all SNOMED codes as comma separated values.
### Source ### Source
This data set contains the full microbial taxonomy of `r AMR:::nr2char(length(unique(AMR::microorganisms$kingdom[!AMR::microorganisms$kingdom %like% "unknown"])))` kingdoms from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF): This data set contains the full microbial taxonomy of `r AMR:::nr2char(length(unique(AMR::microorganisms$kingdom[!AMR::microorganisms$kingdom %like% "unknown"])))` kingdoms from the List of Prokaryotic names with Standing in Nomenclature (LPSN) and the Global Biodiversity Information Facility (GBIF):