1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 20:06:12 +01:00
AMR/reproduction_of_microorganisms.R

435 lines
18 KiB
R
Raw Normal View History

2019-03-18 14:29:41 +01:00
# Reproduction of the `microorganisms` data set
# Data retrieved from the Catalogue of Life (CoL) through the Encyclopaedia of Life:
2019-02-20 00:04:48 +01:00
# https://opendata.eol.org/dataset/catalogue-of-life/
2019-03-18 14:29:41 +01:00
# (download the resource file with a name like "Catalogue of Life yyyy-mm-dd")
# and from the Leibniz Institute DSMZ-German Collection of Microorganisms and Cell Cultures
# https://www.dsmz.de/support/bacterial-nomenclature-up-to-date-downloads.html
# (download the latest "Complete List" as xlsx file)
2019-02-20 00:04:48 +01:00
2019-02-21 23:32:30 +01:00
library(dplyr)
library(AMR)
2019-03-18 14:29:41 +01:00
# unzip and extract taxon.tab (around 1.5 GB) from the CoL archive, then:
data_col <- data.table::fread("Downloads/taxon.tab")
# read the xlsx file from DSMZ (only around 2.5 MB):
data_dsmz <- readxl::read_xlsx("Downloads/DSMZ_bactnames.xlsx")
# the CoL data is over 3.7M rows:
data_col %>% freq(kingdom)
2019-02-20 00:04:48 +01:00
# Item Count Percent Cum. Count Cum. Percent
# --- ---------- ---------- -------- ----------- -------------
# 1 Animalia 2,225,627 59.1% 2,225,627 59.1%
# 2 Plantae 1,177,412 31.3% 3,403,039 90.4%
# 3 Fungi 290,145 7.7% 3,693,184 98.1%
# 4 Chromista 47,126 1.3% 3,740,310 99.3%
# 5 Bacteria 14,478 0.4% 3,754,788 99.7%
# 6 Protozoa 6,060 0.2% 3,760,848 99.9%
# 7 Viruses 3,827 0.1% 3,764,675 100.0%
# 8 Archaea 610 0.0% 3,765,285 100.0%
2019-03-18 14:29:41 +01:00
# clean data_col
data_col <- data_col %>%
as_tibble() %>%
select(col_id = taxonID,
col_id_new = acceptedNameUsageID,
fullname = scientificName,
kingdom,
phylum,
class,
order,
family,
genus,
species = specificEpithet,
subspecies = infraspecificEpithet,
rank = taxonRank,
ref = scientificNameAuthorship,
species_id = furtherInformationURL)
data_col$source <- "CoL"
# clean data_dsmz
data_dsmz <- data_dsmz %>%
2019-02-20 00:04:48 +01:00
as_tibble() %>%
2019-03-18 14:29:41 +01:00
transmute(col_id = NA_integer_,
col_id_new = NA_integer_,
fullname = "",
# kingdom = "",
# phylum = "",
# class = "",
# order = "",
# family = "",
genus = ifelse(is.na(GENUS), "", GENUS),
species = ifelse(is.na(SPECIES), "", SPECIES),
subspecies = ifelse(is.na(SUBSPECIES), "", SUBSPECIES),
rank = ifelse(species == "", "genus", "species"),
ref = AUTHORS,
species_id = as.character(RECORD_NO),
source = "DSMZ")
# DSMZ only contains genus/(sub)species, try to find taxonomic properties based on genus and data_col
ref_taxonomy <- data_col %>%
filter(genus %in% data_dsmz$genus,
family != "") %>%
distinct(genus, .keep_all = TRUE) %>%
select(kingdom, phylum, class, order, family, genus)
data_dsmz <- data_dsmz %>%
left_join(ref_taxonomy, by = "genus") %>%
mutate(kingdom = "Bacteria",
phylum = ifelse(is.na(phylum), "(unknown phylum)", phylum),
class = ifelse(is.na(class), "(unknown class)", class),
order = ifelse(is.na(order), "(unknown order)", order),
family = ifelse(is.na(family), "(unknown family)", family),
)
# combine everything
data_total <- data_col %>%
bind_rows(data_dsmz)
rm(data_col)
rm(data_dsmz)
rm(ref_taxonomy)
MOs <- data_total %>%
2019-02-20 00:04:48 +01:00
filter(
2019-02-28 13:56:28 +01:00
(
2019-04-05 18:47:39 +02:00
# we only want all MICROorganisms and no viruses
!kingdom %in% c("Animalia", "Plantae", "Viruses")
2019-03-18 14:29:41 +01:00
# and no entries above genus level - all species already have a taxonomic tree
& !rank %in% c("kingdom", "phylum", "superfamily", "class", "order", "family")
# and not all fungi: Aspergillus, Candida, Trichphyton and Pneumocystis are the most important,
2019-02-28 13:56:28 +01:00
# so only keep these orders from the fungi:
& !(kingdom == "Fungi"
& !order %in% c("Eurotiales", "Saccharomycetales", "Schizosaccharomycetales", "Tremellales", "Onygenales", "Pneumocystales"))
)
2019-03-18 14:29:41 +01:00
# or the genus has to be one of the genera we found in our hospitals last decades (Northern Netherlands, 2002-2018)
2019-02-28 13:56:28 +01:00
| genus %in% c("Absidia", "Acremonium", "Actinotignum", "Alternaria", "Anaerosalibacter", "Ancylostoma", "Anisakis", "Apophysomyces",
"Arachnia", "Ascaris", "Aureobacterium", "Aureobasidium", "Balantidum", "Bilophilia", "Branhamella", "Brochontrix",
"Brugia", "Calymmatobacterium", "Catabacter", "Cdc", "Chilomastix", "Chryseomonas", "Cladophialophora", "Cladosporium",
"Clonorchis", "Cordylobia", "Curvularia", "Demodex", "Dermatobia", "Diphyllobothrium", "Dracunculus", "Echinococcus",
"Enterobius", "Euascomycetes", "Exophiala", "Fasciola", "Fusarium", "Hendersonula", "Hymenolepis", "Kloeckera",
"Koserella", "Larva", "Leishmania", "Lelliottia", "Loa", "Lumbricus", "Malassezia", "Metagonimus", "Molonomonas",
"Mucor", "Nattrassia", "Necator", "Novospingobium", "Onchocerca", "Opistorchis", "Paragonimus", "Paramyxovirus",
"Pediculus", "Phoma", "Phthirus", "Pityrosporum", "Pseudallescheria", "Pulex", "Rhizomucor", "Rhizopus", "Rhodotorula",
"Salinococcus", "Sanguibacteroides", "Schistosoma", "Scopulariopsis", "Scytalidium", "Sporobolomyces", "Stomatococcus",
"Strongyloides", "Syncephalastraceae", "Taenia", "Torulopsis", "Trichinella", "Trichobilharzia", "Trichomonas",
"Trichosporon", "Trichuris", "Trypanosoma", "Wuchereria")
2019-04-05 18:47:39 +02:00
# or the taxonomic entry is old - the species was renamed
| !is.na(col_id_new)
)
# filter old taxonomic names so only the ones with an existing reference will be kept
MOs <- MOs %>%
filter(is.na(col_id_new) | (!is.na(col_id_new) & col_id_new %in% MOs$col_id))
MOs <- MOs %>%
2019-02-20 00:04:48 +01:00
# remove text if it contains 'Not assigned' like phylum in viruses
2019-03-18 14:29:41 +01:00
mutate_all(~gsub("Not assigned", "", .))
MOs <- MOs %>%
# Only keep first author, e.g. transform 'Smith, Jones, 2011' to 'Smith et al., 2011':
mutate(authors2 = iconv(ref, from = "UTF-8", to = "ASCII//TRANSLIT"),
2019-02-22 22:12:10 +01:00
# remove leading and trailing brackets
authors2 = gsub("^[(](.*)[)]$", "\\1", authors2),
# only take part after brackets if there's a name
authors2 = ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2),
gsub(".*[)] (.*)", "\\1", authors2),
authors2),
# get year from last 4 digits
lastyear = as.integer(gsub(".*([0-9]{4})$", "\\1", authors2)),
# can never be later than now
lastyear = ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")),
NA,
lastyear),
# get authors without last year
authors = gsub("(.*)[0-9]{4}$", "\\1", authors2),
# remove nonsense characters from names
authors = gsub("[^a-zA-Z,'& -]", "", authors),
# remove trailing and leading spaces
authors = trimws(authors),
# only keep first author and replace all others by 'et al'
2019-03-18 14:29:41 +01:00
authors = gsub("(,| and| et| &| ex| emend\\.?) .*", " et al.", authors),
2019-02-22 22:12:10 +01:00
# et al. always with ending dot
authors = gsub(" et al\\.?", " et al.", authors),
authors = gsub(" ?,$", "", authors),
# don't start with 'sensu' or 'ehrenb'
authors = gsub("^(sensu|Ehrenb.?) ", "", authors, ignore.case = TRUE),
# no initials, only surname
authors = gsub("^([A-Z]+ )+", "", authors, ignore.case = FALSE),
# combine author and year if year is available
ref = ifelse(!is.na(lastyear),
paste0(authors, ", ", lastyear),
authors),
# fix beginning and ending
ref = gsub(", $", "", ref),
ref = gsub("^, ", "", ref)
2019-02-20 00:04:48 +01:00
)
2019-03-18 14:29:41 +01:00
# Remove non-ASCII characters (these are not allowed by CRAN)
2019-02-20 00:04:48 +01:00
MOs <- MOs %>%
lapply(iconv, from = "UTF-8", to = "ASCII//TRANSLIT") %>%
as_tibble(stringsAsFactors = FALSE)
2019-03-18 14:29:41 +01:00
# Split old taxonomic names - they refer in the original data to a new `taxonID` with `acceptedNameUsageID`
2019-02-20 00:04:48 +01:00
MOs.old <- MOs %>%
2019-03-18 14:29:41 +01:00
filter(!is.na(col_id_new),
ref != "",
source != "DSMZ") %>%
transmute(col_id,
col_id_new,
2019-02-20 00:04:48 +01:00
fullname =
trimws(
gsub("(.*)[(].*", "\\1",
stringr::str_replace(
2019-03-18 14:29:41 +01:00
string = fullname,
pattern = stringr::fixed(authors2),
2019-04-05 18:47:39 +02:00
replacement = "")) %>%
gsub(" (var|f|subsp)[.]", "", .)),
2019-03-18 14:29:41 +01:00
ref) %>%
2019-02-20 00:04:48 +01:00
filter(!is.na(fullname)) %>%
distinct(fullname, .keep_all = TRUE) %>%
arrange(col_id)
MOs <- MOs %>%
2019-03-18 14:29:41 +01:00
filter(is.na(col_id_new) | source == "DSMZ") %>%
transmute(col_id,
2019-04-05 18:47:39 +02:00
fullname = trimws(paste(genus, species, subspecies)),
2019-02-20 00:04:48 +01:00
kingdom,
phylum,
class,
order,
family,
genus = gsub(":", "", genus),
2019-03-18 14:29:41 +01:00
species,
subspecies,
rank,
ref,
species_id = gsub(".*/([a-f0-9]+)", "\\1", species_id),
source) %>%
#distinct(fullname, .keep_all = TRUE) %>%
2019-02-20 00:04:48 +01:00
filter(!grepl("unassigned", fullname, ignore.case = TRUE))
2019-03-18 14:29:41 +01:00
# Filter out the DSMZ records that were renamed and are now in MOs.old
MOs <- MOs %>%
filter(!(source == "DSMZ" & fullname %in% MOs.old$fullname),
!(source == "DSMZ" & fullname %in% (MOs %>% filter(source == "CoL") %>% pull(fullname)))) %>%
distinct(fullname, .keep_all = TRUE)
# Add abbreviations so we can easily know which ones are which ones.
# These will become valid and unique microbial IDs for the AMR package.
2019-02-20 00:04:48 +01:00
MOs <- MOs %>%
group_by(kingdom) %>%
# abbreviations may be same for genera between kingdoms,
2019-03-18 14:29:41 +01:00
# because each abbreviation starts with the the first character(s) of the kingdom
2019-02-20 00:04:48 +01:00
mutate(abbr_genus = abbreviate(genus,
minlength = 5,
use.classes = TRUE,
method = "both.sides",
strict = FALSE)) %>%
ungroup() %>%
group_by(genus) %>%
# species abbreviations may be the same between genera
# because the genus abbreviation is part of the abbreviation
mutate(abbr_species = abbreviate(species,
minlength = 3,
use.classes = FALSE,
method = "both.sides")) %>%
ungroup() %>%
group_by(genus, species) %>%
mutate(abbr_subspecies = abbreviate(subspecies,
minlength = 3,
use.classes = FALSE,
method = "both.sides")) %>%
ungroup() %>%
# remove trailing underscores
mutate(mo = gsub("_+$", "",
2019-03-18 14:29:41 +01:00
toupper(paste(ifelse(kingdom %in% c("Animalia", "Plantae"),
substr(kingdom, 1, 2),
substr(kingdom, 1, 1)),
2019-02-20 00:04:48 +01:00
abbr_genus,
abbr_species,
abbr_subspecies,
sep = "_")))) %>%
2019-02-26 12:33:26 +01:00
mutate(mo = ifelse(duplicated(.$mo),
2019-03-18 14:29:41 +01:00
# these one or two must be unique too
2019-02-26 12:33:26 +01:00
paste0(mo, "1"),
mo),
fullname = ifelse(fullname == "",
2019-02-28 13:56:28 +01:00
trimws(paste(genus, species, subspecies)),
fullname)) %>%
2019-03-18 14:29:41 +01:00
# put `mo` in front, followed by the rest
2019-02-20 00:04:48 +01:00
select(mo, everything(), -abbr_genus, -abbr_species, -abbr_subspecies)
2019-02-21 23:32:30 +01:00
2019-02-20 00:04:48 +01:00
# add non-taxonomic entries
MOs <- MOs %>%
bind_rows(
2019-03-02 22:47:04 +01:00
# Unknowns
2019-03-18 14:29:41 +01:00
data.frame(mo = "UNKNOWN",
col_id = NA_integer_,
fullname = "(unknown name)",
kingdom = "(unknown kingdom)",
phylum = "(unknown phylum)",
class = "(unknown class)",
order = "(unknown order)",
family = "(unknown family)",
genus = "(unknown genus)",
species = "(unknown species)",
subspecies = "(unknown subspecies)",
rank = "(unknown rank)",
ref = NA_character_,
species_id = "",
source = "manually added",
stringsAsFactors = FALSE),
2019-03-02 22:47:04 +01:00
data.frame(mo = "B_GRAMN",
col_id = NA_integer_,
fullname = "(unknown Gram negatives)",
kingdom = "Bacteria",
phylum = "(unknown phylum)",
class = "(unknown class)",
order = "(unknown order)",
family = "(unknown family)",
genus = "(unknown Gram negatives)",
species = "(unknown species)",
subspecies = "(unknown subspecies)",
rank = "species",
ref = NA_character_,
2019-03-18 14:29:41 +01:00
species_id = "",
source = "manually added",
2019-03-02 22:47:04 +01:00
stringsAsFactors = FALSE),
data.frame(mo = "B_GRAMP",
col_id = NA_integer_,
fullname = "(unknown Gram positives)",
kingdom = "Bacteria",
phylum = "(unknown phylum)",
class = "(unknown class)",
order = "(unknown order)",
family = "(unknown family)",
genus = "(unknown Gram positives)",
species = "(unknown species)",
subspecies = "(unknown subspecies)",
rank = "species",
ref = NA_character_,
2019-03-18 14:29:41 +01:00
species_id = "",
source = "manually added",
2019-03-02 22:47:04 +01:00
stringsAsFactors = FALSE),
2019-02-20 00:04:48 +01:00
# CoNS
MOs %>%
filter(genus == "Staphylococcus", species == "epidermidis") %>% .[1,] %>%
mutate(mo = gsub("EPI", "CNS", mo),
col_id = NA_integer_,
2019-03-18 14:29:41 +01:00
species = "coagulase-negative",
fullname = "Coagulase-negative Staphylococcus (CoNS)",
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
# CoPS
MOs %>%
filter(genus == "Staphylococcus", species == "epidermidis") %>% .[1,] %>%
mutate(mo = gsub("EPI", "CPS", mo),
col_id = NA_integer_,
2019-03-18 14:29:41 +01:00
species = "coagulase-positive",
fullname = "Coagulase-positive Staphylococcus (CoPS)",
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
# Streptococci groups A, B, C, F, H, K
MOs %>%
2019-03-18 14:29:41 +01:00
filter(genus == "Streptococcus", species == "pyogenes") %>% .[1,] %>%
# we can keep all other details, since S. pyogenes is the only member of group A
mutate(mo = gsub("PYO", "GRA", mo),
2019-02-20 00:04:48 +01:00
species = "group A" ,
fullname = "Streptococcus group A"),
MOs %>%
2019-03-18 14:29:41 +01:00
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
# we can keep all other details, since S. agalactiae is the only member of group B
mutate(mo = gsub("AGA", "GRB", mo),
2019-02-20 00:04:48 +01:00
species = "group B" ,
fullname = "Streptococcus group B"),
MOs %>%
2019-03-18 14:29:41 +01:00
filter(genus == "Streptococcus", species == "dysgalactiae") %>% .[1,] %>%
mutate(mo = gsub("DYS", "GRC", mo),
2019-02-20 00:04:48 +01:00
col_id = NA_integer_,
species = "group C" ,
fullname = "Streptococcus group C",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "GRD", mo),
col_id = NA_integer_,
species = "group D" ,
fullname = "Streptococcus group D",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "GRF", mo),
col_id = NA_integer_,
species = "group F" ,
fullname = "Streptococcus group F",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "GRG", mo),
col_id = NA_integer_,
2019-03-18 14:29:41 +01:00
species = "group G" ,
2019-02-20 00:04:48 +01:00
fullname = "Streptococcus group G",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "GRH", mo),
col_id = NA_integer_,
species = "group H" ,
fullname = "Streptococcus group H",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "GRK", mo),
col_id = NA_integer_,
species = "group K" ,
fullname = "Streptococcus group K",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added"),
2019-02-20 00:04:48 +01:00
# Beta haemolytic Streptococci
MOs %>%
filter(genus == "Streptococcus", species == "agalactiae") %>% .[1,] %>%
mutate(mo = gsub("AGA", "HAE", mo),
col_id = NA_integer_,
species = "beta-haemolytic" ,
fullname = "Beta-haemolytic Streptococcus",
2019-03-18 14:29:41 +01:00
ref = NA_character_,
species_id = "",
source = "manually added")
2019-02-20 00:04:48 +01:00
)
2019-02-28 13:56:28 +01:00
# everything distinct?
sum(duplicated(MOs$mo))
2019-03-02 22:47:04 +01:00
colnames(MOs)
2019-02-28 13:56:28 +01:00
2019-02-20 00:04:48 +01:00
# save it
MOs <- as.data.frame(MOs %>% arrange(mo), stringsAsFactors = FALSE)
MOs.old <- as.data.frame(MOs.old, stringsAsFactors = FALSE)
class(MOs$mo) <- "mo"
saveRDS(MOs, "microorganisms.rds")
saveRDS(MOs.old, "microorganisms.old.rds")
2019-02-22 22:12:10 +01:00
2019-02-20 00:04:48 +01:00
# on the server:
2019-02-28 13:56:28 +01:00
usethis::use_data(microorganisms, overwrite = TRUE)
usethis::use_data(microorganisms.old, overwrite = TRUE)
rm(microorganisms)
rm(microorganisms.old)
2019-03-18 14:29:41 +01:00
# and update the year in R/data.R