diff --git a/.github/workflows/check-old.yaml b/.github/workflows/check-old.yaml index ab4a736d..01adad0d 100644 --- a/.github/workflows/check-old.yaml +++ b/.github/workflows/check-old.yaml @@ -49,7 +49,7 @@ jobs: # Test all old versions of R >= 3.0, we support them all! # For these old versions, dependencies and vignettes will not be checked. # For recent R versions, see check-recent.yaml (r-lib and tidyverse support the latest 5 major R releases). - - {os: windows-latest, r: '3.5', allowfail: true} + # - {os: windows-latest, r: '3.5', allowfail: true} # always fails, horrible with UTF-8 - {os: ubuntu-latest, r: '3.4', allowfail: false} - {os: ubuntu-latest, r: '3.3', allowfail: false} - {os: ubuntu-latest, r: '3.2', allowfail: false} diff --git a/R/sir.R b/R/sir.R index 07aa2c4d..d333f7e4 100755 --- a/R/sir.R +++ b/R/sir.R @@ -941,7 +941,7 @@ as_sir_method <- function(method_short, mo_current <- df_unique[i, "mo", drop = TRUE] uti_current <- df_unique[i, "uti", drop = TRUE] if (is.na(uti_current)) { - # preference, so no filter on UTIs + # no preference, so no filter on UTIs rows <- which(df$mo == mo_current) } else { rows <- which(df$mo == mo_current & df$uti == uti_current) @@ -957,10 +957,10 @@ as_sir_method <- function(method_short, mo_current_rank <- AMR_env$MO_lookup$rank[match(mo_current, AMR_env$MO_lookup$mo)] mo_current_name <- AMR_env$MO_lookup$fullname[match(mo_current, AMR_env$MO_lookup$mo)] if (mo_current %in% AMR::microorganisms.groups$mo) { - # get the species group - mo_current_species_group <- AMR::microorganisms.groups$mo_group[match(mo_current, AMR::microorganisms.groups$mo)] + # get the species group (might be more than 1 entry) + mo_current_species_group <- AMR::microorganisms.groups$mo_group[which(AMR::microorganisms.groups$mo == mo_current)] } else { - mo_current_species_group <- mo_current + mo_current_species_group <- NULL } mo_current_other <- structure("UNKNOWN", class = c("mo", "character")) # formatted for notes @@ -977,7 +977,7 @@ as_sir_method <- function(method_short, # (this will prefer species breakpoints over order breakpoints) breakpoints_current <- breakpoints %pm>% subset(mo %in% c( - mo_current_genus, mo_current_family, + mo_current, mo_current_genus, mo_current_family, mo_current_order, mo_current_class, mo_current_species_group, mo_current_other diff --git a/data-raw/reproduction_of_clinical_breakpoints.R b/data-raw/reproduction_of_clinical_breakpoints.R index f8936a28..c7d96c2d 100644 --- a/data-raw/reproduction_of_clinical_breakpoints.R +++ b/data-raw/reproduction_of_clinical_breakpoints.R @@ -297,6 +297,9 @@ breakpoints_new[which(breakpoints_new$breakpoint_R == 257), "breakpoint_R"] <- 2 breakpoints_new[which(breakpoints_new$breakpoint_R == 513), "breakpoint_R"] <- 512 breakpoints_new[which(breakpoints_new$breakpoint_R == 1025), "breakpoint_R"] <- 1024 +# fix streptococci in WHONET table of EUCAST: Strep A, B, C and G now includes all streptococci: +clinical_breakpoints$mo[clinical_breakpoints$mo == "B_STRPT" & clinical_breakpoints$ref_tbl %like% "strep.* a.* b.*c.*g"] <- as.mo("B_STRPT_ABCG") + # WHONET adds one log2 level to the R breakpoint for their software, e.g. in AMC in Enterobacterales: # EUCAST 2022 guideline: S <= 8 and R > 8 # WHONET file: S <= 8 and R >= 16 diff --git a/data-raw/reproduction_of_microorganisms.groups.R b/data-raw/reproduction_of_microorganisms.groups.R index ba4be3b9..e6986967 100644 --- a/data-raw/reproduction_of_microorganisms.groups.R +++ b/data-raw/reproduction_of_microorganisms.groups.R @@ -112,7 +112,7 @@ microorganisms.groups <- whonet_organisms %>% mo = microorganisms$mo[which(microorganisms$mo %like% "^B_STRPT_SLVR(_|$)")])) %>% # and for EUCAST: Strep group A, B, C, G bind_rows(tibble(mo_group = as.mo("Streptococcus Group A, B, C, G"), - mo = microorganisms$mo[which(microorganisms$mo %like% "^B_STRPT_(PYGN|AGLC|DYSG|EQUI|CANS)(_|$)")])) %>% + mo = microorganisms$mo[which(microorganisms$mo %like% "^B_STRPT_(PYGN|AGLC|DYSG|EQUI|CANS|GRPA|GRPB|GRPC|GRPG)(_|$)")])) %>% # HACEK is: # - Haemophilus species # - Aggregatibacter species @@ -133,8 +133,8 @@ microorganisms.groups <- whonet_organisms %>% bind_rows(tibble(mo_group = as.mo("B_MYCBC_RGM"), mo = paste("Mycobacterium", c( "abscessus abscessus", "abscessus bolletii", "abscessus massiliense", "agri", "aichiense", "algericum", "alvei", "anyangense", "arabiense", "aromaticivorans", "aubagnense", "aubagnense", "aurum", "austroafricanum", "bacteremicum", "boenickei", "bourgelatii", "brisbanense", "brumae", "canariasense", "celeriflavum", "chelonae", "chitae", "chlorophenolicum", "chubuense", "confluentis", "cosmeticum", "crocinum", "diernhoferi", "duvalii", "elephantis", "fallax", "flavescens", "fluoranthenivorans", "fortuitum", "franklinii", "frederiksbergense", "gadium", "gilvum", "goodii", "hassiacum", "hippocampi", "hodleri", "holsaticum", "houstonense", "immunogenum", "insubricum", "iranicum", "komossense", "litorale", "llatzerense", "madagascariense", "mageritense", "monacense", "moriokaense", "mucogenicum", "mucogenicum", "murale", "neoaurum", "neworleansense", "novocastrense", "obuense", "pallens", "parafortuitum", "peregrinum", "phlei", "phocaicum", "phocaicum", "porcinum", "poriferae", "psychrotolerans", "pyrenivorans", "rhodesiae", "rufum", "rutilum", "salmoniphilum", "sediminis", "senegalense", "septicum", "setense", "smegmatis", "sphagni", "thermoresistibile", "tokaiense", "vaccae", "vanbaalenii", "wolinskyi")) %>% as.mo(keep_synonyms = TRUE))) %>% # add full names - mutate(mo_group_name = mo_name(mo_group, keep_synonyms = TRUE), - mo_name = mo_name(mo, keep_synonyms = TRUE)) %>% + mutate(mo_group_name = mo_name(mo_group, keep_synonyms = TRUE, language = NULL), + mo_name = mo_name(mo, keep_synonyms = TRUE, language = NULL)) %>% arrange(mo_group_name, mo_name) %>% filter(mo_group != mo) %>% distinct() %>% @@ -146,30 +146,3 @@ class(microorganisms.groups$mo) <- c("mo", "character") usethis::use_data(microorganisms.groups, internal = FALSE, overwrite = TRUE, compress = "xz", version = 2) rm(microorganisms.groups) devtools::load_all() - - -# -# microorganisms <- microorganisms %>% -# mutate(mo = as.character(mo)) %>% -# bind_rows( -# microorganisms %>% filter(mo == "B_STRPT_HAEM") %>% -# mutate(mo = as.character(mo), -# mo = "B_STRPT_ABCG", -# fullname = "Streptococcus Group A, B, C, G", -# species = "Group A, B, C, G")) %>% -# arrange(fullname) %>% -# dataset_UTF8_to_ASCII() -# -# microorganisms$rank[which(microorganisms$fullname %like% "^Streptococcus Group")] <- "species group" -# microorganisms$lpsn_parent[which(microorganisms$fullname %like% "^Streptococcus Group")] <- 517118 -# microorganisms$gbif_parent[which(microorganisms$fullname %like% "^Streptococcus Group")] <- 3223465 -# microorganisms$ref[which(microorganisms$fullname %like% "^Streptococcus Group")] <- "Lancefield, 1933" -# microorganisms$prevalence[which(microorganisms$fullname %like% "^Streptococcus Group")] <- 1.5 -# microorganisms$oxygen_tolerance[which(microorganisms$fullname %like% "^Streptococcus Group")] <- "likely facultative anaerobe" -# - - -class(microorganisms$mo) <- c("mo", "character") -usethis::use_data(microorganisms, internal = FALSE, overwrite = TRUE, compress = "xz", version = 2) -rm(microorganisms) -devtools::load_all() diff --git a/data/clinical_breakpoints.rda b/data/clinical_breakpoints.rda index 631d6fb6..8828fc8a 100644 Binary files a/data/clinical_breakpoints.rda and b/data/clinical_breakpoints.rda differ diff --git a/data/microorganisms.groups.rda b/data/microorganisms.groups.rda index e298ce87..ea65ae2b 100644 Binary files a/data/microorganisms.groups.rda and b/data/microorganisms.groups.rda differ diff --git a/vignettes/datasets.Rmd b/vignettes/datasets.Rmd index aaadf921..1b39a7e9 100644 --- a/vignettes/datasets.Rmd +++ b/vignettes/datasets.Rmd @@ -49,7 +49,6 @@ download_txt <- function(filename) { excel <- paste0(filename, ".xlsx") feather <- paste0(filename, ".feather") parquet <- paste0(filename, ".parquet") - sas <- paste0(filename, ".sas") xpt <- paste0(filename, ".xpt") spss <- paste0(filename, ".sav") stata <- paste0(filename, ".dta") @@ -70,7 +69,6 @@ download_txt <- function(filename) { file.exists(excel), file.exists(feather), file.exists(parquet), - file.exists(sas), file.exists(xpt), file.exists(spss), file.exists(stata) @@ -82,7 +80,6 @@ download_txt <- function(filename) { create_txt(excel, "xlsx", "Microsoft Excel workbook", file.exists(excel)), create_txt(feather, "feather", "Apache Feather file", file.exists(feather)), create_txt(parquet, "parquet", "Apache Parquet file", file.exists(parquet)), - create_txt(sas, "sas", "SAS data (SAS) file", file.exists(sas)), create_txt(xpt, "xpt", "SAS transport (XPT) file", file.exists(xpt)), create_txt(spss, "sav", "IBM SPSS Statistics data file", file.exists(spss)), create_txt(stata, "dta", "Stata DTA file", file.exists(stata))