add strep groups to ABCG

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-07-12 11:41:25 +01:00
parent 66eeeb4b88
commit 7cd9ca274c
7 changed files with 12 additions and 39 deletions

View File

@ -49,7 +49,7 @@ jobs:
# Test all old versions of R >= 3.0, we support them all! # Test all old versions of R >= 3.0, we support them all!
# For these old versions, dependencies and vignettes will not be checked. # 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). # 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.4', allowfail: false}
- {os: ubuntu-latest, r: '3.3', allowfail: false} - {os: ubuntu-latest, r: '3.3', allowfail: false}
- {os: ubuntu-latest, r: '3.2', allowfail: false} - {os: ubuntu-latest, r: '3.2', allowfail: false}

10
R/sir.R
View File

@ -941,7 +941,7 @@ as_sir_method <- function(method_short,
mo_current <- df_unique[i, "mo", drop = TRUE] mo_current <- df_unique[i, "mo", drop = TRUE]
uti_current <- df_unique[i, "uti", drop = TRUE] uti_current <- df_unique[i, "uti", drop = TRUE]
if (is.na(uti_current)) { if (is.na(uti_current)) {
# preference, so no filter on UTIs # no preference, so no filter on UTIs
rows <- which(df$mo == mo_current) rows <- which(df$mo == mo_current)
} else { } else {
rows <- which(df$mo == mo_current & df$uti == uti_current) 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_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)] mo_current_name <- AMR_env$MO_lookup$fullname[match(mo_current, AMR_env$MO_lookup$mo)]
if (mo_current %in% AMR::microorganisms.groups$mo) { if (mo_current %in% AMR::microorganisms.groups$mo) {
# get the species group # get the species group (might be more than 1 entry)
mo_current_species_group <- AMR::microorganisms.groups$mo_group[match(mo_current, AMR::microorganisms.groups$mo)] mo_current_species_group <- AMR::microorganisms.groups$mo_group[which(AMR::microorganisms.groups$mo == mo_current)]
} else { } else {
mo_current_species_group <- mo_current mo_current_species_group <- NULL
} }
mo_current_other <- structure("UNKNOWN", class = c("mo", "character")) mo_current_other <- structure("UNKNOWN", class = c("mo", "character"))
# formatted for notes # formatted for notes
@ -977,7 +977,7 @@ as_sir_method <- function(method_short,
# (this will prefer species breakpoints over order breakpoints) # (this will prefer species breakpoints over order breakpoints)
breakpoints_current <- breakpoints %pm>% breakpoints_current <- breakpoints %pm>%
subset(mo %in% c( 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_order, mo_current_class,
mo_current_species_group, mo_current_species_group,
mo_current_other mo_current_other

View File

@ -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 == 513), "breakpoint_R"] <- 512
breakpoints_new[which(breakpoints_new$breakpoint_R == 1025), "breakpoint_R"] <- 1024 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: # 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 # EUCAST 2022 guideline: S <= 8 and R > 8
# WHONET file: S <= 8 and R >= 16 # WHONET file: S <= 8 and R >= 16

View File

@ -112,7 +112,7 @@ microorganisms.groups <- whonet_organisms %>%
mo = microorganisms$mo[which(microorganisms$mo %like% "^B_STRPT_SLVR(_|$)")])) %>% mo = microorganisms$mo[which(microorganisms$mo %like% "^B_STRPT_SLVR(_|$)")])) %>%
# and for EUCAST: Strep group A, B, C, G # and for EUCAST: Strep group A, B, C, G
bind_rows(tibble(mo_group = as.mo("Streptococcus 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: # HACEK is:
# - Haemophilus species # - Haemophilus species
# - Aggregatibacter species # - Aggregatibacter species
@ -133,8 +133,8 @@ microorganisms.groups <- whonet_organisms %>%
bind_rows(tibble(mo_group = as.mo("B_MYCBC_RGM"), 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))) %>% 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 # add full names
mutate(mo_group_name = mo_name(mo_group, keep_synonyms = TRUE), mutate(mo_group_name = mo_name(mo_group, keep_synonyms = TRUE, language = NULL),
mo_name = mo_name(mo, keep_synonyms = TRUE)) %>% mo_name = mo_name(mo, keep_synonyms = TRUE, language = NULL)) %>%
arrange(mo_group_name, mo_name) %>% arrange(mo_group_name, mo_name) %>%
filter(mo_group != mo) %>% filter(mo_group != mo) %>%
distinct() %>% 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) usethis::use_data(microorganisms.groups, internal = FALSE, overwrite = TRUE, compress = "xz", version = 2)
rm(microorganisms.groups) rm(microorganisms.groups)
devtools::load_all() 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()

Binary file not shown.

Binary file not shown.

View File

@ -49,7 +49,6 @@ download_txt <- function(filename) {
excel <- paste0(filename, ".xlsx") excel <- paste0(filename, ".xlsx")
feather <- paste0(filename, ".feather") feather <- paste0(filename, ".feather")
parquet <- paste0(filename, ".parquet") parquet <- paste0(filename, ".parquet")
sas <- paste0(filename, ".sas")
xpt <- paste0(filename, ".xpt") xpt <- paste0(filename, ".xpt")
spss <- paste0(filename, ".sav") spss <- paste0(filename, ".sav")
stata <- paste0(filename, ".dta") stata <- paste0(filename, ".dta")
@ -70,7 +69,6 @@ download_txt <- function(filename) {
file.exists(excel), file.exists(excel),
file.exists(feather), file.exists(feather),
file.exists(parquet), file.exists(parquet),
file.exists(sas),
file.exists(xpt), file.exists(xpt),
file.exists(spss), file.exists(spss),
file.exists(stata) file.exists(stata)
@ -82,7 +80,6 @@ download_txt <- function(filename) {
create_txt(excel, "xlsx", "Microsoft Excel workbook", file.exists(excel)), create_txt(excel, "xlsx", "Microsoft Excel workbook", file.exists(excel)),
create_txt(feather, "feather", "Apache Feather file", file.exists(feather)), create_txt(feather, "feather", "Apache Feather file", file.exists(feather)),
create_txt(parquet, "parquet", "Apache Parquet file", file.exists(parquet)), 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(xpt, "xpt", "SAS transport (XPT) file", file.exists(xpt)),
create_txt(spss, "sav", "IBM SPSS Statistics data file", file.exists(spss)), create_txt(spss, "sav", "IBM SPSS Statistics data file", file.exists(spss)),
create_txt(stata, "dta", "Stata DTA file", file.exists(stata)) create_txt(stata, "dta", "Stata DTA file", file.exists(stata))