mirror of
https://github.com/msberends/AMR.git
synced 2026-07-17 22:30:56 +02:00
Compare commits
4 Commits
main
...
8fb640256a
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
8fb640256a | ||
|
|
8d959f54cb | ||
|
|
ee6fab9b50 | ||
|
|
623f6230f9 |
2
.github/workflows/check-old-tinytest.yaml
vendored
2
.github/workflows/check-old-tinytest.yaml
vendored
@@ -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: ubuntu-latest, r: '3.6', allowfail: false}
|
- {os: ubuntu-latest, r: '3.6', allowfail: false}
|
||||||
# - {os: windows-latest, r: '3.5', allowfail: false} # always fails, horrible with UTF-8
|
# - {os: windows-latest, r: '3.5', allowfail: false} # always fails, horrible with UTF-8
|
||||||
# - {os: ubuntu-latest, r: '3.4', allowfail: false} # 3.1-3.4 now always fails with Error in grep(warn_re, lines, invert = TRUE, value = TRUE) attempt to set index 46/46 in SET_STRING_ELT
|
# - {os: ubuntu-latest, r: '3.4', allowfail: false} # 3.1-3.4 now always fails with Error in grep(warn_re, lines, invert = TRUE, value = TRUE) attempt to set index 46/46 in SET_STRING_ELT
|
||||||
# - {os: ubuntu-latest, r: '3.3', allowfail: false}
|
# - {os: ubuntu-latest, r: '3.3', allowfail: false}
|
||||||
|
|||||||
247
.github/workflows/todo-tracker.yml
vendored
247
.github/workflows/todo-tracker.yml
vendored
@@ -29,6 +29,7 @@
|
|||||||
|
|
||||||
on:
|
on:
|
||||||
push:
|
push:
|
||||||
|
# only on main
|
||||||
branches: "main"
|
branches: "main"
|
||||||
|
|
||||||
name: Update TODO Tracker
|
name: Update TODO Tracker
|
||||||
@@ -39,228 +40,40 @@ jobs:
|
|||||||
|
|
||||||
steps:
|
steps:
|
||||||
- uses: actions/checkout@v4
|
- uses: actions/checkout@v4
|
||||||
with:
|
|
||||||
fetch-depth: 0 # full history required for git blame
|
|
||||||
|
|
||||||
- name: Generate TODO report
|
- name: Generate TODO list from R/
|
||||||
env:
|
|
||||||
GH_TOKEN: ${{ secrets.GH_REPO_SCOPE }}
|
|
||||||
run: |
|
run: |
|
||||||
set -euo pipefail
|
|
||||||
export TZ=Europe/Amsterdam
|
export TZ=Europe/Amsterdam
|
||||||
|
last_updated=$(date +"%e %B %Y %H:%M:%S %Z" | sed 's/^ *//')
|
||||||
REPO="msberends/AMR"
|
echo "## \`TODO\` Report" > todo.md
|
||||||
REPO_URL="https://github.com/$REPO/blob/main"
|
echo "" >> todo.md
|
||||||
NOW=$(date +%s)
|
echo "**Last Updated: ${last_updated}**" >> todo.md
|
||||||
LAST_UPDATED=$(date +"%e %B %Y %H:%M:%S %Z" | sed 's/^ *//')
|
echo "" >> todo.md
|
||||||
STALE_DAYS=180
|
echo "_This overview is automatically updated on each push to \`main\`. It provides an automated overview of all mentions of the text \`TODO\`._" >> todo.md
|
||||||
|
echo "" >> todo.md
|
||||||
# ── helper: human-readable age ──────────────────────────────
|
todos=$(grep -rn --include=\*.{R,Rmd,yaml,yml,md,css,js} --exclude={todo-tracker.yml,todo.md} "TODO" . || true)
|
||||||
format_age() {
|
if [ -z "$todos" ]; then
|
||||||
local d=$1
|
echo "✅ No TODOs found." >> todo.md
|
||||||
if [ "$d" -lt 0 ] 2>/dev/null; then echo "unknown"; return; fi
|
else
|
||||||
local y=$((d / 365)) m=$(( (d % 365) / 30 ))
|
echo "$todos" | awk -F: -v repo="https://github.com/msberends/AMR/blob/main/" '
|
||||||
if [ "$y" -gt 0 ] && [ "$m" -gt 0 ]; then echo "${y}y ${m}m"
|
{
|
||||||
elif [ "$y" -gt 0 ]; then echo "${y}y"
|
file = $1
|
||||||
elif [ "$m" -gt 0 ]; then echo "${m}m"
|
gsub("^\\./", "", file) # remove leading ./ if present
|
||||||
else echo "${d}d"
|
line = $2
|
||||||
fi
|
text = substr($0, index($0,$3))
|
||||||
}
|
if (file != last_file) {
|
||||||
|
if (last_file != "") print "```"
|
||||||
export -f format_age
|
print ""
|
||||||
|
print "### [`" file "`](" repo file ")"
|
||||||
# ── step 1: find all markers ────────────────────────────────
|
print "```r"
|
||||||
grep -rn \
|
last_file = file
|
||||||
--include='*.R' --include='*.Rmd' --include='*.yaml' \
|
}
|
||||||
--include='*.yml' --include='*.md' --include='*.css' \
|
printf "L%s: %s\n", line, text
|
||||||
--include='*.js' \
|
}
|
||||||
--exclude='todo-tracker.yml' --exclude='todo.md' \
|
' >> todo.md
|
||||||
-E '\b(TODO|FIXME|HACK|XXX)\b' . > /tmp/raw.txt || true
|
echo "\`\`\`" >> todo.md
|
||||||
|
|
||||||
if [ ! -s /tmp/raw.txt ]; then
|
|
||||||
echo -e "## \`TODO\` Report\n\n**Last Updated: ${LAST_UPDATED}**\n\nNo markers found." > todo.md
|
|
||||||
exit 0
|
|
||||||
fi
|
fi
|
||||||
|
|
||||||
# ── step 2: enrich with git blame & extract issue refs ──────
|
|
||||||
> /tmp/enriched.tsv
|
|
||||||
> /tmp/issues_seen.txt
|
|
||||||
|
|
||||||
while IFS= read -r match; do
|
|
||||||
clean=$(printf '%s\n' "$match" | sed 's|^\./||')
|
|
||||||
file=$(printf '%s\n' "$clean" | cut -d: -f1)
|
|
||||||
lineno=$(printf '%s\n' "$clean" | cut -d: -f2)
|
|
||||||
text=$(printf '%s\n' "$clean" | cut -d: -f3-)
|
|
||||||
|
|
||||||
# determine marker type (first match wins, TODO is default)
|
|
||||||
marker="TODO"
|
|
||||||
for m in FIXME HACK XXX; do
|
|
||||||
if printf '%s\n' "$text" | grep -qw "$m"; then marker="$m"; break; fi
|
|
||||||
done
|
|
||||||
|
|
||||||
# git blame timestamp
|
|
||||||
blame_ts=$(git blame -L "${lineno},${lineno}" --porcelain -- "$file" 2>/dev/null \
|
|
||||||
| awk '/^author-time/{print $2}' || echo "0")
|
|
||||||
blame_ts=${blame_ts:-0}
|
|
||||||
|
|
||||||
if [ "$blame_ts" -gt 0 ] 2>/dev/null; then
|
|
||||||
age_days=$(( (NOW - blame_ts) / 86400 ))
|
|
||||||
else
|
|
||||||
age_days=-1
|
|
||||||
fi
|
|
||||||
|
|
||||||
# extract issue references (#NNN)
|
|
||||||
issues=$(printf '%s\n' "$text" | grep -oE '#[0-9]+' | sed 's/#//' | tr '\n' ',' | sed 's/,$//' || true)
|
|
||||||
if [ -n "$issues" ]; then
|
|
||||||
for inum in $(echo "$issues" | tr ',' ' '); do
|
|
||||||
echo "$inum" >> /tmp/issues_seen.txt
|
|
||||||
done
|
|
||||||
fi
|
|
||||||
|
|
||||||
printf '%s\t%s\t%s\t%s\t%s\t%s\n' \
|
|
||||||
"$file" "$lineno" "$marker" "$age_days" "$issues" "$text" >> /tmp/enriched.tsv
|
|
||||||
done < /tmp/raw.txt
|
|
||||||
|
|
||||||
# ── step 3: query GitHub API for referenced issues ──────────
|
|
||||||
> /tmp/issue_info.tsv
|
|
||||||
if [ -s /tmp/issues_seen.txt ]; then
|
|
||||||
sort -un /tmp/issues_seen.txt | while read -r inum; do
|
|
||||||
info=$(gh api "/repos/$REPO/issues/$inum" \
|
|
||||||
--jq '"\(.state)\t\(.title)"' 2>/dev/null \
|
|
||||||
|| echo "unknown (could not fetch)")
|
|
||||||
printf '%s\t%s\n' "$inum" "$info" >> /tmp/issue_info.tsv
|
|
||||||
done
|
|
||||||
fi
|
|
||||||
|
|
||||||
# ── step 4: build the report ────────────────────────────────
|
|
||||||
{
|
|
||||||
# ── header ──
|
|
||||||
echo "## \`TODO\` Report"
|
|
||||||
echo ""
|
|
||||||
echo "**Last Updated: ${LAST_UPDATED}**"
|
|
||||||
echo ""
|
|
||||||
echo "_This overview is automatically updated on each push to \`main\`. It scans for \`TODO\`, \`FIXME\`, \`HACK\`, and \`XXX\` markers across the codebase._"
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
# ── summary table ──
|
|
||||||
total=$(wc -l < /tmp/enriched.tsv | tr -d ' ')
|
|
||||||
files_affected=$(awk -F'\t' '{print $1}' /tmp/enriched.tsv | sort -u | wc -l | tr -d ' ')
|
|
||||||
todo_n=$(awk -F'\t' '$3=="TODO"' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
fixme_n=$(awk -F'\t' '$3=="FIXME"' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
hack_n=$(awk -F'\t' '$3=="HACK"' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
xxx_n=$(awk -F'\t' '$3=="XXX"' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
stale_n=$(awk -F'\t' -v s="$STALE_DAYS" '$4 > s' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
linked_n=$(awk -F'\t' '$5 != ""' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
unlinked_n=$(awk -F'\t' '$5 == ""' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
|
|
||||||
# oldest marker
|
|
||||||
oldest_line=$(awk -F'\t' '$4 >= 0' /tmp/enriched.tsv | sort -t$'\t' -k4 -rn | head -1)
|
|
||||||
oldest_days=$(echo "$oldest_line" | cut -f4)
|
|
||||||
oldest_file=$(echo "$oldest_line" | cut -f1)
|
|
||||||
oldest_lineno=$(echo "$oldest_line" | cut -f2)
|
|
||||||
oldest_age=$(format_age "$oldest_days")
|
|
||||||
|
|
||||||
echo "### Summary"
|
|
||||||
echo ""
|
|
||||||
echo "| Metric | Value |"
|
|
||||||
echo "|:---|---:|"
|
|
||||||
echo "| Total markers | **${total}** |"
|
|
||||||
[ "$todo_n" -gt 0 ] && echo "| \`TODO\` | ${todo_n} |"
|
|
||||||
[ "$fixme_n" -gt 0 ] && echo "| \`FIXME\` | ${fixme_n} |"
|
|
||||||
[ "$hack_n" -gt 0 ] && echo "| \`HACK\` | ${hack_n} |"
|
|
||||||
[ "$xxx_n" -gt 0 ] && echo "| \`XXX\` | ${xxx_n} |"
|
|
||||||
echo "| Files affected | ${files_affected} |"
|
|
||||||
echo "| Stale (> 6 months) | ${stale_n} |"
|
|
||||||
echo "| Oldest marker | ${oldest_age}, \`${oldest_file}\` L${oldest_lineno} |"
|
|
||||||
echo "| Linked to issues | ${linked_n} |"
|
|
||||||
echo "| Unlinked (no issue ref) | ${unlinked_n} |"
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
# ── by referenced issue ──
|
|
||||||
if [ -s /tmp/issue_info.tsv ]; then
|
|
||||||
echo "### By Referenced Issue"
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
has_closed=false
|
|
||||||
|
|
||||||
while IFS=$'\t' read -r inum state title; do
|
|
||||||
count=$(awk -F'\t' -v n="$inum" '$5 ~ "(^|,)"n"(,|$)"' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
[ "$state" = "closed" ] && has_closed=true
|
|
||||||
|
|
||||||
state_icon=""
|
|
||||||
[ "$state" = "closed" ] && state_icon=" :warning:"
|
|
||||||
|
|
||||||
echo "<details><summary><b>#${inum}</b> (${state}): <i>${title}</i> — ${count} marker(s)${state_icon}</summary>"
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
awk -F'\t' -v n="$inum" '$5 ~ "(^|,)"n"(,|$)"' /tmp/enriched.tsv \
|
|
||||||
| while IFS=$'\t' read -r f l m d refs txt; do
|
|
||||||
age_str=$(format_age "$d")
|
|
||||||
flag=""
|
|
||||||
[ "$d" -gt "$STALE_DAYS" ] 2>/dev/null && flag=" :warning:"
|
|
||||||
# re-read the actual source line and trim leading/trailing whitespace
|
|
||||||
src_text=$(sed -n "${l}p" "$f" 2>/dev/null | sed 's/^[[:space:]]*//;s/[[:space:]]*$//' || true)
|
|
||||||
echo "- [\`${f}\` L${l}](${REPO_URL}/${f}#L${l}) (${age_str} ago)${flag}"
|
|
||||||
[ -n "$src_text" ] && echo " \`${src_text}\`"
|
|
||||||
done
|
|
||||||
|
|
||||||
echo ""
|
|
||||||
echo "</details>"
|
|
||||||
echo ""
|
|
||||||
done < /tmp/issue_info.tsv
|
|
||||||
|
|
||||||
if [ "$has_closed" = true ]; then
|
|
||||||
echo "> **Warning:** some markers reference closed issues and may be stale."
|
|
||||||
echo ""
|
|
||||||
fi
|
|
||||||
fi
|
|
||||||
|
|
||||||
# ── by file ──
|
|
||||||
echo "### By File"
|
|
||||||
echo ""
|
|
||||||
|
|
||||||
prev_file=""
|
|
||||||
prev_lineno=-99
|
|
||||||
|
|
||||||
while IFS=$'\t' read -r file lineno marker age_days issues text; do
|
|
||||||
if [ "$file" != "$prev_file" ]; then
|
|
||||||
# close previous code block
|
|
||||||
if [ -n "$prev_file" ]; then
|
|
||||||
echo '```'
|
|
||||||
echo ""
|
|
||||||
fi
|
|
||||||
|
|
||||||
file_count=$(awk -F'\t' -v f="$file" '$1==f' /tmp/enriched.tsv | wc -l | tr -d ' ')
|
|
||||||
echo "#### [\`${file}\`](${REPO_URL}/${file}) — ${file_count} marker(s)"
|
|
||||||
echo '```r'
|
|
||||||
|
|
||||||
prev_lineno=-99
|
|
||||||
fi
|
|
||||||
|
|
||||||
# blank line between non-sequential lines (visual grouping)
|
|
||||||
if [ "$file" = "$prev_file" ] && [ $((lineno - prev_lineno)) -gt 1 ]; then
|
|
||||||
echo ""
|
|
||||||
fi
|
|
||||||
|
|
||||||
age_str=$(format_age "$age_days")
|
|
||||||
flag=""
|
|
||||||
[ "$age_days" -gt "$STALE_DAYS" ] 2>/dev/null && flag=" !!"
|
|
||||||
|
|
||||||
# re-read the actual source line to avoid TSV round-trip corruption
|
|
||||||
src_line=$(sed -n "${lineno}p" "$file" 2>/dev/null | sed 's/[[:space:]]*$//' || true)
|
|
||||||
printf 'L%s: %s ◁ %s ago%s\n' "$lineno" "$src_line" "$age_str" "$flag"
|
|
||||||
|
|
||||||
prev_file="$file"
|
|
||||||
prev_lineno="$lineno"
|
|
||||||
done < <(sort -t$'\t' -k1,1 -k2,2n /tmp/enriched.tsv)
|
|
||||||
|
|
||||||
# close final code block
|
|
||||||
if [ -n "$prev_file" ]; then
|
|
||||||
echo '```'
|
|
||||||
fi
|
|
||||||
|
|
||||||
} > todo.md
|
|
||||||
|
|
||||||
- name: Update GitHub issue
|
- name: Update GitHub issue
|
||||||
uses: peter-evans/create-or-update-comment@v4
|
uses: peter-evans/create-or-update-comment@v4
|
||||||
with:
|
with:
|
||||||
|
|||||||
1
.gitignore
vendored
1
.gitignore
vendored
@@ -22,7 +22,6 @@ vignettes/*.R
|
|||||||
^CRAN-RELEASE$
|
^CRAN-RELEASE$
|
||||||
packrat/lib*/
|
packrat/lib*/
|
||||||
packrat/src/
|
packrat/src/
|
||||||
*~$*
|
|
||||||
data-raw/taxa.txt
|
data-raw/taxa.txt
|
||||||
data-raw/taxon.tab
|
data-raw/taxon.tab
|
||||||
data-raw/CLSI*.pdf
|
data-raw/CLSI*.pdf
|
||||||
|
|||||||
@@ -2,7 +2,7 @@ Version: 1.0
|
|||||||
ProjectId: 5128c748-a412-44db-a5fb-45c68c93dd10
|
ProjectId: 5128c748-a412-44db-a5fb-45c68c93dd10
|
||||||
|
|
||||||
RestoreWorkspace: No
|
RestoreWorkspace: No
|
||||||
SaveWorkspace: Ask
|
SaveWorkspace: No
|
||||||
AlwaysSaveHistory: Yes
|
AlwaysSaveHistory: Yes
|
||||||
|
|
||||||
EnableCodeIndexing: Yes
|
EnableCodeIndexing: Yes
|
||||||
|
|||||||
21
CLAUDE.md
21
CLAUDE.md
@@ -85,27 +85,6 @@ _pkgdown.yml # pkgdown website configuration
|
|||||||
- `translate.R` — 28-language translation system
|
- `translate.R` — 28-language translation system
|
||||||
- `ggplot_sir.R` / `ggplot_pca.R` / `plotting.R` — visualisation functions
|
- `ggplot_sir.R` / `ggplot_pca.R` / `plotting.R` — visualisation functions
|
||||||
|
|
||||||
## Code Style
|
|
||||||
|
|
||||||
Follow the [tidyverse style guide](https://style.tidyverse.org/) precisely. Key rules:
|
|
||||||
|
|
||||||
- 2-space indentation; no tabs
|
|
||||||
- `<-` for assignment, not `=`
|
|
||||||
- Spaces around all binary operators and after commas; no spaces inside parentheses
|
|
||||||
- When a function call must break across lines, place the first argument on a new line indented by 2 spaces, and put the closing `)` on its own line — **never align arguments to the opening parenthesis** (no hanging/forced mid-line indentation)
|
|
||||||
|
|
||||||
```r
|
|
||||||
# good
|
|
||||||
stop_(
|
|
||||||
"some long message part one ",
|
|
||||||
"part two"
|
|
||||||
)
|
|
||||||
|
|
||||||
# bad — forces indentation to match the opening parenthesis
|
|
||||||
stop_("some long message part one ",
|
|
||||||
"part two")
|
|
||||||
```
|
|
||||||
|
|
||||||
## Custom S3 Classes
|
## Custom S3 Classes
|
||||||
|
|
||||||
The package defines five S3 classes with full print/format/plot/vctrs support:
|
The package defines five S3 classes with full print/format/plot/vctrs support:
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 3.0.1.9085
|
Version: 3.0.1.9055
|
||||||
Date: 2026-07-09
|
Date: 2026-04-30
|
||||||
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)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
@@ -73,4 +73,4 @@ License: GPL-2 | file LICENSE
|
|||||||
Encoding: UTF-8
|
Encoding: UTF-8
|
||||||
LazyData: true
|
LazyData: true
|
||||||
RoxygenNote: 7.3.3
|
RoxygenNote: 7.3.3
|
||||||
Roxygen: list(markdown = TRUE)
|
Roxygen: list(markdown = TRUE, old_usage = TRUE)
|
||||||
|
|||||||
@@ -49,7 +49,6 @@ S3method(as.data.frame,mo)
|
|||||||
S3method(as.double,mic)
|
S3method(as.double,mic)
|
||||||
S3method(as.double,sir)
|
S3method(as.double,sir)
|
||||||
S3method(as.list,custom_eucast_rules)
|
S3method(as.list,custom_eucast_rules)
|
||||||
S3method(as.list,custom_interpretive_rules)
|
|
||||||
S3method(as.list,custom_mdro_guideline)
|
S3method(as.list,custom_mdro_guideline)
|
||||||
S3method(as.list,mic)
|
S3method(as.list,mic)
|
||||||
S3method(as.matrix,mic)
|
S3method(as.matrix,mic)
|
||||||
@@ -67,7 +66,6 @@ S3method(c,ab)
|
|||||||
S3method(c,amr_selector)
|
S3method(c,amr_selector)
|
||||||
S3method(c,av)
|
S3method(c,av)
|
||||||
S3method(c,custom_eucast_rules)
|
S3method(c,custom_eucast_rules)
|
||||||
S3method(c,custom_interpretive_rules)
|
|
||||||
S3method(c,custom_mdro_guideline)
|
S3method(c,custom_mdro_guideline)
|
||||||
S3method(c,disk)
|
S3method(c,disk)
|
||||||
S3method(c,mic)
|
S3method(c,mic)
|
||||||
@@ -98,7 +96,6 @@ S3method(print,amr_selector)
|
|||||||
S3method(print,av)
|
S3method(print,av)
|
||||||
S3method(print,bug_drug_combinations)
|
S3method(print,bug_drug_combinations)
|
||||||
S3method(print,custom_eucast_rules)
|
S3method(print,custom_eucast_rules)
|
||||||
S3method(print,custom_interpretive_rules)
|
|
||||||
S3method(print,custom_mdro_guideline)
|
S3method(print,custom_mdro_guideline)
|
||||||
S3method(print,deprecated_amr_dataset)
|
S3method(print,deprecated_amr_dataset)
|
||||||
S3method(print,disk)
|
S3method(print,disk)
|
||||||
@@ -231,7 +228,6 @@ export(count_df)
|
|||||||
export(count_resistant)
|
export(count_resistant)
|
||||||
export(count_susceptible)
|
export(count_susceptible)
|
||||||
export(custom_eucast_rules)
|
export(custom_eucast_rules)
|
||||||
export(custom_interpretive_rules)
|
|
||||||
export(custom_mdro_guideline)
|
export(custom_mdro_guideline)
|
||||||
export(eucast_dosage)
|
export(eucast_dosage)
|
||||||
export(eucast_exceptional_phenotypes)
|
export(eucast_exceptional_phenotypes)
|
||||||
@@ -300,7 +296,6 @@ export(mo_is_yeast)
|
|||||||
export(mo_kingdom)
|
export(mo_kingdom)
|
||||||
export(mo_lpsn)
|
export(mo_lpsn)
|
||||||
export(mo_matching_score)
|
export(mo_matching_score)
|
||||||
export(mo_morphology)
|
|
||||||
export(mo_mycobank)
|
export(mo_mycobank)
|
||||||
export(mo_name)
|
export(mo_name)
|
||||||
export(mo_order)
|
export(mo_order)
|
||||||
@@ -386,7 +381,6 @@ export(translate_AMR)
|
|||||||
export(trimethoprims)
|
export(trimethoprims)
|
||||||
export(ureidopenicillins)
|
export(ureidopenicillins)
|
||||||
export(wisca)
|
export(wisca)
|
||||||
export(wisca_plot)
|
|
||||||
if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
|
if(getRversion() >= "3.0.0") S3method(cleaner::freq, mo)
|
||||||
if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
|
if(getRversion() >= "3.0.0") S3method(cleaner::freq, sir)
|
||||||
if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
|
if(getRversion() >= "3.0.0") S3method(ggplot2::autoplot, antibiogram)
|
||||||
|
|||||||
110
NEWS.md
110
NEWS.md
@@ -1,60 +1,66 @@
|
|||||||
# AMR 3.0.1.9085
|
# AMR 3.0.1.9055
|
||||||
|
|
||||||
Planned as v3.1.0, end of June 2026.
|
This will become release v3.1.0, intended for launch end of May.
|
||||||
|
|
||||||
### Breaking Changes
|
|
||||||
* The former *kingdoms* Bacteria and Archaea are now each divided into four kingdoms with new top-level *domains* 'Bacteria' and 'Archaea' (Göker and Oren, 2024, DOI: 10.1099/ijsem.0.006242). Following this, a new `domain` column in the `microorganisms` data set was added, and more importantly, `mo_kingdom()` now returns the formal kingdom (e.g. `"Pseudomonadati"` instead of `"Bacteria"`). Use `mo_domain()` for the old behaviour. For non-prokaryotic kingdoms (Fungi, Protozoa, etc.), `kingdom` and `domain` are identical.
|
|
||||||
* Faster parallel computing via the `future` package for `as.sir()` and `wisca()`: a non-sequential plan (e.g. `future::plan(future::multisession)`) must be active before using `parallel = TRUE`.
|
|
||||||
|
|
||||||
### New
|
### New
|
||||||
* EUCAST 2026 and CLSI 2026 breakpoints: over 5,700 new breakpoints added to the `clinical_breakpoints` data set; EUCAST 2026 is now the default for all MIC and disk diffusion interpretations
|
* Support for clinical breakpoints of 2026 of both CLSI and EUCAST, by adding all of their over 5,700 new clinical breakpoints to the `clinical_breakpoints` data set for usage in `as.sir()`. EUCAST 2026 is now the new default guideline for all MIC and disk diffusion interpretations.
|
||||||
* Wildtype/Non-wildtype (WT/NWT) output when using ECOFF-based interpretation, by setting `breakpoint_type = "ECOFF"` in `as.sir()`; WT/NWT results are fully supported in all resistance/susceptibility functions and plots (#254)
|
* Support for the [`future`](https://future.futureverse.org) package and its framework, as the previous implementation of parallel computing was slow
|
||||||
* *tidymodels* integration for using SIR, MIC and disk data in modelling pipelines: `step_mic_log2()`, `step_sir_numeric()`, and new column selectors `all_sir()`, `all_mic()`, `all_disk()`
|
- **Breaking change**: `as.sir()` with `parallel = TRUE` now requires a non-sequential `future::plan()` to be active before the call — e.g., `future::plan(future::multisession)` — and throws an informative error if none is set.
|
||||||
* New `esbl_isolates` data set for practising AMR modelling
|
- New all-core usage setup: when the number of AB columns is smaller than the number of available cores, rows are now split into batches so all cores stay active (row-batch mode). Previously, a 6-column dataset on a 16-core machine would only use 6 cores; now all 16 are used, with each worker processing a smaller row slice (lower per-worker memory pressure and processing time)
|
||||||
* New antimicrobial selectors: `ionophores()`, `peptides()`, `phosphonics()`, `spiropyrimidinetriones()`
|
- `antibiogram()` and `wisca()` gained a `parallel` argument using the same `future`/`future.apply` pattern: for WISCA, Monte Carlo simulations are split into `(group, chunk)` job pairs distributed across workers; for grouped antibiograms, each group is processed by a separate worker (#281)
|
||||||
* New antimicrobials: cefepime/taniborbactam (`FTA`), ceftibuten/avibactam (`CTA`), clorobiocin (`CLB`), kasugamycin (`KAS`), ostreogrycin (`OST`), taniborbactam (`TAN`), thiostrepton (`THS`), xeruborbactam (`XER`), zorbamycin (`ZOR`)
|
* Integration with the *tidymodels* framework to allow seamless use of SIR, MIC and disk data in modelling pipelines via `recipes`
|
||||||
* New `interpretive_rules()`, a unified function for EUCAST and CLSI interpretive rules; `eucast_rules()` is now a wrapper around it (#235, #259)
|
- `step_mic_log2()` to transform `<mic>` columns with log2, and `step_sir_numeric()` to convert `<sir>` columns to numeric
|
||||||
* New `morphology` column in the `microorganisms` data set and corresponding `mo_morphology()` function, returning the cell shape of bacteria. Data sourced from BacDive; values prefixed with "likely" are extrapolated from genus-level consensus. New `add_morphology` argument was added to `mo_gramstain()` to return combined results such as `"Gram-negative rods"`.
|
- New `tidyselect` helpers:
|
||||||
* New `amr_course()` to download and unpack course or webinar materials from GitHub in one call
|
- `all_sir()`, `all_sir_predictors()`
|
||||||
* Typed missing value constants `NA_ab_` and `NA_mo_`, for use in pipelines that need missing values of a specific class
|
- `all_mic()`, `all_mic_predictors()`
|
||||||
* New `wisca_plot()` to assess the susceptibility and incidence distributions from the Monte Carlo simulations
|
- `all_disk()`, `all_disk_predictors()`
|
||||||
|
* Data set `esbl_isolates` to practise with AMR modelling
|
||||||
|
* AMR selectors `ionophores()`, `peptides()`, `phosphonics()` and `spiropyrimidinetriones()`
|
||||||
|
* Support for Wildtype (WT) / Non-wildtype (NWT) in `as.sir()`, all plotting functions, and all susceptibility/resistance functions.
|
||||||
|
- `as.sir()` gained an argument `as_wt_nwt`, which defaults to `TRUE` only when `breakpoint_type = "ECOFF"` (#254)
|
||||||
|
- This transforms the output from S/R to WT/NWT
|
||||||
|
- Functions such as `susceptibility()` count WT as S and NWT as R
|
||||||
|
* Function `interpretive_rules()`, which allows future implementation of CLSI interpretive rules (#235)
|
||||||
|
- `eucast_rules()` has become a wrapper around that function
|
||||||
|
- Gained argument `add_if_missing` (default: `TRUE`). When set to `FALSE`, rules are only applied to cells that already contain an SIR value; `NA` cells are left untouched. This is useful with `overwrite = TRUE` to update reported results without imputing values for drugs that were not tested (#259)
|
||||||
|
* Function `amr_course()`, which allows for automated download and unpacking of a GitHub repository for e.g. webinar use
|
||||||
|
* Two new `NA` objects, `NA_ab_` and `NA_mo_`, analogous to base R's `NA_character_` and `NA_integer_`, for use in pipelines that require typed missing values
|
||||||
|
|
||||||
### Fixed
|
### Fixes
|
||||||
* Setting `options(AMR_guideline = "EUCAST 2012")` or any year-qualified value no longer causes errors or silent wrong behaviour in `interpretive_rules()`, `resistance()`, `susceptibility()`, `count_resistant()`, `count_susceptible()`, and SIR plotting/printing functions (#298)
|
* Fixed a bug in `as.sir()` where values that were purely numeric (e.g., `"1"`) and matched the broad SIR-matching regex would be incorrectly stripped of all content by the Unicode letter filter
|
||||||
* `as.sir()`
|
* Fixed a bug in `as.mic()` where MIC values in scientific notation (e.g., `"1e-3"`) were incorrectly handled because the letter `e` was removed along with other Unicode letters; scientific notation `e` is now preserved
|
||||||
* On data frames: already-converted SIR columns no longer dropped on re-run (#278)
|
* Fixed a bug in `as.ab()` where certain AB codes containing "PH" or "TH" (such as `ETH`, `MTH`, `PHE`, `PHN`, `STH`, `THA`, `THI1`) would incorrectly return `NA` when combined in a vector with any untranslatable value (#245)
|
||||||
* Metadata columns (e.g. `patient`, `ward`) no longer misidentified as antibiotic columns
|
* Fixed a bug in `antibiogram()` for when no antimicrobials are set
|
||||||
* `info = FALSE` now suppresses all messages, including for columns without breakpoints
|
* Fixed a bug in `as.sir()` where for numeric input the arguments `S`, `I`, and `R` would not be considered (#244)
|
||||||
* Assumption of disk zones are now preferred over MIC values when input is only whole numbers (#291)
|
* Fixed a bug in plotting MIC values when `keep_operators = "all"`
|
||||||
* `as.mic()`: values in scientific notation (e.g. `1e-3`) now handled correctly
|
* Fixed some foreign translations of antimicrobial drugs
|
||||||
* `as.ab()`: codes containing "PH" or "TH" (e.g. `ETH`, `PHE`) no longer return `NA` when mixed with unrecognised input (#245)
|
* Fixed a bug for printing column names to the console when using `mutate_at(vars(...), as.mic)` (#249)
|
||||||
* Combined MIC/SIR input values (e.g. `"<= 0.002; S"` or `"S; 0.002"`) now parsed correctly (#252)
|
* Fixed a bug to disregard `NI` for susceptibility proportion functions
|
||||||
* `as.mo()`:
|
* Fixed Italian translation of CoNS to Stafilococco coagulasi-negativo and CoPS to Stafilococco coagulasi-positivo (#256)
|
||||||
* Input of the form `"X complex"` now falls back to `"X"` when the complex is not a distinct taxon in the database, preventing `NA` results for valid clinical descriptions such as `"Proteus vulgaris complex"` (#287)
|
* Fixed SIR and MIC coercion of combined values, e.g. `as.sir("<= 0.002; S") ` or `as.mic("S; 0.002")` (#252)
|
||||||
* Abbreviated-genus input (e.g. `"S. apiospermum"`) now correctly ranks candidates whose species epithet exactly matches the input above more-prevalent organisms whose species does not match; fixes `"S. apiospermum"` resolving to *Staphylococcus* instead of *Scedosporium apiospermum* (#288)
|
* Fixed translation of foreign languages in `sir_df()` (#272)
|
||||||
* Abbreviated-genus input for species that have subspecies (e.g. `"P. ovale"`) now collapses to the species-rank record instead of incorrectly matching a more-prevalent organism; explicit subspecies queries (e.g. `"P. ovale curtisi"`) are preserved (#288)
|
* Fixed BRMO classification by including bacterial complexes (#275)
|
||||||
* `get_author_year()` in the microorganism reproduction script now strips `emend.` and everything after it, so `ref` reflects the combination authority rather than the emendation author (e.g. *Rhodococcus equi* now returns "Goodfellow et al., 1977" instead of "Nouioui et al., 2018")
|
* Fixed `as.sir()` for data frames silently deleting columns whose AB class was already `<sir>` when called a second time (re-running on already-converted data) (#278)
|
||||||
* BRMO classification now includes bacterial complexes (#275)
|
* Fixed `as.sir()` for data frames incorrectly treating metadata columns (e.g. `patient`, `ward`) as antibiotic columns when their names coincidentally matched an antibiotic code; column content is now validated against AMR data patterns before inclusion
|
||||||
* Translation fixes for Italian CoNS/CoPS names (#256), Dutch antimicrobials, and `sir_df()` foreign-language output (#272)
|
* Fixed `as.sir()` ignoring `info = FALSE` for columns with no breakpoints (e.g. cefoxitin against *E. coli*)
|
||||||
* Fixed some EUCAST Expert Rules, mostly on *S. pneumoniae*
|
|
||||||
|
### Updates
|
||||||
|
* `as.sir()` with `reference_data`: custom guideline names now correctly classify values as R using EUCAST convention (`> breakpoint_R` for MIC, `< breakpoint_R` for disk); custom breakpoints with `host = NA` now serve as a host-agnostic fallback when no host-specific row matches (#239)
|
||||||
|
* Extensive `cli` integration for better message handling and clickable links in messages and warnings (#191, #265)
|
||||||
|
* `mdro()` now infers resistance for a _missing_ base drug column from an _available_ corresponding drug+inhibitor combination showing resistance (e.g., piperacillin is absent but required, while piperacillin/tazobactam available and resistant). Can be set with the new argument `infer_from_combinations`, which defaults to `TRUE` (#209). Note that this can yield a higher MDRO detection (which is a good thing as it has become more reliable).
|
||||||
|
* `susceptibility()` and `resistance()` gained the argument `guideline`, which defaults to EUCAST, for interpreting the 'I' category correctly.
|
||||||
|
* Added to the `antimicrobials` data set: cefepime/taniborbactam (`FTA`), ceftibuten/avibactam (`CTA`), clorobiocin (`CLB`), kasugamycin (`KAS`), ostreogrycin (`OST`), taniborbactam (`TAN`), thiostrepton (`THS`), xeruborbactam (`XER`), and zorbamycin (`ZOR`)
|
||||||
|
* `as.mic()` and `rescale_mic()` gained the argument `round_to_next_log2`, which can be set to `TRUE` to round all values up to the nearest next log2 level (#255)
|
||||||
|
* `antimicrobials$group` is now a `list` instead of a `character`, to contain any group the drug is in (#246)
|
||||||
|
* `ab_group()` gained an argument `all_groups` to return all groups the antimicrobial drug is in (#246)
|
||||||
|
* Added explaining message to `as.sir()` when interpreting numeric values (e.g., 1 for S, 2 for I, 3 for R) (#244)
|
||||||
|
* Updated handling of capped MIC values (`<`, `<=`, `>`, `>=`) in `as.sir()` in the argument `capped_mic_handling`: (#243)
|
||||||
|
* Introduced four clearly defined options: `"none"`, `"conservative"` (default), `"standard"`, and `"lenient"`
|
||||||
|
* Interpretation of capped MIC values now consistently returns `"NI"` (non-interpretable) when the true MIC could be at either side of a breakpoint, depending on the selected handling mode
|
||||||
|
* This results in more reliable behaviour compared to previous versions for capped MIC values
|
||||||
|
* Removed the `"inverse"` option, which has now become redundant
|
||||||
|
* `ab_group()` now returns values consist with the AMR selectors (#246)
|
||||||
|
|
||||||
### Updated
|
|
||||||
* `top_n_microorganisms()`: new `property_for_each` argument for sub-grouping within top *n* groups; rank ordering enforced (only lower taxonomic ranks allowed); fixed `property = NULL` not being accepted; inner filter now tracks original row indices to prevent cross-group contamination
|
|
||||||
* Taxonomic update for all microorganisms, now updated to June 2026
|
|
||||||
* `mo_kingdom()` now returns the formal taxonomic kingdom; a one-time note per session explains the change when querying bacterial or archaeal records.
|
|
||||||
* `mo_taxonomy()` and `mo_info()` gained `domain` for the list output
|
|
||||||
* `antibiogram()` and `wisca()` now also support parallel computing via the argument `parallel = TRUE` (#281)
|
|
||||||
* `custom_eucast_rules()` renamed to `custom_interpretive_rules()`; old name deprecated but still works (#268)
|
|
||||||
* `mdro()` can now infer resistance from a drug+inhibitor combination when the base drug column is absent (e.g. piperacillin inferred from piperacillin/tazobactam); controlled via new `infer_from_combinations` argument (default `TRUE`) (#209)
|
|
||||||
* `wisca()` now more strictly follows Bielicki et al. (2016) by using $\text{Beta}(1, 9999)$ for intrinsically resistant pairs, forcing near-zero susceptibility regardless of observed data (based on EUCAST Expected Resistant Phenotypes)
|
|
||||||
* `susceptibility()` / `resistance()`: new `guideline` argument (default EUCAST) to ensure the 'I' category is interpreted correctly per guideline
|
|
||||||
* Capped MIC handling in `as.sir()` reworked into four clearly defined options: `"none"`, `"conservative"` (new default), `"standard"`, `"lenient"` (#243)
|
|
||||||
* `as.mic()` / `rescale_mic()`: new `round_to_next_log2` argument to round values up to the nearest log2 dilution level (#255)
|
|
||||||
* `antimicrobials$group` is now a `list`, so that drugs belonging to multiple groups are fully represented; use `ab_group(all_groups = TRUE)` to retrieve all groups for a drug (#246)
|
|
||||||
* Improved console messages with clickable links throughout, powered by `cli` if it is installed (#191, #265)
|
|
||||||
* `as.disk()`: input validation is now more strict, rejecting values that are not recognisable as a numeric disk zone diameter
|
|
||||||
* `as.sir()` gains an `enforce_method` argument (`"auto"`, `"mic"`, or `"disk"`) to force the interpretation method when S3 class information is lost, e.g. when called from Python (#291)
|
|
||||||
* `AMR for Python` vignette: added sections on installation channels (stable CRAN vs. development GitHub via `AMR.beta`) and on using `enforce_method` in `as_sir()` from Python
|
|
||||||
|
|
||||||
# AMR 3.0.1
|
# AMR 3.0.1
|
||||||
|
|
||||||
|
|||||||
@@ -36,7 +36,7 @@
|
|||||||
#'
|
#'
|
||||||
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
|
||||||
#'
|
#'
|
||||||
#' After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated `r format(AMR:::TAXONOMY_VERSION$GBIF$accessed_date, "%B %Y")`) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
#' After installing this package, R knows [**`r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species**](https://amr-for-r.org/reference/microorganisms.html) (updated June 2024) and all [**`r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial and antiviral drugs**](https://amr-for-r.org/reference/antimicrobials.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral clinical breakpoint guidelines from CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))` and EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))` are included, even with epidemiological cut-off (ECOFF) values. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
||||||
#'
|
#'
|
||||||
#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
|
||||||
#' @section Download Our Reference Data:
|
#' @section Download Our Reference Data:
|
||||||
@@ -45,7 +45,7 @@
|
|||||||
#' For maximum compatibility, we also provide machine-readable, tab-separated plain text files suitable for use in any software, including laboratory information systems.
|
#' For maximum compatibility, we also provide machine-readable, tab-separated plain text files suitable for use in any software, including laboratory information systems.
|
||||||
#'
|
#'
|
||||||
#' Visit [our website for direct download links](https://amr-for-r.org/articles/datasets.html), or explore the actual files in [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw/datasets).
|
#' Visit [our website for direct download links](https://amr-for-r.org/articles/datasets.html), or explore the actual files in [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw/datasets).
|
||||||
#' @references
|
#' @source
|
||||||
#' To cite AMR in publications use:
|
#' To cite AMR in publications use:
|
||||||
#'
|
#'
|
||||||
#' Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2022). "AMR: An R Package for Working with Antimicrobial Resistance Data." _Journal of Statistical Software_, *104*(3), 1-31. \doi{10.18637/jss.v104.i03}
|
#' Berends MS, Luz CF, Friedrich AW, Sinha BNM, Albers CJ, Glasner C (2022). "AMR: An R Package for Working with Antimicrobial Resistance Data." _Journal of Statistical Software_, *104*(3), 1-31. \doi{10.18637/jss.v104.i03}
|
||||||
|
|||||||
@@ -27,7 +27,7 @@
|
|||||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||||
# ==================================================================== #
|
# ==================================================================== #
|
||||||
|
|
||||||
# add new version numbers here, and add the rules themselves to "data-raw/interpretive_rules.tsv" and clinical_breakpoints
|
# add new version numbers here, and add the rules themselves to "data-raw/eucast_rules.tsv" and clinical_breakpoints
|
||||||
# (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
|
# (sourcing "data-raw/_pre_commit_checks.R" will process the TSV file)
|
||||||
EUCAST_VERSION_BREAKPOINTS <- list(
|
EUCAST_VERSION_BREAKPOINTS <- list(
|
||||||
"16.0" = list(
|
"16.0" = list(
|
||||||
@@ -104,27 +104,26 @@ EUCAST_VERSION_EXPECTED_PHENOTYPES <- list(
|
|||||||
|
|
||||||
TAXONOMY_VERSION <- list(
|
TAXONOMY_VERSION <- list(
|
||||||
GBIF = list(
|
GBIF = list(
|
||||||
name = "Global Biodiversity Information Facility (GBIF), via Catalogue of Life (COL)",
|
name = "Global Biodiversity Information Facility (GBIF)",
|
||||||
accessed_date = as.Date("2026-05-07"),
|
accessed_date = as.Date("2024-06-24"),
|
||||||
# take the citation from https://www.gbif.org/dataset/7ddf754f-d193-4cc9-b351-99906754a03b#citation
|
citation = "GBIF Secretariat (2023). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
|
||||||
citation = "Banki, O. *et al.* (2026). Catalogue of Life (2026-04-18 XR). Catalogue of Life Foundation, Amsterdam, Netherlands. \\doi{10.48580/dgxjw}.",
|
|
||||||
url = "https://www.gbif.org"
|
url = "https://www.gbif.org"
|
||||||
),
|
),
|
||||||
LPSN = list(
|
LPSN = list(
|
||||||
name = "List of Prokaryotic names with Standing in Nomenclature (LPSN)",
|
name = "List of Prokaryotic names with Standing in Nomenclature (LPSN)",
|
||||||
accessed_date = as.Date("2026-05-07"),
|
accessed_date = as.Date("2024-06-24"),
|
||||||
citation = "Freese, HM *et al.* (2026). **TYGS and LPSN in 2025: a Global Core Biodata Resource for genome-based classification and nomenclature of prokaryotes within DSMZ Digital Diversity.** Nucleic Acids Research, 54, D884\u2013D891; \\doi{10.1093/nar/gkaf1110}.",
|
citation = "Parte, AC *et al.* (2020). **List of Prokaryotic names with Standing in Nomenclature (LPSN) moves to the DSMZ.** International Journal of Systematic and Evolutionary Microbiology, 70, 5607-5612; \\doi{10.1099/ijsem.0.004332}.",
|
||||||
url = "https://lpsn.dsmz.de"
|
url = "https://lpsn.dsmz.de"
|
||||||
),
|
),
|
||||||
MycoBank = list(
|
MycoBank = list(
|
||||||
name = "MycoBank",
|
name = "MycoBank",
|
||||||
accessed_date = as.Date("2026-05-07"),
|
accessed_date = as.Date("2024-06-24"),
|
||||||
citation = "Vincent, R *et al* (2013). **MycoBank gearing up for new horizons.** IMA Fungus, 4(2), 371-9; \\doi{10.5598/imafungus.2013.04.02.16}.",
|
citation = "Vincent, R *et al* (2013). **MycoBank gearing up for new horizons.** IMA Fungus, 4(2), 371-9; \\doi{10.5598/imafungus.2013.04.02.16}.",
|
||||||
url = "https://www.mycobank.org"
|
url = "https://www.mycobank.org"
|
||||||
),
|
),
|
||||||
BacDive = list(
|
BacDive = list(
|
||||||
name = "BacDive",
|
name = "BacDive",
|
||||||
accessed_date = as.Date("2026-05-07"),
|
accessed_date = as.Date("2024-07-16"),
|
||||||
citation = "Reimer, LC *et al.* (2022). ***BacDive* in 2022: the knowledge base for standardized bacterial and archaeal data.** Nucleic Acids Res., 50(D1):D741-D74; \\doi{10.1093/nar/gkab961}.",
|
citation = "Reimer, LC *et al.* (2022). ***BacDive* in 2022: the knowledge base for standardized bacterial and archaeal data.** Nucleic Acids Res., 50(D1):D741-D74; \\doi{10.1093/nar/gkab961}.",
|
||||||
url = "https://bacdive.dsmz.de"
|
url = "https://bacdive.dsmz.de"
|
||||||
),
|
),
|
||||||
@@ -149,13 +148,10 @@ TAXONOMY_VERSION <- list(
|
|||||||
)
|
)
|
||||||
|
|
||||||
globalVariables(c(
|
globalVariables(c(
|
||||||
".coverage",
|
|
||||||
".GenericCallEnv",
|
".GenericCallEnv",
|
||||||
".lower",
|
|
||||||
".mo",
|
".mo",
|
||||||
".rowid",
|
".rowid",
|
||||||
".syndromic_group",
|
".syndromic_group",
|
||||||
".upper",
|
|
||||||
"ab",
|
"ab",
|
||||||
"ab_txt",
|
"ab_txt",
|
||||||
"affect_ab_name",
|
"affect_ab_name",
|
||||||
@@ -191,7 +187,6 @@ globalVariables(c(
|
|||||||
"hjust",
|
"hjust",
|
||||||
"host_index",
|
"host_index",
|
||||||
"host_match",
|
"host_match",
|
||||||
"incidence",
|
|
||||||
"input",
|
"input",
|
||||||
"input_given",
|
"input_given",
|
||||||
"intrinsic_resistant",
|
"intrinsic_resistant",
|
||||||
@@ -219,7 +214,6 @@ globalVariables(c(
|
|||||||
"old",
|
"old",
|
||||||
"old_name",
|
"old_name",
|
||||||
"p_susceptible",
|
"p_susceptible",
|
||||||
"pathogen",
|
|
||||||
"pattern",
|
"pattern",
|
||||||
"R",
|
"R",
|
||||||
"rank_index",
|
"rank_index",
|
||||||
@@ -227,8 +221,6 @@ globalVariables(c(
|
|||||||
"reference.rule",
|
"reference.rule",
|
||||||
"reference.rule_group",
|
"reference.rule_group",
|
||||||
"reference.version",
|
"reference.version",
|
||||||
"regimen",
|
|
||||||
"rule.provider",
|
|
||||||
"rowid",
|
"rowid",
|
||||||
"rule_group",
|
"rule_group",
|
||||||
"rule_name",
|
"rule_name",
|
||||||
|
|||||||
75
R/aa_helper_functions.R
Executable file → Normal file
75
R/aa_helper_functions.R
Executable file → Normal file
@@ -489,11 +489,7 @@ cli_to_plain <- function(msg, envir = parent.frame()) {
|
|||||||
if (length(m) >= 2L) m[2L] else paste0("?", resolve(c))
|
if (length(m) >= 2L) m[2L] else paste0("?", resolve(c))
|
||||||
})
|
})
|
||||||
msg <- apply_sub(msg, "\\{\\.url (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
msg <- apply_sub(msg, "\\{\\.url (\\{[^}]+\\}|[^}]+)\\}", function(c) resolve(c))
|
||||||
msg <- apply_sub(msg, "\\{\\.href ([^}]+)\\}", function(c) {
|
msg <- apply_sub(msg, "\\{\\.href ([^}]+)\\}", function(c) strsplit(resolve(c), " ", fixed = TRUE)[[1L]][1L])
|
||||||
# Handle [display text](url) markdown link format: extract just the URL
|
|
||||||
m <- regmatches(c, regexec("^\\[.*\\]\\(([^)]+)\\)$", c))[[1L]]
|
|
||||||
if (length(m) >= 2L) m[2L] else resolve(c)
|
|
||||||
})
|
|
||||||
|
|
||||||
# bare {variable} or {expression} -> evaluate in caller's environment
|
# bare {variable} or {expression} -> evaluate in caller's environment
|
||||||
while (grepl("\\{[^{}]+\\}", msg)) {
|
while (grepl("\\{[^{}]+\\}", msg)) {
|
||||||
@@ -555,7 +551,7 @@ word_wrap <- function(...,
|
|||||||
indentation <- 0L + extra_indent
|
indentation <- 0L + extra_indent
|
||||||
}
|
}
|
||||||
if (indentation > 0L) {
|
if (indentation > 0L) {
|
||||||
wrapped <- gsub("\n", paste0("\n", strrep("\u00a0", indentation)), wrapped, fixed = TRUE)
|
wrapped <- gsub("\n", paste0("\n", strrep(" ", indentation)), wrapped, fixed = TRUE)
|
||||||
}
|
}
|
||||||
gsub("(\n| )+$", "", wrapped)
|
gsub("(\n| )+$", "", wrapped)
|
||||||
}
|
}
|
||||||
@@ -587,27 +583,13 @@ simplify_help_markup <- function(msg) {
|
|||||||
|
|
||||||
message_ <- function(...,
|
message_ <- function(...,
|
||||||
appendLF = TRUE,
|
appendLF = TRUE,
|
||||||
as_note = TRUE,
|
as_note = TRUE) {
|
||||||
as_check = FALSE,
|
|
||||||
extra_indent = 0,
|
|
||||||
with_bullet = FALSE) {
|
|
||||||
msg <- paste0(c(...), collapse = "")
|
|
||||||
if (with_bullet == TRUE) {
|
|
||||||
as_note <- FALSE
|
|
||||||
msg <- paste0(AMR_env$bullet_icon, "\u00a0", msg)
|
|
||||||
}
|
|
||||||
if (extra_indent > 0) {
|
|
||||||
msg <- paste0(strrep("\u00a0", extra_indent), msg)
|
|
||||||
}
|
|
||||||
if (has_cli_rlang()) {
|
if (has_cli_rlang()) {
|
||||||
# prevent errors with single opening curly brackets, we don't evaluate cli's/glue's {} in AMR anyway
|
msg <- paste0(c(...), collapse = "")
|
||||||
msg <- gsub("\\{(?!\\.)", "", msg, perl = TRUE)
|
|
||||||
if (!cli::ansi_has_hyperlink_support()) {
|
if (!cli::ansi_has_hyperlink_support()) {
|
||||||
msg <- simplify_help_markup(msg)
|
msg <- simplify_help_markup(msg)
|
||||||
}
|
}
|
||||||
if (isTRUE(as_check)) {
|
if (isTRUE(as_note)) {
|
||||||
cli::cli_inform(c("v" = msg), .envir = parent.frame())
|
|
||||||
} else if (isTRUE(as_note)) {
|
|
||||||
cli::cli_inform(c("i" = msg), .envir = parent.frame())
|
cli::cli_inform(c("i" = msg), .envir = parent.frame())
|
||||||
} else if (isTRUE(appendLF)) {
|
} else if (isTRUE(appendLF)) {
|
||||||
cli::cli_inform(msg, .envir = parent.frame())
|
cli::cli_inform(msg, .envir = parent.frame())
|
||||||
@@ -616,28 +598,22 @@ message_ <- function(...,
|
|||||||
cat(format_inline_(msg), file = stderr())
|
cat(format_inline_(msg), file = stderr())
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
plain_msg <- cli_to_plain(msg, envir = parent.frame())
|
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||||
message(word_wrap(plain_msg, as_note = as_note), appendLF = appendLF)
|
message(word_wrap(plain_msg, as_note = as_note), appendLF = appendLF)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
warning_ <- function(...,
|
warning_ <- function(...,
|
||||||
immediate = FALSE,
|
immediate = FALSE,
|
||||||
call = FALSE,
|
call = FALSE) {
|
||||||
extra_indent = 0) {
|
|
||||||
msg <- paste0(c(...), collapse = "")
|
|
||||||
if (extra_indent > 0) {
|
|
||||||
msg <- paste0(strrep("\u00a0", extra_indent), msg)
|
|
||||||
}
|
|
||||||
if (has_cli_rlang()) {
|
if (has_cli_rlang()) {
|
||||||
# prevent errors with single opening curly brackets, we don't evaluate cli's/glue's {} in AMR anyway
|
msg <- paste0(c(...), collapse = "")
|
||||||
msg <- gsub("\\{(?!\\.)", "", msg, perl = TRUE)
|
|
||||||
if (!cli::ansi_has_hyperlink_support()) {
|
if (!cli::ansi_has_hyperlink_support()) {
|
||||||
msg <- simplify_help_markup(msg)
|
msg <- simplify_help_markup(msg)
|
||||||
}
|
}
|
||||||
cli::cli_warn(msg, .envir = parent.frame())
|
cli::cli_warn(msg, .envir = parent.frame())
|
||||||
} else {
|
} else {
|
||||||
plain_msg <- cli_to_plain(msg, envir = parent.frame())
|
plain_msg <- cli_to_plain(paste0(c(...), collapse = ""), envir = parent.frame())
|
||||||
warning(trimws2(word_wrap(plain_msg, as_note = FALSE)), immediate. = immediate, call. = call)
|
warning(trimws2(word_wrap(plain_msg, as_note = FALSE)), immediate. = immediate, call. = call)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -645,15 +621,8 @@ warning_ <- function(...,
|
|||||||
# this alternative to the stop() function:
|
# this alternative to the stop() function:
|
||||||
# - adds the function name where the error was thrown (plain-text fallback)
|
# - adds the function name where the error was thrown (plain-text fallback)
|
||||||
# - wraps text to never break lines within words (plain-text fallback)
|
# - wraps text to never break lines within words (plain-text fallback)
|
||||||
stop_ <- function(...,
|
stop_ <- function(..., call = TRUE) {
|
||||||
call = TRUE,
|
|
||||||
extra_indent = 0) {
|
|
||||||
msg <- paste0(c(...), collapse = "")
|
msg <- paste0(c(...), collapse = "")
|
||||||
if (extra_indent > 0) {
|
|
||||||
msg <- paste0(strrep("\u00a0", extra_indent), msg)
|
|
||||||
}
|
|
||||||
# prevent errors with single opening curly brackets, we don't evaluate cli's/glue's {} in AMR anyway
|
|
||||||
msg <- gsub("\\{(?!\\.)", "", msg, perl = TRUE)
|
|
||||||
if (!cli::ansi_has_hyperlink_support()) {
|
if (!cli::ansi_has_hyperlink_support()) {
|
||||||
msg <- simplify_help_markup(msg)
|
msg <- simplify_help_markup(msg)
|
||||||
}
|
}
|
||||||
@@ -708,7 +677,7 @@ stop_ifnot <- function(expr, ..., call = TRUE) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
"%or_if_na%" <- function(x, y) {
|
"%or%" <- function(x, y) {
|
||||||
if (is.null(x) || is.null(y)) {
|
if (is.null(x) || is.null(y)) {
|
||||||
if (is.null(x)) {
|
if (is.null(x)) {
|
||||||
return(y)
|
return(y)
|
||||||
@@ -758,7 +727,7 @@ documentation_date <- function(d) {
|
|||||||
suffix[day %in% c(1, 21, 31)] <- "st"
|
suffix[day %in% c(1, 21, 31)] <- "st"
|
||||||
suffix[day %in% c(2, 22)] <- "nd"
|
suffix[day %in% c(2, 22)] <- "nd"
|
||||||
suffix[day %in% c(3, 23)] <- "rd"
|
suffix[day %in% c(3, 23)] <- "rd"
|
||||||
paste0(day, suffix, " of ", month.name[as.integer(format(d, "%m"))], ", ", format(d, "%Y"))
|
paste0(month.name[as.integer(format(d, "%m"))], " ", day, suffix, ", ", format(d, "%Y"))
|
||||||
}
|
}
|
||||||
|
|
||||||
format_included_data_number <- function(data) {
|
format_included_data_number <- function(data) {
|
||||||
@@ -1666,14 +1635,14 @@ add_MO_lookup_to_AMR_env <- function() {
|
|||||||
if (is.null(AMR_env$MO_lookup)) {
|
if (is.null(AMR_env$MO_lookup)) {
|
||||||
MO_lookup <- AMR::microorganisms
|
MO_lookup <- AMR::microorganisms
|
||||||
|
|
||||||
MO_lookup$domain_index <- NA_real_
|
MO_lookup$kingdom_index <- NA_real_
|
||||||
MO_lookup[which(MO_lookup$domain == "Bacteria" | as.character(MO_lookup$mo) == "UNKNOWN"), "domain_index"] <- 1
|
MO_lookup[which(MO_lookup$kingdom == "Bacteria" | as.character(MO_lookup$mo) == "UNKNOWN"), "kingdom_index"] <- 1
|
||||||
MO_lookup[which(MO_lookup$domain == "Fungi"), "domain_index"] <- 1.25
|
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 1.25
|
||||||
MO_lookup[which(MO_lookup$domain == "Protozoa"), "domain_index"] <- 1.5
|
MO_lookup[which(MO_lookup$kingdom == "Protozoa"), "kingdom_index"] <- 1.5
|
||||||
MO_lookup[which(MO_lookup$domain == "Chromista"), "domain_index"] <- 1.75
|
MO_lookup[which(MO_lookup$kingdom == "Chromista"), "kingdom_index"] <- 1.75
|
||||||
MO_lookup[which(MO_lookup$domain == "Archaea"), "domain_index"] <- 2
|
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 2
|
||||||
# all the rest
|
# all the rest
|
||||||
MO_lookup[which(is.na(MO_lookup$domain_index)), "domain_index"] <- 3
|
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 3
|
||||||
|
|
||||||
# the fullname lowercase, important for the internal algorithms in as.mo()
|
# the fullname lowercase, important for the internal algorithms in as.mo()
|
||||||
MO_lookup$fullname_lower <- tolower(trimws2(paste(
|
MO_lookup$fullname_lower <- tolower(trimws2(paste(
|
||||||
@@ -1846,10 +1815,4 @@ if (getRversion() < "4.0.0") {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (getRversion() < "4.4.0") {
|
|
||||||
`%||%` <- function(x, y) {
|
|
||||||
if (is.null(x)) y else x
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# nolint end
|
# nolint end
|
||||||
|
|||||||
2
R/ab.R
2
R/ab.R
@@ -54,7 +54,7 @@
|
|||||||
#' @section Source:
|
#' @section Source:
|
||||||
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
|
#' World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology: \url{https://atcddd.fhi.no/atc_ddd_index/}
|
||||||
#'
|
#'
|
||||||
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://health.ec.europa.eu/documents/community-register/html/index_en.htm}
|
#' European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: \url{https://health.ec.europa.eu/documents/community-register/html/reg_hum_atc.htm}
|
||||||
#' @aliases ab
|
#' @aliases ab
|
||||||
#' @return A [character] [vector] with additional class [`ab`]
|
#' @return A [character] [vector] with additional class [`ab`]
|
||||||
#' @seealso
|
#' @seealso
|
||||||
|
|||||||
0
R/amr_course.R
Executable file → Normal file
0
R/amr_course.R
Executable file → Normal file
@@ -202,7 +202,7 @@
|
|||||||
#' # data.table --------------------------------------------------------------
|
#' # data.table --------------------------------------------------------------
|
||||||
#'
|
#'
|
||||||
#' # data.table is supported as well, just use it in the same way as with
|
#' # data.table is supported as well, just use it in the same way as with
|
||||||
#' # base R, but add `with = FALSE` if using a single AMR selector.
|
#' # base R, but add `with = FALSE` if using a single AB selector.
|
||||||
#'
|
#'
|
||||||
#' if (require("data.table")) {
|
#' if (require("data.table")) {
|
||||||
#' dt <- as.data.table(example_isolates)
|
#' dt <- as.data.table(example_isolates)
|
||||||
@@ -215,7 +215,7 @@
|
|||||||
#' dt[, carbapenems(), with = FALSE]
|
#' dt[, carbapenems(), with = FALSE]
|
||||||
#' }
|
#' }
|
||||||
#'
|
#'
|
||||||
#' # for multiple selections or AMR selectors, `with = FALSE` is not needed:
|
#' # for multiple selections or AB selectors, `with = FALSE` is not needed:
|
||||||
#' if (require("data.table")) {
|
#' if (require("data.table")) {
|
||||||
#' dt[, c("mo", aminoglycosides())]
|
#' dt[, c("mo", aminoglycosides())]
|
||||||
#' }
|
#' }
|
||||||
|
|||||||
1107
R/antibiogram.R
1107
R/antibiogram.R
File diff suppressed because it is too large
Load Diff
10
R/count.R
10
R/count.R
@@ -126,11 +126,6 @@ count_resistant <- function(...,
|
|||||||
only_all_tested = FALSE,
|
only_all_tested = FALSE,
|
||||||
guideline = getOption("AMR_guideline", "EUCAST")) {
|
guideline = getOption("AMR_guideline", "EUCAST")) {
|
||||||
# other arguments for meet_criteria are handled by sir_calc()
|
# other arguments for meet_criteria are handled by sir_calc()
|
||||||
if (guideline %like% "EUCAST") {
|
|
||||||
guideline <- "EUCAST"
|
|
||||||
} else if (guideline %like% "CLSI") {
|
|
||||||
guideline <- "CLSI"
|
|
||||||
}
|
|
||||||
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
||||||
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("count_resistant", "eucast_default", entire_session = TRUE)) {
|
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("count_resistant", "eucast_default", entire_session = TRUE)) {
|
||||||
message_("{.help [{.fun count_resistant}](AMR::count_resistant)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
message_("{.help [{.fun count_resistant}](AMR::count_resistant)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
||||||
@@ -155,11 +150,6 @@ count_susceptible <- function(...,
|
|||||||
only_all_tested = FALSE,
|
only_all_tested = FALSE,
|
||||||
guideline = getOption("AMR_guideline", "EUCAST")) {
|
guideline = getOption("AMR_guideline", "EUCAST")) {
|
||||||
# other arguments for meet_criteria are handled by sir_calc()
|
# other arguments for meet_criteria are handled by sir_calc()
|
||||||
if (guideline %like% "EUCAST") {
|
|
||||||
guideline <- "EUCAST"
|
|
||||||
} else if (guideline %like% "CLSI") {
|
|
||||||
guideline <- "CLSI"
|
|
||||||
}
|
|
||||||
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
||||||
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("count_susceptible", "eucast_default", entire_session = TRUE)) {
|
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("count_susceptible", "eucast_default", entire_session = TRUE)) {
|
||||||
message_("{.help [{.fun count_susceptible}](AMR::count_susceptible)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
message_("{.help [{.fun count_susceptible}](AMR::count_susceptible)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
||||||
|
|||||||
@@ -27,27 +27,27 @@
|
|||||||
# how to conduct AMR data analysis: https://amr-for-r.org #
|
# how to conduct AMR data analysis: https://amr-for-r.org #
|
||||||
# ==================================================================== #
|
# ==================================================================== #
|
||||||
|
|
||||||
#' Define Custom Interpretive Rules
|
#' Define Custom EUCAST Rules
|
||||||
#'
|
#'
|
||||||
#' Define custom interpretive rules for your organisation or specific analysis and use the output of this function in [interpretive_rules()].
|
#' Define custom EUCAST rules for your organisation or specific analysis and use the output of this function in [eucast_rules()].
|
||||||
#' @param ... Rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
|
#' @param ... Rules in [formula][base::tilde] notation, see below for instructions, and in *Examples*.
|
||||||
#' @details
|
#' @details
|
||||||
#' Some organisations have their own adoption of interpretive rules. This function can be used to define custom rules to be used in the [interpretive_rules()] function.
|
#' Some organisations have their own adoption of EUCAST rules. This function can be used to define custom EUCAST rules to be used in the [eucast_rules()] function.
|
||||||
#'
|
#'
|
||||||
#' ### Basics
|
#' ### Basics
|
||||||
#'
|
#'
|
||||||
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
#' If you are familiar with the [`case_when()`][dplyr::case_when()] function of the `dplyr` package, you will recognise the input method to set your own rules. Rules must be set using what \R considers to be the 'formula notation'. The rule itself is written *before* the tilde (`~`) and the consequence of the rule is written *after* the tilde:
|
||||||
#'
|
#'
|
||||||
#' ```r
|
#' ```r
|
||||||
#' x <- custom_interpretive_rules(TZP == "S" ~ aminopenicillins == "S",
|
#' x <- custom_eucast_rules(TZP == "S" ~ aminopenicillins == "S",
|
||||||
#' TZP == "R" ~ aminopenicillins == "R")
|
#' TZP == "R" ~ aminopenicillins == "R")
|
||||||
#' ```
|
#' ```
|
||||||
#'
|
#'
|
||||||
#' These are two custom interpretive rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
|
#' These are two custom EUCAST rules: if TZP (piperacillin/tazobactam) is "S", all aminopenicillins (ampicillin and amoxicillin) must be made "S", and if TZP is "R", aminopenicillins must be made "R". These rules can also be printed to the console, so it is immediately clear how they work:
|
||||||
#'
|
#'
|
||||||
#' ```r
|
#' ```r
|
||||||
#' x
|
#' x
|
||||||
#' #> A set of custom interpretive rules:
|
#' #> A set of custom EUCAST rules:
|
||||||
#' #>
|
#' #>
|
||||||
#' #> 1. If TZP is "S" then set to S :
|
#' #> 1. If TZP is "S" then set to S :
|
||||||
#' #> amoxicillin (AMX), ampicillin (AMP)
|
#' #> amoxicillin (AMX), ampicillin (AMP)
|
||||||
@@ -68,11 +68,11 @@
|
|||||||
#' #> 1 Escherichia coli R S S
|
#' #> 1 Escherichia coli R S S
|
||||||
#' #> 2 Klebsiella pneumoniae R S S
|
#' #> 2 Klebsiella pneumoniae R S S
|
||||||
#'
|
#'
|
||||||
#' interpretive_rules(df,
|
#' eucast_rules(df,
|
||||||
#' rules = "custom",
|
#' rules = "custom",
|
||||||
#' custom_rules = x,
|
#' custom_rules = x,
|
||||||
#' info = FALSE,
|
#' info = FALSE,
|
||||||
#' overwrite = TRUE)
|
#' overwrite = TRUE)
|
||||||
#' #> mo TZP ampi cipro
|
#' #> mo TZP ampi cipro
|
||||||
#' #> 1 Escherichia coli R R S
|
#' #> 1 Escherichia coli R R S
|
||||||
#' #> 2 Klebsiella pneumoniae R R S
|
#' #> 2 Klebsiella pneumoniae R R S
|
||||||
@@ -83,16 +83,16 @@
|
|||||||
#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
#' There is one exception in columns used for the rules: all column names of the [microorganisms] data set can also be used, but do not have to exist in the data set. These column names are: `r vector_and(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. Thus, this next example will work as well, despite the fact that the `df` data set does not contain a column `genus`:
|
||||||
#'
|
#'
|
||||||
#' ```r
|
#' ```r
|
||||||
#' y <- custom_interpretive_rules(
|
#' y <- custom_eucast_rules(
|
||||||
#' TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
#' TZP == "S" & genus == "Klebsiella" ~ aminopenicillins == "S",
|
||||||
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
|
#' TZP == "R" & genus == "Klebsiella" ~ aminopenicillins == "R"
|
||||||
#' )
|
#' )
|
||||||
#'
|
#'
|
||||||
#' interpretive_rules(df,
|
#' eucast_rules(df,
|
||||||
#' rules = "custom",
|
#' rules = "custom",
|
||||||
#' custom_rules = y,
|
#' custom_rules = y,
|
||||||
#' info = FALSE,
|
#' info = FALSE,
|
||||||
#' overwrite = TRUE)
|
#' overwrite = TRUE)
|
||||||
#' #> mo TZP ampi cipro
|
#' #> mo TZP ampi cipro
|
||||||
#' #> 1 Escherichia coli R S S
|
#' #> 1 Escherichia coli R S S
|
||||||
#' #> 2 Klebsiella pneumoniae R R S
|
#' #> 2 Klebsiella pneumoniae R R S
|
||||||
@@ -109,9 +109,9 @@
|
|||||||
#' Rules can also be applied to multiple antimicrobials and antimicrobial groups simultaneously. Use the `c()` function to combine multiple antimicrobials. For instance, the following example sets all aminopenicillins and ureidopenicillins to "R" if column TZP (piperacillin/tazobactam) is "R":
|
#' Rules can also be applied to multiple antimicrobials and antimicrobial groups simultaneously. Use the `c()` function to combine multiple antimicrobials. For instance, the following example sets all aminopenicillins and ureidopenicillins to "R" if column TZP (piperacillin/tazobactam) is "R":
|
||||||
#'
|
#'
|
||||||
#' ```r
|
#' ```r
|
||||||
#' x <- custom_interpretive_rules(TZP == "R" ~ c(aminopenicillins, ureidopenicillins) == "R")
|
#' x <- custom_eucast_rules(TZP == "R" ~ c(aminopenicillins, ureidopenicillins) == "R")
|
||||||
#' x
|
#' x
|
||||||
#' #> A set of custom interpretive rules:
|
#' #> A set of custom EUCAST rules:
|
||||||
#' #>
|
#' #>
|
||||||
#' #> 1. If TZP is "R" then set to "R":
|
#' #> 1. If TZP is "R" then set to "R":
|
||||||
#' #> amoxicillin (AMX), ampicillin (AMP), azlocillin (AZL), mezlocillin (MEZ), piperacillin (PIP), piperacillin/tazobactam (TZP)
|
#' #> amoxicillin (AMX), ampicillin (AMP), azlocillin (AZL), mezlocillin (MEZ), piperacillin (PIP), piperacillin/tazobactam (TZP)
|
||||||
@@ -123,7 +123,7 @@
|
|||||||
#' @returns A [list] containing the custom rules
|
#' @returns A [list] containing the custom rules
|
||||||
#' @export
|
#' @export
|
||||||
#' @examples
|
#' @examples
|
||||||
#' x <- custom_interpretive_rules(
|
#' x <- custom_eucast_rules(
|
||||||
#' AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
#' AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||||
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I"
|
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I"
|
||||||
#' )
|
#' )
|
||||||
@@ -141,24 +141,24 @@
|
|||||||
#' # combine rule sets
|
#' # combine rule sets
|
||||||
#' x2 <- c(
|
#' x2 <- c(
|
||||||
#' x,
|
#' x,
|
||||||
#' custom_interpretive_rules(TZP == "R" ~ carbapenems == "R")
|
#' custom_eucast_rules(TZP == "R" ~ carbapenems == "R")
|
||||||
#' )
|
#' )
|
||||||
#' x2
|
#' x2
|
||||||
custom_interpretive_rules <- function(...) {
|
custom_eucast_rules <- function(...) {
|
||||||
dots <- tryCatch(list(...),
|
dots <- tryCatch(list(...),
|
||||||
error = function(e) "error"
|
error = function(e) "error"
|
||||||
)
|
)
|
||||||
stop_if(
|
stop_if(
|
||||||
identical(dots, "error"),
|
identical(dots, "error"),
|
||||||
"rules must be a valid formula inputs (e.g., using '~'), see {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
|
"rules must be a valid formula inputs (e.g., using '~'), see {.help [{.fun custom_eucast_rules}](AMR::custom_eucast_rules)}"
|
||||||
)
|
)
|
||||||
n_dots <- length(dots)
|
n_dots <- length(dots)
|
||||||
stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}.")
|
stop_if(n_dots == 0, "no custom rules were set. Please read the documentation using {.help [{.fun custom_eucast_rules}](AMR::custom_eucast_rules)}.")
|
||||||
out <- vector("list", n_dots)
|
out <- vector("list", n_dots)
|
||||||
for (i in seq_len(n_dots)) {
|
for (i in seq_len(n_dots)) {
|
||||||
stop_ifnot(
|
stop_ifnot(
|
||||||
inherits(dots[[i]], "formula"),
|
inherits(dots[[i]], "formula"),
|
||||||
"rule ", i, " must be a valid formula input (e.g., using '~'), see {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
|
"rule ", i, " must be a valid formula input (e.g., using '~'), see {.help [{.fun custom_eucast_rules}](AMR::custom_eucast_rules)}"
|
||||||
)
|
)
|
||||||
|
|
||||||
# Query
|
# Query
|
||||||
@@ -180,7 +180,7 @@ custom_interpretive_rules <- function(...) {
|
|||||||
result <- dots[[i]][[3]]
|
result <- dots[[i]][[3]]
|
||||||
stop_ifnot(
|
stop_ifnot(
|
||||||
deparse(result) %like% "==",
|
deparse(result) %like% "==",
|
||||||
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see {.help [{.fun custom_interpretive_rules}](AMR::custom_interpretive_rules)}"
|
"the result of rule ", i, " (the part after the `~`) must contain `==`, such as in `... ~ ampicillin == \"R\"`, see {.help [{.fun custom_eucast_rules}](AMR::custom_eucast_rules)}"
|
||||||
)
|
)
|
||||||
result_group <- as.character(result)[[2]]
|
result_group <- as.character(result)[[2]]
|
||||||
result_group <- as.character(str2lang(result_group))
|
result_group <- as.character(str2lang(result_group))
|
||||||
@@ -230,13 +230,13 @@ custom_interpretive_rules <- function(...) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
names(out) <- paste0("rule", seq_len(n_dots))
|
names(out) <- paste0("rule", seq_len(n_dots))
|
||||||
set_clean_class(out, new_class = c("custom_interpretive_rules", "list"))
|
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @method c custom_interpretive_rules
|
#' @method c custom_eucast_rules
|
||||||
#' @noRd
|
#' @noRd
|
||||||
#' @export
|
#' @export
|
||||||
c.custom_interpretive_rules <- function(x, ...) {
|
c.custom_eucast_rules <- function(x, ...) {
|
||||||
if (length(list(...)) == 0) {
|
if (length(list(...)) == 0) {
|
||||||
return(x)
|
return(x)
|
||||||
}
|
}
|
||||||
@@ -245,21 +245,21 @@ c.custom_interpretive_rules <- function(x, ...) {
|
|||||||
out <- c(out, unclass(e))
|
out <- c(out, unclass(e))
|
||||||
}
|
}
|
||||||
names(out) <- paste0("rule", seq_len(length(out)))
|
names(out) <- paste0("rule", seq_len(length(out)))
|
||||||
set_clean_class(out, new_class = c("custom_interpretive_rules", "list"))
|
set_clean_class(out, new_class = c("custom_eucast_rules", "list"))
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @method as.list custom_interpretive_rules
|
#' @method as.list custom_eucast_rules
|
||||||
#' @noRd
|
#' @noRd
|
||||||
#' @export
|
#' @export
|
||||||
as.list.custom_interpretive_rules <- function(x, ...) {
|
as.list.custom_eucast_rules <- function(x, ...) {
|
||||||
c(x, ...)
|
c(x, ...)
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @method print custom_interpretive_rules
|
#' @method print custom_eucast_rules
|
||||||
#' @export
|
#' @export
|
||||||
#' @noRd
|
#' @noRd
|
||||||
print.custom_interpretive_rules <- function(x, ...) {
|
print.custom_eucast_rules <- function(x, ...) {
|
||||||
cat("A set of custom interpretive rules:\n")
|
cat("A set of custom EUCAST rules:\n")
|
||||||
for (i in seq_len(length(x))) {
|
for (i in seq_len(length(x))) {
|
||||||
rule <- x[[i]]
|
rule <- x[[i]]
|
||||||
rule$query <- format_custom_query_rule(rule$query)
|
rule$query <- format_custom_query_rule(rule$query)
|
||||||
@@ -291,19 +291,3 @@ print.custom_interpretive_rules <- function(x, ...) {
|
|||||||
cat("\n ", rule_if, "\n", rule_then, "\n", sep = "")
|
cat("\n ", rule_if, "\n", rule_then, "\n", sep = "")
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Backward-compat S3 dispatch for objects created with the old custom_eucast_rules() function
|
|
||||||
#' @method c custom_eucast_rules
|
|
||||||
#' @noRd
|
|
||||||
#' @export
|
|
||||||
c.custom_eucast_rules <- function(x, ...) c.custom_interpretive_rules(x, ...)
|
|
||||||
|
|
||||||
#' @method as.list custom_eucast_rules
|
|
||||||
#' @noRd
|
|
||||||
#' @export
|
|
||||||
as.list.custom_eucast_rules <- function(x, ...) as.list.custom_interpretive_rules(x, ...)
|
|
||||||
|
|
||||||
#' @method print custom_eucast_rules
|
|
||||||
#' @export
|
|
||||||
#' @noRd
|
|
||||||
print.custom_eucast_rules <- function(x, ...) print.custom_interpretive_rules(x, ...)
|
|
||||||
@@ -195,13 +195,11 @@ add_custom_microorganisms <- function(x) {
|
|||||||
if (!"fullname" %in% colnames(x)) {
|
if (!"fullname" %in% colnames(x)) {
|
||||||
x$fullname <- trimws2(paste(x$genus, x$species, x$subspecies))
|
x$fullname <- trimws2(paste(x$genus, x$species, x$subspecies))
|
||||||
}
|
}
|
||||||
if (!"domain" %in% colnames(x)) x$domain <- ""
|
|
||||||
if (!"kingdom" %in% colnames(x)) x$kingdom <- ""
|
if (!"kingdom" %in% colnames(x)) x$kingdom <- ""
|
||||||
if (!"phylum" %in% colnames(x)) x$phylum <- ""
|
if (!"phylum" %in% colnames(x)) x$phylum <- ""
|
||||||
if (!"class" %in% colnames(x)) x$class <- ""
|
if (!"class" %in% colnames(x)) x$class <- ""
|
||||||
if (!"order" %in% colnames(x)) x$order <- ""
|
if (!"order" %in% colnames(x)) x$order <- ""
|
||||||
if (!"family" %in% colnames(x)) x$family <- ""
|
if (!"family" %in% colnames(x)) x$family <- ""
|
||||||
x$domain[is.na(x$domain)] <- ""
|
|
||||||
x$kingdom[is.na(x$kingdom)] <- ""
|
x$kingdom[is.na(x$kingdom)] <- ""
|
||||||
x$phylum[is.na(x$phylum)] <- ""
|
x$phylum[is.na(x$phylum)] <- ""
|
||||||
x$class[is.na(x$class)] <- ""
|
x$class[is.na(x$class)] <- ""
|
||||||
@@ -219,7 +217,6 @@ add_custom_microorganisms <- function(x) {
|
|||||||
|
|
||||||
# fill in taxonomy based on genus
|
# fill in taxonomy based on genus
|
||||||
genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
|
genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
|
||||||
x$domain[which(x$domain == "" & genus_to_check != "")] <- AMR_env$MO_lookup$domain[match(genus_to_check[which(x$domain == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
|
||||||
x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||||
x$phylum[which(x$phylum == "" & genus_to_check != "")] <- AMR_env$MO_lookup$phylum[match(genus_to_check[which(x$phylum == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
x$phylum[which(x$phylum == "" & genus_to_check != "")] <- AMR_env$MO_lookup$phylum[match(genus_to_check[which(x$phylum == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||||
x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
|
||||||
@@ -232,9 +229,9 @@ add_custom_microorganisms <- function(x) {
|
|||||||
x$prevalence[is.na(x$prevalence)] <- 1.25
|
x$prevalence[is.na(x$prevalence)] <- 1.25
|
||||||
x$status <- "accepted"
|
x$status <- "accepted"
|
||||||
x$ref <- paste("Self-added,", format(Sys.Date(), "%Y"))
|
x$ref <- paste("Self-added,", format(Sys.Date(), "%Y"))
|
||||||
x$domain_index <- AMR_env$MO_lookup$domain_index[match(genus_to_check, AMR_env$MO_lookup$genus)]
|
x$kingdom_index <- AMR_env$MO_lookup$kingdom_index[match(genus_to_check, AMR_env$MO_lookup$genus)]
|
||||||
# complete missing domain index, so mo_matching_score() will not return NA
|
# complete missing kingdom index, so mo_matching_score() will not return NA
|
||||||
x$domain_index[is.na(x$domain_index)] <- 1
|
x$kingdom_index[is.na(x$kingdom_index)] <- 1
|
||||||
x$fullname_lower <- tolower(x$fullname)
|
x$fullname_lower <- tolower(x$fullname)
|
||||||
x$full_first <- substr(x$fullname_lower, 1, 1)
|
x$full_first <- substr(x$fullname_lower, 1, 1)
|
||||||
x$species_first <- tolower(substr(x$species, 1, 1))
|
x$species_first <- tolower(substr(x$species, 1, 1))
|
||||||
|
|||||||
27
R/data.R
27
R/data.R
@@ -77,13 +77,13 @@
|
|||||||
#'
|
#'
|
||||||
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and are consequently only available where a CID is available.
|
#' Synonyms (i.e. trade names) were derived from the PubChem Compound ID (column `cid`) and are consequently only available where a CID is available.
|
||||||
#' @inheritSection AMR Download Our Reference Data
|
#' @inheritSection AMR Download Our Reference Data
|
||||||
#' @references
|
#' @source
|
||||||
#'
|
#'
|
||||||
#' * `r TAXONOMY_VERSION$ATC_DDD$citation` Accessed from <`r TAXONOMY_VERSION$ATC_DDD$url`> on `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`.
|
#' * `r TAXONOMY_VERSION$ATC_DDD$citation` Accessed from <`r TAXONOMY_VERSION$ATC_DDD$url`> on `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`.
|
||||||
#'
|
#'
|
||||||
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
|
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
|
||||||
#'
|
#'
|
||||||
#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/index_en.htm>
|
#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
|
||||||
#' @inheritSection WHOCC WHOCC
|
#' @inheritSection WHOCC WHOCC
|
||||||
#' @seealso [microorganisms], [intrinsic_resistant]
|
#' @seealso [microorganisms], [intrinsic_resistant]
|
||||||
#' @examples
|
#' @examples
|
||||||
@@ -100,18 +100,17 @@
|
|||||||
#' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Taxonomic Records of Microorganisms
|
#' Data Set with `r format(nrow(microorganisms), big.mark = " ")` Taxonomic Records of Microorganisms
|
||||||
#'
|
#'
|
||||||
#' @description
|
#' @description
|
||||||
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$domain[!microorganisms$domain %like% "unknown"])))` domains. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
|
#' A data set containing the full microbial taxonomy (**last updated: `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date, TAXONOMY_VERSION$MycoBank$accessed_date))`**) of `r nr2char(length(unique(microorganisms$kingdom[!microorganisms$kingdom %like% "unknown"])))` kingdoms. This data set is the backbone of this `AMR` package. MO codes can be looked up using [as.mo()] and microorganism properties can be looked up using any of the [`mo_*`][mo_property()] functions.
|
||||||
#'
|
#'
|
||||||
#' This data set is carefully crafted, yet made 100% reproducible from public and authoritative taxonomic sources (using [this script](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R)), namely: *`r TAXONOMY_VERSION$LPSN$name`* for bacteria, *`r TAXONOMY_VERSION$MycoBank$name`* for fungi, and *`r TAXONOMY_VERSION$GBIF$name`* for all others taxons.
|
#' This data set is carefully crafted, yet made 100% reproducible from public and authoritative taxonomic sources (using [this script](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R)), namely: *`r TAXONOMY_VERSION$LPSN$name`* for bacteria, *`r TAXONOMY_VERSION$MycoBank$name`* for fungi, and *`r TAXONOMY_VERSION$GBIF$name`* for all others taxons.
|
||||||
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms), big.mark = " ")` observations and `r ncol(microorganisms)` variables:
|
#' @format A [tibble][tibble::tibble] with `r format(nrow(microorganisms), big.mark = " ")` observations and `r ncol(microorganisms)` variables:
|
||||||
#' - `mo`\cr ID of microorganism as used by this package. ***This is a unique identifier.***
|
#' - `mo`\cr ID of microorganism as used by this package. ***This is a unique identifier.***
|
||||||
#' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. ***This is a unique identifier.***
|
#' - `fullname`\cr Full name, like `"Escherichia coli"`. For the taxonomic ranks genus, species and subspecies, this is the 'pasted' text of genus, species, and subspecies. For all taxonomic ranks higher than genus, this is the name of the taxon. ***This is a unique identifier.***
|
||||||
#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status, documentation = TRUE)`
|
#' - `status` \cr Status of the taxon, either `r vector_or(microorganisms$status, documentation = TRUE)`
|
||||||
#' - `domain`, `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism. Note that for fungi, *phylum* is used for their taxonomic *division*. Also, for fungi, *subkingdom* and *subdivision* were left out since they do not occur in the bacterial taxonomy. For all species outside the domains of Bacteria and Archaea, the `domain` and `kingdom` are identical.
|
#' - `kingdom`, `phylum`, `class`, `order`, `family`, `genus`, `species`, `subspecies`\cr Taxonomic rank of the microorganism. Note that for fungi, *phylum* is equal to their taxonomic *division*. Also, for fungi, *subkingdom* and *subdivision* were left out since they do not occur in the bacterial taxonomy.
|
||||||
#' - `rank`\cr Text of the taxonomic rank of the microorganism, such as `"species"` or `"genus"`
|
#' - `rank`\cr Text of the taxonomic rank of the microorganism, such as `"species"` or `"genus"`
|
||||||
#' - `ref`\cr Abbreviated authority citation for the nomenclatural act that established the current name combination, following ICNP conventions. For species described in their current genus (*sp. nov.*), this is the original description author(s) and year. For species transferred to a different genus (*comb. nov.*), this is the reclassification author(s) and year. Emendations are excluded. For synonyms, this is the authority under which the synonym was originally published. This field is directly retrieved from the source specified in the column `source`. Diacritics were removed to comply with CRAN, that only allows ASCII characters.
|
#' - `ref`\cr Author(s) and year of related scientific publication. This contains only the *first surname* and year of the *latest* authors, e.g. "Wallis *et al.* 2006 *emend.* Smith and Jones 2018" becomes "Smith *et al.*, 2018". This field is directly retrieved from the source specified in the column `source`. Moreover, accents were removed to comply with CRAN that only allows ASCII characters.
|
||||||
#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance, documentation = TRUE)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
|
#' - `oxygen_tolerance` \cr Oxygen tolerance, either `r vector_or(microorganisms$oxygen_tolerance, documentation = TRUE)`. These data were retrieved from BacDive (see *Source*). Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus to guess the oxygen tolerance. Currently `r round(length(microorganisms$oxygen_tolerance[which(!is.na(microorganisms$oxygen_tolerance))]) / nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$kingdom == "Bacteria"), ]))` bacteria in the data set contain an oxygen tolerance.
|
||||||
#' - `morphology` \cr Morphology (cell shape), either `r vector_or(microorganisms$morphology, documentation = TRUE)`. These data were retrieved from BacDive (see *Source*). Genera that are clinically established as coccobacilli (the HACEK group and beyond, such as *Haemophilus* and *Acinetobacter*) are classified as such regardless of BacDive majority vote. Items that contain "likely" are missing from BacDive and were extrapolated from other species within the same genus. Currently `r round(length(microorganisms$morphology[which(!is.na(microorganisms$morphology))]) / nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]) * 100, 1)`% of all `r format_included_data_number(nrow(microorganisms[which(microorganisms$domain == "Bacteria"), ]))` bacteria in the data set contain a morphology.
|
|
||||||
#' - `source`\cr Either `r vector_or(microorganisms$source, documentation = TRUE)` (see *Source*)
|
#' - `source`\cr Either `r vector_or(microorganisms$source, documentation = TRUE)` (see *Source*)
|
||||||
#' - `lpsn`\cr Identifier ('Record number') of `r TAXONOMY_VERSION$LPSN$name`. This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$lpsn)))` records.
|
#' - `lpsn`\cr Identifier ('Record number') of `r TAXONOMY_VERSION$LPSN$name`. This will be the first/highest LPSN identifier to keep one identifier per row. For example, *Acetobacter ascendens* has LPSN Record number 7864 and 11011. Only the first is available in the `microorganisms` data set. ***This is a unique identifier***, though available for only `r format_included_data_number(sum(!is.na(microorganisms$lpsn)))` records.
|
||||||
#' - `lpsn_parent`\cr LPSN identifier of the parent taxon
|
#' - `lpsn_parent`\cr LPSN identifier of the parent taxon
|
||||||
@@ -131,26 +130,27 @@
|
|||||||
#'
|
#'
|
||||||
#' @section Included Taxa:
|
#' @section Included Taxa:
|
||||||
#' Included taxonomic data from [LPSN](`r TAXONOMY_VERSION$LPSN$url`), [MycoBank](`r TAXONOMY_VERSION$MycoBank$url`), and [GBIF](`r TAXONOMY_VERSION$GBIF$url`) are:
|
#' Included taxonomic data from [LPSN](`r TAXONOMY_VERSION$LPSN$url`), [MycoBank](`r TAXONOMY_VERSION$MycoBank$url`), and [GBIF](`r TAXONOMY_VERSION$GBIF$url`) are:
|
||||||
#' - All `r format_included_data_number(microorganisms[which(microorganisms$domain %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the domains of Archaea and Bacteria
|
#' - All `r format_included_data_number(microorganisms[which(microorganisms$kingdom %in% c("Archeae", "Bacteria")), , drop = FALSE])` (sub)species from the kingdoms of Archaea and Bacteria
|
||||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$domain == "Fungi"), , drop = FALSE])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
|
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Fungi"), , drop = FALSE])` species from the kingdom of Fungi. The kingdom of Fungi is a very large taxon with almost 300,000 different (sub)species, of which most are not microbial (but rather macroscopic, like mushrooms). Because of this, not all fungi fit the scope of this package. Only relevant fungi are covered (such as all species of *Aspergillus*, *Candida*, *Cryptococcus*, *Histoplasma*, *Pneumocystis*, *Saccharomyces* and *Trichophyton*).
|
||||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Protozoa"), , drop = FALSE])` (sub)species from the kingdom of Protozoa
|
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Protozoa"), , drop = FALSE])` (sub)species from the kingdom of Protozoa
|
||||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
|
#' - `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), , drop = FALSE])` (sub)species from `r format_included_data_number(microorganisms[which(microorganisms$kingdom == "Animalia"), "genus", drop = TRUE])` other relevant genera from the kingdom of Animalia (such as *Strongyloides* and *Taenia*)
|
||||||
#' - All `r format_included_data_number(microorganisms[which(microorganisms$status != "accepted"), , drop = FALSE])` previously accepted names of all included (sub)species (these were taxonomically renamed)
|
#' - All `r format_included_data_number(microorganisms[which(microorganisms$status != "accepted"), , drop = FALSE])` previously accepted names of all included (sub)species (these were taxonomically renamed)
|
||||||
#' - The complete taxonomic tree of all included (sub)species: from domain to subspecies
|
#' - The complete taxonomic tree of all included (sub)species: from kingdom to subspecies
|
||||||
#' - The identifier of the parent taxons
|
#' - The identifier of the parent taxons
|
||||||
#' - The year and first author of the related scientific publication
|
#' - The year and first author of the related scientific publication
|
||||||
#'
|
#'
|
||||||
#' ### Manual additions
|
#' ### Manual additions
|
||||||
#' For convenience, some entries were added manually:
|
#' For convenience, some entries were added manually:
|
||||||
#'
|
#'
|
||||||
#' - All `r format_included_data_number(length(which(microorganisms$rank == "species group")))` groups and complexes of the [microorganisms.groups] data set, for cross-reference (examples include beta-haemolytic *Streptococcus* groups A to K, coagulase-negative *Staphylococcus* (CoNS), *Mycobacterium tuberculosis* complex, etc.)
|
|
||||||
#' - `r format_included_data_number(microorganisms[which(microorganisms$source == "manually added" & microorganisms$genus == "Salmonella"), , drop = FALSE])` entries of *Salmonella*, such as the city-like serovars and groups A to H
|
#' - `r format_included_data_number(microorganisms[which(microorganisms$source == "manually added" & microorganisms$genus == "Salmonella"), , drop = FALSE])` entries of *Salmonella*, such as the city-like serovars and groups A to H
|
||||||
|
#' - `r format_included_data_number(length(which(microorganisms$rank == "species group")))` species groups (such as the beta-haemolytic *Streptococcus* groups A to K, coagulase-negative *Staphylococcus* (CoNS), *Mycobacterium tuberculosis* complex, etc.), of which the group compositions are stored in the [microorganisms.groups] data set
|
||||||
#' - 1 entry of *Blastocystis* (*B. hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
|
#' - 1 entry of *Blastocystis* (*B. hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
|
||||||
#' - `r sum(microorganisms$fullname %like% "unknown")` other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
|
#' - 1 entry of *Moraxella* (*M. catarrhalis*), which was formally named *Branhamella catarrhalis* (Catlin, 1970) though this change was never accepted within the field of clinical microbiology
|
||||||
|
#' - 8 other 'undefined' entries (unknown, unknown Gram-negatives, unknown Gram-positives, unknown yeast, unknown fungus, and unknown anaerobic Gram-pos/Gram-neg bacteria)
|
||||||
#'
|
#'
|
||||||
#' The syntax used to transform the original data to a cleansed \R format, can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R).
|
#' The syntax used to transform the original data to a cleansed \R format, can be [found here](https://github.com/msberends/AMR/blob/main/data-raw/_reproduction_scripts/reproduction_of_microorganisms.R).
|
||||||
#' @inheritSection AMR Download Our Reference Data
|
#' @inheritSection AMR Download Our Reference Data
|
||||||
#' @references
|
#' @source
|
||||||
#' Taxonomic entries were imported in this order of importance:
|
#' Taxonomic entries were imported in this order of importance:
|
||||||
#' 1. `r TAXONOMY_VERSION$LPSN$name`:\cr\cr
|
#' 1. `r TAXONOMY_VERSION$LPSN$name`:\cr\cr
|
||||||
#' `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
|
#' `r TAXONOMY_VERSION$LPSN$citation` Accessed from <`r TAXONOMY_VERSION$LPSN$url`> on `r documentation_date(TAXONOMY_VERSION$LPSN$accessed_date)`.
|
||||||
@@ -339,7 +339,6 @@
|
|||||||
#' This data set is internally used by:
|
#' This data set is internally used by:
|
||||||
#' * [not_intrinsic_resistant()] (an [antimicrobial selector][antimicrobial_selectors])
|
#' * [not_intrinsic_resistant()] (an [antimicrobial selector][antimicrobial_selectors])
|
||||||
#' * [mo_is_intrinsic_resistant()]
|
#' * [mo_is_intrinsic_resistant()]
|
||||||
#' * [wisca()] to model \eqn{\beta(1, 9999)} for resistant bug-drug combinations, per \doi{10.1093/jac/dkv397}
|
|
||||||
#' @inheritSection AMR Download Our Reference Data
|
#' @inheritSection AMR Download Our Reference Data
|
||||||
#' @examples
|
#' @examples
|
||||||
#' intrinsic_resistant
|
#' intrinsic_resistant
|
||||||
|
|||||||
45
R/disk.R
45
R/disk.R
@@ -83,31 +83,34 @@ as.disk <- function(x, na.rm = FALSE) {
|
|||||||
|
|
||||||
na_before <- length(x[is.na(x)])
|
na_before <- length(x[is.na(x)])
|
||||||
|
|
||||||
# extract a plausible numeric disk zone value from character input
|
# heavily based on cleaner::clean_double():
|
||||||
extract_disk_value <- function(x) {
|
clean_double2 <- function(x, remove = "[^0-9.,-]", fixed = FALSE) {
|
||||||
x <- as.character(x)
|
|
||||||
# normalise decimal separators
|
|
||||||
x <- gsub(",", ".", x, fixed = TRUE)
|
x <- gsub(",", ".", x, fixed = TRUE)
|
||||||
# strip known context: leading/trailing whitespace, SIR interpretations,
|
# remove ending dot/comma
|
||||||
# comparison operators, semicolons, and surrounding whitespace
|
x <- gsub("[,.]$", "", x)
|
||||||
x <- trimws(x)
|
# only keep last dot/comma
|
||||||
# remove trailing SIR interpretation (e.g., "42; S", "28 R")
|
reverse <- function(x) vapply(FUN.VALUE = character(1), lapply(strsplit(x, NULL), rev), paste, collapse = "")
|
||||||
x <- gsub("[;[:space:]]+[SIRsir]$", "", x)
|
x <- sub("{{dot}}", ".",
|
||||||
# remove leading comparison operators (e.g., ">=20", "<=6")
|
gsub(".", "",
|
||||||
x <- gsub("^[<>=]+\\s*", "", x)
|
reverse(sub(".", "}}tod{{",
|
||||||
x <- trimws(x)
|
reverse(x),
|
||||||
# now the remainder must be a plausible standalone number
|
fixed = TRUE
|
||||||
out <- rep(NA_real_, length(x))
|
)),
|
||||||
is_numeric <- grepl("^[0-9]+\\.?[0-9]*$", x)
|
fixed = TRUE
|
||||||
out[is_numeric] <- as.double(x[is_numeric])
|
),
|
||||||
out
|
fixed = TRUE
|
||||||
|
)
|
||||||
|
x_clean <- gsub(remove, "", x, ignore.case = TRUE, fixed = fixed)
|
||||||
|
# remove everything that is not a number or dot
|
||||||
|
as.double(gsub("[^0-9.]+", "", x_clean))
|
||||||
}
|
}
|
||||||
|
|
||||||
# round up and coerce to integer
|
# round up and make it an integer
|
||||||
x <- as.integer(ceiling(extract_disk_value(x)))
|
x <- as.integer(ceiling(clean_double2(x)))
|
||||||
# valid disk diffusion zones: 0-50 mm
|
|
||||||
x[x < 0 | x > 50] <- NA_integer_
|
|
||||||
|
|
||||||
|
# disks can never be less than 0 mm or more than 50 mm
|
||||||
|
x[x < 0 | x > 99] <- NA_integer_
|
||||||
|
x[x > 50] <- 50L
|
||||||
na_after <- length(x[is.na(x)])
|
na_after <- length(x[is.na(x)])
|
||||||
|
|
||||||
if (na_before != na_after) {
|
if (na_before != na_after) {
|
||||||
|
|||||||
2
R/first_isolate.R
Executable file → Normal file
2
R/first_isolate.R
Executable file → Normal file
@@ -134,7 +134,7 @@
|
|||||||
#' @seealso [key_antimicrobials()]
|
#' @seealso [key_antimicrobials()]
|
||||||
#' @export
|
#' @export
|
||||||
#' @return A [logical] vector
|
#' @return A [logical] vector
|
||||||
#' @references Methodology of these functions is strictly based on:
|
#' @source Methodology of these functions is strictly based on:
|
||||||
#'
|
#'
|
||||||
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
#' - **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||||
#'
|
#'
|
||||||
|
|||||||
0
R/get_episode.R
Executable file → Normal file
0
R/get_episode.R
Executable file → Normal file
@@ -62,17 +62,17 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
|||||||
#' @param x A data set with antimicrobials columns, such as `amox`, `AMX` and `AMC`.
|
#' @param x A data set with antimicrobials columns, such as `amox`, `AMX` and `AMC`.
|
||||||
#' @param info A [logical] to indicate whether progress should be printed to the console - the default is only print while in interactive sessions.
|
#' @param info A [logical] to indicate whether progress should be printed to the console - the default is only print while in interactive sessions.
|
||||||
#' @param guideline A guideline name, either "EUCAST" (default) or "CLSI". This can be set with the package option [`AMR_guideline`][AMR-options].
|
#' @param guideline A guideline name, either "EUCAST" (default) or "CLSI". This can be set with the package option [`AMR_guideline`][AMR-options].
|
||||||
#' @param rules A [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expected_phenotypes"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expected_phenotypes")`. The default value can be set to another value using the package option [`AMR_interpretive_rules`][AMR-options]: `options(AMR_interpretive_rules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_interpretive_rules()].
|
#' @param rules A [character] vector that specifies which rules should be applied. Must be one or more of `"breakpoints"`, `"expected_phenotypes"`, `"expert"`, `"other"`, `"custom"`, `"all"`, and defaults to `c("breakpoints", "expected_phenotypes")`. The default value can be set to another value using the package option [`AMR_interpretive_rules`][AMR-options]: `options(AMR_interpretive_rules = "all")`. If using `"custom"`, be sure to fill in argument `custom_rules` too. Custom rules can be created with [custom_eucast_rules()].
|
||||||
#' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
|
#' @param verbose A [logical] to turn Verbose mode on and off (default is off). In Verbose mode, the function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way. Using Verbose mode takes a lot more time.
|
||||||
#' @param version_breakpoints The version number to use for the EUCAST Clinical Breakpoints guideline. Can be `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), documentation = TRUE, reverse = TRUE)`.
|
#' @param version_breakpoints The version number to use for the EUCAST Clinical Breakpoints guideline. Can be `r vector_or(names(EUCAST_VERSION_BREAKPOINTS), documentation = TRUE, reverse = TRUE)`.
|
||||||
#' @param version_expected_phenotypes The version number to use for the EUCAST Expected Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_EXPECTED_PHENOTYPES), documentation = TRUE, reverse = TRUE)`.
|
#' @param version_expected_phenotypes The version number to use for the EUCAST Expected Phenotypes. Can be `r vector_or(names(EUCAST_VERSION_EXPECTED_PHENOTYPES), documentation = TRUE, reverse = TRUE)`.
|
||||||
#' @param version_expertrules The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), documentation = TRUE, reverse = TRUE)`.
|
#' @param version_expertrules The version number to use for the EUCAST Expert Rules and Intrinsic Resistance guideline. Can be `r vector_or(names(EUCAST_VERSION_EXPERT_RULES), documentation = TRUE, reverse = TRUE)`.
|
||||||
#' @param ampc_cephalosporin_resistance (only applies when `rules` contains `"expert"` or `"all"`) a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these versions of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(INTERPRETIVE_RULES_DF[which(INTERPRETIVE_RULES_DF$reference.version %in% c(3.2, 3.3) & INTERPRETIVE_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
#' @param ampc_cephalosporin_resistance (only applies when `rules` contains `"expert"` or `"all"`) a [character] value that should be applied to cefotaxime, ceftriaxone and ceftazidime for AmpC de-repressed cephalosporin-resistant mutants - the default is `NA`. Currently only works when `version_expertrules` is `3.2` and higher; these versions of '*EUCAST Expert Rules on Enterobacterales*' state that results of cefotaxime, ceftriaxone and ceftazidime should be reported with a note, or results should be suppressed (emptied) for these three drugs. A value of `NA` (the default) for this argument will remove results for these three drugs, while e.g. a value of `"R"` will make the results for these drugs resistant. Use `NULL` or `FALSE` to not alter results for these three drugs of AmpC de-repressed cephalosporin-resistant mutants. Using `TRUE` is equal to using `"R"`. \cr For *EUCAST Expert Rules* v3.2, this rule applies to: `r vector_and(gsub("[^a-zA-Z ]+", "", unlist(strsplit(EUCAST_RULES_DF[which(EUCAST_RULES_DF$reference.version %in% c(3.2, 3.3) & EUCAST_RULES_DF$reference.rule %like% "ampc"), "this_value"][1], "|", fixed = TRUE))), quotes = "*")`.
|
||||||
#' @param ... Column names of antimicrobials. To automatically detect antimicrobial column names, do not provide any named arguments; [guess_ab_col()] will then be used for detection. To manually specify a column, provide its name (case-insensitive) as an argument, e.g. `AMX = "amoxicillin"`. To skip a specific antimicrobial, set it to `NULL`, e.g. `TIC = NULL` to exclude ticarcillin. If a manually defined column does not exist in the data, it will be skipped with a warning.
|
#' @param ... Column names of antimicrobials. To automatically detect antimicrobial column names, do not provide any named arguments; [guess_ab_col()] will then be used for detection. To manually specify a column, provide its name (case-insensitive) as an argument, e.g. `AMX = "amoxicillin"`. To skip a specific antimicrobial, set it to `NULL`, e.g. `TIC = NULL` to exclude ticarcillin. If a manually defined column does not exist in the data, it will be skipped with a warning.
|
||||||
#' @param ab Any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()].
|
#' @param ab Any (vector of) text that can be coerced to a valid antimicrobial drug code with [as.ab()].
|
||||||
#' @param administration Route of administration, either `r vector_or(dosage$administration, documentation = TRUE)`.
|
#' @param administration Route of administration, either `r vector_or(dosage$administration, documentation = TRUE)`.
|
||||||
#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
|
#' @param only_sir_columns A [logical] to indicate whether only antimicrobial columns must be included that were transformed to class [sir][as.sir()] on beforehand. Defaults to `FALSE` if no columns of `x` have a class [sir][as.sir()].
|
||||||
#' @param custom_rules Custom rules to apply, created with [custom_interpretive_rules()].
|
#' @param custom_rules Custom rules to apply, created with [custom_eucast_rules()].
|
||||||
#' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".
|
#' @param overwrite A [logical] indicating whether to overwrite existing SIR values (default: `FALSE`). When `FALSE`, only non-SIR values are modified (i.e., any value that is not already S, I or R). To ensure compliance with EUCAST guidelines, **this should remain** `FALSE`, as EUCAST notes often state that an organism "should be tested for susceptibility to individual agents or be reported resistant".
|
||||||
#' @param add_if_missing A [logical] indicating whether rules should also be applied to missing (`NA`) values (default: `TRUE`). When `FALSE`, rules are only applied to cells that already contain an SIR value; cells with `NA` are left untouched. This is particularly useful when using `overwrite = TRUE` with custom rules and you want to update reported results without imputing values for untested drugs.
|
#' @param add_if_missing A [logical] indicating whether rules should also be applied to missing (`NA`) values (default: `TRUE`). When `FALSE`, rules are only applied to cells that already contain an SIR value; cells with `NA` are left untouched. This is particularly useful when using `overwrite = TRUE` with custom rules and you want to update reported results without imputing values for untested drugs.
|
||||||
#' @inheritParams first_isolate
|
#' @inheritParams first_isolate
|
||||||
@@ -80,17 +80,17 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
|||||||
#' **Note:** This function does not translate MIC or disk values to SIR values. Use [as.sir()] for that. \cr
|
#' **Note:** This function does not translate MIC or disk values to SIR values. Use [as.sir()] for that. \cr
|
||||||
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
||||||
#'
|
#'
|
||||||
#' The file containing all interpretive rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/interpretive_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The `AMR` package contains the full microbial taxonomy updated until `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`, see [microorganisms].
|
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/main/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The `AMR` package contains the full microbial taxonomy updated until `r documentation_date(max(TAXONOMY_VERSION$GBIF$accessed_date, TAXONOMY_VERSION$LPSN$accessed_date))`, see [microorganisms].
|
||||||
#'
|
#'
|
||||||
#' ### Custom Rules
|
#' ### Custom Rules
|
||||||
#'
|
#'
|
||||||
#' Custom rules can be created using [custom_interpretive_rules()], e.g.:
|
#' Custom rules can be created using [custom_eucast_rules()], e.g.:
|
||||||
#'
|
#'
|
||||||
#' ```r
|
#' ```r
|
||||||
#' x <- custom_interpretive_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||||
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
|
#' AMC == "I" & genus == "Klebsiella" ~ aminopenicillins == "I")
|
||||||
#'
|
#'
|
||||||
#' interpretive_rules(example_isolates, rules = "custom", custom_rules = x)
|
#' eucast_rules(example_isolates, rules = "custom", custom_rules = x)
|
||||||
#' ```
|
#' ```
|
||||||
#'
|
#'
|
||||||
#' ### 'Other' Rules
|
#' ### 'Other' Rules
|
||||||
@@ -102,16 +102,21 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
|||||||
#'
|
#'
|
||||||
#' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set.
|
#' Important examples include amoxicillin and amoxicillin/clavulanic acid, and trimethoprim and trimethoprim/sulfamethoxazole. Needless to say, for these rules to work, both drugs must be available in the data set.
|
||||||
#'
|
#'
|
||||||
#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `interpretive_rules(..., rules = "all")`. You can also set the package option [`AMR_interpretive_rules`][AMR-options], i.e. run `options(AMR_interpretive_rules = "all")`.
|
#' Since these rules are not officially approved by EUCAST, they are not applied at default. To use these rules, include `"other"` to the `rules` argument, or use `eucast_rules(..., rules = "all")`. You can also set the package option [`AMR_interpretive_rules`][AMR-options], i.e. run `options(AMR_interpretive_rules = "all")`.
|
||||||
#' @aliases EUCAST
|
#' @aliases EUCAST
|
||||||
#' @rdname interpretive_rules
|
#' @rdname interpretive_rules
|
||||||
#' @export
|
#' @export
|
||||||
#' @return The input of `x`, possibly with edited values of antimicrobials. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations.
|
#' @return The input of `x`, possibly with edited values of antimicrobials. Or, if `verbose = TRUE`, a [data.frame] with all original and new values of the affected bug-drug combinations.
|
||||||
#' @references
|
#' @source
|
||||||
#' - EUCAST Expert Rules. Version 2.0, 2012.\cr
|
#' - EUCAST Expert Rules. Version 2.0, 2012.\cr
|
||||||
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60; \doi{https://doi.org/10.1111/j.1469-0691.2011.03703.x}
|
#' Leclercq et al. **EUCAST expert rules in antimicrobial susceptibility testing.** *Clin Microbiol Infect.* 2013;19(2):141-60; \doi{https://doi.org/10.1111/j.1469-0691.2011.03703.x}
|
||||||
#' - EUCAST Expected Phenotypes. [(link)](https://www.eucast.org/bacteria/important-additional-information/expected-phenotypes/)
|
#' - EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes Tables. Version 3.1, 2016. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf)
|
||||||
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. [(link)](https://www.eucast.org/bacteria/clinical-breakpoints-and-interpretation/clinical-breakpoint-tables/)
|
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.2, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2020/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.2_20200225.pdf)
|
||||||
|
#' - EUCAST Intrinsic Resistance and Unusual Phenotypes. Version 3.3, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/2021/Intrinsic_Resistance_and_Unusual_Phenotypes_Tables_v3.3_20211018.pdf)
|
||||||
|
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 9.0, 2019. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_9.0_Breakpoint_Tables.xlsx)
|
||||||
|
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 10.0, 2020. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_10.0_Breakpoint_Tables.xlsx)
|
||||||
|
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 11.0, 2021. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_11.0_Breakpoint_Tables.xlsx)
|
||||||
|
#' - EUCAST Breakpoint tables for interpretation of MICs and zone diameters. Version 12.0, 2022. [(link)](https://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Breakpoint_tables/v_12.0_Breakpoint_Tables.xlsx)
|
||||||
#' @inheritSection AMR Download Our Reference Data
|
#' @inheritSection AMR Download Our Reference Data
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
@@ -170,11 +175,6 @@ interpretive_rules <- function(x,
|
|||||||
...) {
|
...) {
|
||||||
meet_criteria(x, allow_class = "data.frame")
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
meet_criteria(col_mo, allow_class = "character", has_length = 1, is_in = colnames(x), allow_NULL = TRUE)
|
||||||
if (guideline %like% "EUCAST") {
|
|
||||||
guideline <- "EUCAST"
|
|
||||||
} else if (guideline %like% "CLSI") {
|
|
||||||
guideline <- "CLSI"
|
|
||||||
}
|
|
||||||
meet_criteria(guideline, allow_class = "character", has_length = 1, is_in = c("EUCAST", "CLSI"))
|
meet_criteria(guideline, allow_class = "character", has_length = 1, is_in = c("EUCAST", "CLSI"))
|
||||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||||
meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4, 5, 6), is_in = c("breakpoints", "expected_phenotypes", "expert", "other", "all", "custom"))
|
meet_criteria(rules, allow_class = "character", has_length = c(1, 2, 3, 4, 5, 6), is_in = c("breakpoints", "expected_phenotypes", "expert", "other", "all", "custom"))
|
||||||
@@ -184,7 +184,7 @@ interpretive_rules <- function(x,
|
|||||||
meet_criteria(version_expertrules, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_EXPERT_RULES)))
|
meet_criteria(version_expertrules, allow_class = c("numeric", "integer"), has_length = 1, is_in = as.double(names(EUCAST_VERSION_EXPERT_RULES)))
|
||||||
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
|
meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
|
||||||
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||||
meet_criteria(custom_rules, allow_class = c("custom_interpretive_rules", "custom_eucast_rules"), allow_NULL = TRUE)
|
meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
|
||||||
meet_criteria(overwrite, allow_class = "logical", has_length = 1)
|
meet_criteria(overwrite, allow_class = "logical", has_length = 1)
|
||||||
meet_criteria(add_if_missing, allow_class = "logical", has_length = 1)
|
meet_criteria(add_if_missing, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
@@ -193,6 +193,11 @@ interpretive_rules <- function(x,
|
|||||||
"Either set {.arg overwrite} or {.arg add_if_missing} to {.code TRUE}, or both."
|
"Either set {.arg overwrite} or {.arg add_if_missing} to {.code TRUE}, or both."
|
||||||
)
|
)
|
||||||
|
|
||||||
|
stop_if(
|
||||||
|
guideline == "CLSI",
|
||||||
|
"CLSI guideline is not yet supported."
|
||||||
|
)
|
||||||
|
|
||||||
stop_if(
|
stop_if(
|
||||||
!is.na(ampc_cephalosporin_resistance) && !any(c("expert", "all") %in% rules),
|
!is.na(ampc_cephalosporin_resistance) && !any(c("expert", "all") %in% rules),
|
||||||
"For the {.arg ampc_cephalosporin_resistance} argument to work, the {.arg rules} argument must contain {.code \"expert\"} or {.code \"all\"}."
|
"For the {.arg ampc_cephalosporin_resistance} argument to work, the {.arg rules} argument must contain {.code \"expert\"} or {.code \"all\"}."
|
||||||
@@ -201,7 +206,7 @@ interpretive_rules <- function(x,
|
|||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
if ("custom" %in% rules && is.null(custom_rules)) {
|
if ("custom" %in% rules && is.null(custom_rules)) {
|
||||||
warning_("in {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}: no custom rules were set with the {.arg custom_rules} argument",
|
warning_("in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: no custom rules were set with the {.arg custom_rules} argument",
|
||||||
immediate = TRUE
|
immediate = TRUE
|
||||||
)
|
)
|
||||||
rules <- rules[rules != "custom"]
|
rules <- rules[rules != "custom"]
|
||||||
@@ -224,13 +229,13 @@ interpretive_rules <- function(x,
|
|||||||
|
|
||||||
if (interactive() && isTRUE(verbose) && isTRUE(info)) {
|
if (interactive() && isTRUE(verbose) && isTRUE(info)) {
|
||||||
txt <- paste0(
|
txt <- paste0(
|
||||||
"WARNING: In Verbose mode, the interpretive_rules() function does not apply rules to the data, but instead returns a data set in logbook form with comprehensive info about which rows and columns would be effected and in which way.",
|
"WARNING: In Verbose mode, the eucast_rules() function does not apply rules to the data, but instead returns a data set in logbook form with comprehensive info about which rows and columns would be effected and in which way.",
|
||||||
"\n\nThis may overwrite your existing data if you use e.g.:",
|
"\n\nThis may overwrite your existing data if you use e.g.:",
|
||||||
"\ndata <- interpretive_rules(data, verbose = TRUE)\n\nDo you want to continue?"
|
"\ndata <- eucast_rules(data, verbose = TRUE)\n\nDo you want to continue?"
|
||||||
)
|
)
|
||||||
showQuestion <- import_fn("showQuestion", "rstudioapi", error_on_fail = FALSE)
|
showQuestion <- import_fn("showQuestion", "rstudioapi", error_on_fail = FALSE)
|
||||||
if (!is.null(showQuestion)) {
|
if (!is.null(showQuestion)) {
|
||||||
q_continue <- showQuestion("Using verbose = TRUE with interpretive_rules()", txt)
|
q_continue <- showQuestion("Using verbose = TRUE with eucast_rules()", txt)
|
||||||
} else {
|
} else {
|
||||||
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
|
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
|
||||||
}
|
}
|
||||||
@@ -325,7 +330,7 @@ interpretive_rules <- function(x,
|
|||||||
verbose = verbose,
|
verbose = verbose,
|
||||||
info = info,
|
info = info,
|
||||||
only_sir_columns = only_sir_columns,
|
only_sir_columns = only_sir_columns,
|
||||||
fn = "interpretive_rules",
|
fn = "eucast_rules",
|
||||||
...
|
...
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -479,13 +484,14 @@ interpretive_rules <- function(x,
|
|||||||
if (any(c("all", "other") %in% rules)) {
|
if (any(c("all", "other") %in% rules)) {
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
|
cat(paste0("\n", font_grey(strrep("-", 0.95 * getOption("width", 100))), "\n"))
|
||||||
message_(
|
cat(word_wrap(
|
||||||
"Rules by the ",
|
paste0(
|
||||||
font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)),
|
"Rules by the ",
|
||||||
" (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"),
|
font_bold(paste0("AMR package v", utils::packageDescription("AMR")$Version)),
|
||||||
"), see {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}",
|
" (", format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"),
|
||||||
as_note = FALSE
|
"), see {.help [{.fun eucast_rules}](AMR::eucast_rules)}\n"
|
||||||
)
|
)
|
||||||
|
))
|
||||||
cat("\n\n")
|
cat("\n\n")
|
||||||
}
|
}
|
||||||
ab_enzyme <- subset(AMR::antimicrobials, name %like% "/")[, c("ab", "name"), drop = FALSE]
|
ab_enzyme <- subset(AMR::antimicrobials, name %like% "/")[, c("ab", "name"), drop = FALSE]
|
||||||
@@ -516,11 +522,10 @@ interpretive_rules <- function(x,
|
|||||||
tolower(ab_enzyme$enzyme_name[i]), " ({.field ", font_bold(col_enzyme), "}) = R"
|
tolower(ab_enzyme$enzyme_name[i]), " ({.field ", font_bold(col_enzyme), "}) = R"
|
||||||
)
|
)
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
message_(rule_current,
|
cat(word_wrap(rule_current,
|
||||||
as_note = FALSE,
|
width = getOption("width") - 30,
|
||||||
appendLF = FALSE,
|
|
||||||
extra_indent = 6
|
extra_indent = 6
|
||||||
)
|
))
|
||||||
}
|
}
|
||||||
run_changes <- edit_sir(
|
run_changes <- edit_sir(
|
||||||
x = x,
|
x = x,
|
||||||
@@ -606,63 +611,59 @@ interpretive_rules <- function(x,
|
|||||||
|
|
||||||
if (!any(c("all", "custom") %in% rules) && !is.null(custom_rules)) {
|
if (!any(c("all", "custom") %in% rules) && !is.null(custom_rules)) {
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
message_("Skipping custom interpretive rules, since the {.arg rules} argument does not contain {.code \"custom\"}.")
|
message_("Skipping custom EUCAST rules, since the {.arg rules} argument does not contain {.code \"custom\"}.")
|
||||||
}
|
}
|
||||||
custom_rules <- NULL
|
custom_rules <- NULL
|
||||||
}
|
}
|
||||||
|
|
||||||
# >>> Apply Official interpretive rules <<< ---------------------------------------------------
|
# >>> Apply Official EUCAST rules <<< ---------------------------------------------------
|
||||||
eucast_notification_shown <- FALSE
|
eucast_notification_shown <- FALSE
|
||||||
if (!is.null(list(...)$interpretive_rules_df)) {
|
if (!is.null(list(...)$eucast_rules_df)) {
|
||||||
# this allows: interpretive_rules(x, interpretive_rules_df = AMR:::INTERPRETIVE_RULES_DF |> filter(is.na(have_these_values)))
|
# this allows: eucast_rules(x, eucast_rules_df = AMR:::EUCAST_RULES_DF |> filter(is.na(have_these_values)))
|
||||||
interpretive_rules_df_total <- list(...)$interpretive_rules_df
|
eucast_rules_df_total <- list(...)$eucast_rules_df
|
||||||
} else if (!is.null(list(...)$eucast_rules_df)) {
|
|
||||||
# deprecated parameter name kept for backward compatibility
|
|
||||||
interpretive_rules_df_total <- list(...)$eucast_rules_df
|
|
||||||
warning("Used interpretive_rules(x, eucast_rules_df = ...) - Do use newer argument interpretive_rules_df now.")
|
|
||||||
} else {
|
} else {
|
||||||
# internal data file, created in data-raw/_pre_commit_checks.R
|
# otherwise internal data file, created in data-raw/_pre_commit_checks.R
|
||||||
interpretive_rules_df_total <- INTERPRETIVE_RULES_DF
|
eucast_rules_df_total <- EUCAST_RULES_DF
|
||||||
}
|
}
|
||||||
|
|
||||||
## filter on guideline provider and user-set guideline versions ----
|
## filter on user-set guideline versions ----
|
||||||
interpretive_rules_df <- data.frame()
|
eucast_rules_df <- data.frame()
|
||||||
if (any(c("all", "breakpoints") %in% rules)) {
|
if (any(c("all", "breakpoints") %in% rules)) {
|
||||||
interpretive_rules_df <- interpretive_rules_df %pm>%
|
eucast_rules_df <- eucast_rules_df %pm>%
|
||||||
rbind_AMR(interpretive_rules_df_total %pm>%
|
rbind_AMR(eucast_rules_df_total %pm>%
|
||||||
subset(rule.provider == guideline & reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints))
|
subset(reference.rule_group %like% "breakpoint" & reference.version == version_breakpoints))
|
||||||
}
|
}
|
||||||
if (any(c("all", "expected_phenotypes") %in% rules)) {
|
if (any(c("all", "expected_phenotypes") %in% rules)) {
|
||||||
interpretive_rules_df <- interpretive_rules_df %pm>%
|
eucast_rules_df <- eucast_rules_df %pm>%
|
||||||
rbind_AMR(interpretive_rules_df_total %pm>%
|
rbind_AMR(eucast_rules_df_total %pm>%
|
||||||
subset(rule.provider == guideline & reference.rule_group %like% "expected" & reference.version == version_expected_phenotypes))
|
subset(reference.rule_group %like% "expected" & reference.version == version_expected_phenotypes))
|
||||||
}
|
}
|
||||||
if (any(c("all", "expert") %in% rules)) {
|
if (any(c("all", "expert") %in% rules)) {
|
||||||
interpretive_rules_df <- interpretive_rules_df %pm>%
|
eucast_rules_df <- eucast_rules_df %pm>%
|
||||||
rbind_AMR(interpretive_rules_df_total %pm>%
|
rbind_AMR(eucast_rules_df_total %pm>%
|
||||||
subset(rule.provider == guideline & reference.rule_group %like% "expert" & reference.version == version_expertrules))
|
subset(reference.rule_group %like% "expert" & reference.version == version_expertrules))
|
||||||
}
|
}
|
||||||
## filter out AmpC de-repressed cephalosporin-resistant mutants ----
|
## filter out AmpC de-repressed cephalosporin-resistant mutants ----
|
||||||
# no need to filter on version number here - the rules contain these version number, so are inherently filtered
|
# no need to filter on version number here - the rules contain these version number, so are inherently filtered
|
||||||
# cefotaxime, ceftriaxone, ceftazidime
|
# cefotaxime, ceftriaxone, ceftazidime
|
||||||
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
|
if (is.null(ampc_cephalosporin_resistance) || isFALSE(ampc_cephalosporin_resistance)) {
|
||||||
interpretive_rules_df <- subset(
|
eucast_rules_df <- subset(
|
||||||
interpretive_rules_df,
|
eucast_rules_df,
|
||||||
reference.rule %unlike% "ampc"
|
reference.rule %unlike% "ampc"
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
if (isTRUE(ampc_cephalosporin_resistance)) {
|
if (isTRUE(ampc_cephalosporin_resistance)) {
|
||||||
ampc_cephalosporin_resistance <- "R"
|
ampc_cephalosporin_resistance <- "R"
|
||||||
}
|
}
|
||||||
if (!is.null(interpretive_rules_df$reference.rule)) {
|
if (!is.null(eucast_rules_df$reference.rule)) {
|
||||||
interpretive_rules_df[which(interpretive_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
|
eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# sometimes, the screenings are missing but the names are actually available
|
# sometimes, the screenings are missing but the names are actually available
|
||||||
# we only hints on remaining rows in `interpretive_rules_df`
|
# we only hints on remaining rows in `eucast_rules_df`
|
||||||
screening_abx <- as.character(AMR::antimicrobials$ab[which(AMR::antimicrobials$ab %like% "-S$")])
|
screening_abx <- as.character(AMR::antimicrobials$ab[which(AMR::antimicrobials$ab %like% "-S$")])
|
||||||
screening_abx <- screening_abx[screening_abx %in% unique(unlist(strsplit(interpretive_rules_df_total$and_these_antibiotics[!is.na(interpretive_rules_df_total$and_these_antibiotics)], ", *")))]
|
screening_abx <- screening_abx[screening_abx %in% unique(unlist(strsplit(EUCAST_RULES_DF$and_these_antibiotics[!is.na(EUCAST_RULES_DF$and_these_antibiotics)], ", *")))]
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
cat("\n")
|
cat("\n")
|
||||||
}
|
}
|
||||||
@@ -681,12 +682,12 @@ interpretive_rules <- function(x,
|
|||||||
}
|
}
|
||||||
|
|
||||||
## Go over all rules and apply them ----
|
## Go over all rules and apply them ----
|
||||||
for (i in seq_len(nrow(interpretive_rules_df))) {
|
for (i in seq_len(nrow(eucast_rules_df))) {
|
||||||
rule_previous <- interpretive_rules_df[max(1, i - 1), "reference.rule", drop = TRUE]
|
rule_previous <- eucast_rules_df[max(1, i - 1), "reference.rule", drop = TRUE]
|
||||||
rule_current <- interpretive_rules_df[i, "reference.rule", drop = TRUE]
|
rule_current <- eucast_rules_df[i, "reference.rule", drop = TRUE]
|
||||||
rule_next <- interpretive_rules_df[min(nrow(interpretive_rules_df), i + 1), "reference.rule", drop = TRUE]
|
rule_next <- eucast_rules_df[min(nrow(eucast_rules_df), i + 1), "reference.rule", drop = TRUE]
|
||||||
rule_group_previous <- interpretive_rules_df[max(1, i - 1), "reference.rule_group", drop = TRUE]
|
rule_group_previous <- eucast_rules_df[max(1, i - 1), "reference.rule_group", drop = TRUE]
|
||||||
rule_group_current <- interpretive_rules_df[i, "reference.rule_group", drop = TRUE]
|
rule_group_current <- eucast_rules_df[i, "reference.rule_group", drop = TRUE]
|
||||||
# don't apply rules if user doesn't want to apply them
|
# don't apply rules if user doesn't want to apply them
|
||||||
if (rule_group_current %like% "breakpoint" && !any(c("all", "breakpoints") %in% rules)) {
|
if (rule_group_current %like% "breakpoint" && !any(c("all", "breakpoints") %in% rules)) {
|
||||||
next
|
next
|
||||||
@@ -701,16 +702,16 @@ interpretive_rules <- function(x,
|
|||||||
if (isFALSE(info) || isFALSE(verbose)) {
|
if (isFALSE(info) || isFALSE(verbose)) {
|
||||||
rule_text <- ""
|
rule_text <- ""
|
||||||
} else {
|
} else {
|
||||||
if (is.na(interpretive_rules_df[i, "and_these_antibiotics", drop = TRUE])) {
|
if (is.na(eucast_rules_df[i, "and_these_antibiotics", drop = TRUE])) {
|
||||||
rule_text <- paste0("always report as '", interpretive_rules_df[i, "to_value", drop = TRUE], "': ", get_antibiotic_names(interpretive_rules_df[i, "then_change_these_antibiotics", drop = TRUE]))
|
rule_text <- paste0("always report as '", eucast_rules_df[i, "to_value", drop = TRUE], "': ", get_antibiotic_names(eucast_rules_df[i, "then_change_these_antibiotics", drop = TRUE]))
|
||||||
} else {
|
} else {
|
||||||
rule_text <- paste0(
|
rule_text <- paste0(
|
||||||
"report as '", interpretive_rules_df[i, "to_value", drop = TRUE], "' when ",
|
"report as '", eucast_rules_df[i, "to_value", drop = TRUE], "' when ",
|
||||||
format_antibiotic_names(
|
format_antibiotic_names(
|
||||||
ab_names = get_antibiotic_names(interpretive_rules_df[i, "and_these_antibiotics", drop = TRUE]),
|
ab_names = get_antibiotic_names(eucast_rules_df[i, "and_these_antibiotics", drop = TRUE]),
|
||||||
ab_results = interpretive_rules_df[i, "have_these_values", drop = TRUE]
|
ab_results = eucast_rules_df[i, "have_these_values", drop = TRUE]
|
||||||
), ": ",
|
), ": ",
|
||||||
get_antibiotic_names(interpretive_rules_df[i, "then_change_these_antibiotics", drop = TRUE])
|
get_antibiotic_names(eucast_rules_df[i, "then_change_these_antibiotics", drop = TRUE])
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -719,7 +720,7 @@ interpretive_rules <- function(x,
|
|||||||
rule_previous <- ""
|
rule_previous <- ""
|
||||||
rule_group_previous <- ""
|
rule_group_previous <- ""
|
||||||
}
|
}
|
||||||
if (i == nrow(interpretive_rules_df)) {
|
if (i == nrow(eucast_rules_df)) {
|
||||||
rule_next <- ""
|
rule_next <- ""
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -788,13 +789,13 @@ interpretive_rules <- function(x,
|
|||||||
}
|
}
|
||||||
|
|
||||||
## Get rule from file ------------------------------------------------------
|
## Get rule from file ------------------------------------------------------
|
||||||
if_mo_property <- trimws(interpretive_rules_df[i, "if_mo_property", drop = TRUE])
|
if_mo_property <- trimws(eucast_rules_df[i, "if_mo_property", drop = TRUE])
|
||||||
like_is_one_of <- trimws(interpretive_rules_df[i, "like.is.one_of", drop = TRUE])
|
like_is_one_of <- trimws(eucast_rules_df[i, "like.is.one_of", drop = TRUE])
|
||||||
mo_value <- trimws(interpretive_rules_df[i, "this_value", drop = TRUE])
|
mo_value <- trimws(eucast_rules_df[i, "this_value", drop = TRUE])
|
||||||
source_antibiotics <- interpretive_rules_df[i, "and_these_antibiotics", drop = TRUE]
|
source_antibiotics <- eucast_rules_df[i, "and_these_antibiotics", drop = TRUE]
|
||||||
source_value <- trimws(unlist(strsplit(interpretive_rules_df[i, "have_these_values", drop = TRUE], ",", fixed = TRUE)))
|
source_value <- trimws(unlist(strsplit(eucast_rules_df[i, "have_these_values", drop = TRUE], ",", fixed = TRUE)))
|
||||||
target_antibiotics <- interpretive_rules_df[i, "then_change_these_antibiotics", drop = TRUE]
|
target_antibiotics <- eucast_rules_df[i, "then_change_these_antibiotics", drop = TRUE]
|
||||||
target_value <- interpretive_rules_df[i, "to_value", drop = TRUE]
|
target_value <- eucast_rules_df[i, "to_value", drop = TRUE]
|
||||||
|
|
||||||
# if amo_value contains a group name, expand that name with all species in it
|
# if amo_value contains a group name, expand that name with all species in it
|
||||||
if (any(trimws(strsplit(mo_value, ",")[[1]]) %in% AMR::microorganisms.groups$mo_group_name, na.rm = TRUE)) {
|
if (any(trimws(strsplit(mo_value, ",")[[1]]) %in% AMR::microorganisms.groups$mo_group_name, na.rm = TRUE)) {
|
||||||
@@ -893,7 +894,7 @@ interpretive_rules <- function(x,
|
|||||||
if (!is.null(custom_rules)) {
|
if (!is.null(custom_rules)) {
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
cat("\n")
|
cat("\n")
|
||||||
cat(font_bold("Custom interpretive rules, set by user"), "\n")
|
cat(font_bold("Custom EUCAST rules, set by user"), "\n")
|
||||||
}
|
}
|
||||||
for (i in seq_len(length(custom_rules))) {
|
for (i in seq_len(length(custom_rules))) {
|
||||||
rule <- custom_rules[[i]]
|
rule <- custom_rules[[i]]
|
||||||
@@ -928,8 +929,8 @@ interpretive_rules <- function(x,
|
|||||||
to = target_value,
|
to = target_value,
|
||||||
rule = c(
|
rule = c(
|
||||||
rule_text,
|
rule_text,
|
||||||
"Custom interpretive rules",
|
"Custom EUCAST rules",
|
||||||
paste0("Custom interpretive rule ", i),
|
paste0("Custom EUCAST rule ", i),
|
||||||
paste0(
|
paste0(
|
||||||
"Object '", deparse(substitute(custom_rules)),
|
"Object '", deparse(substitute(custom_rules)),
|
||||||
"' consisting of ", length(custom_rules), " custom rules"
|
"' consisting of ", length(custom_rules), " custom rules"
|
||||||
@@ -1074,7 +1075,7 @@ interpretive_rules <- function(x,
|
|||||||
warn_lacking_sir_class <- warn_lacking_sir_class[order(colnames(x.bak))]
|
warn_lacking_sir_class <- warn_lacking_sir_class[order(colnames(x.bak))]
|
||||||
warn_lacking_sir_class <- warn_lacking_sir_class[!is.na(warn_lacking_sir_class)]
|
warn_lacking_sir_class <- warn_lacking_sir_class[!is.na(warn_lacking_sir_class)]
|
||||||
warning_(
|
warning_(
|
||||||
"in {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}: not all columns with antimicrobial results are of class {.cls sir}. Transform them on beforehand, e.g.:\n\n",
|
"in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: not all columns with antimicrobial results are of class {.cls sir}. Transform them on beforehand, e.g.:\n\n",
|
||||||
"\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0(x_deparsed, " |> as.sir(", ifelse(length(warn_lacking_sir_class) == 1,
|
"\u00a0\u00a0", AMR_env$bullet_icon, " ", highlight_code(paste0(x_deparsed, " |> as.sir(", ifelse(length(warn_lacking_sir_class) == 1,
|
||||||
warn_lacking_sir_class,
|
warn_lacking_sir_class,
|
||||||
paste0(warn_lacking_sir_class[1], ":", warn_lacking_sir_class[length(warn_lacking_sir_class)])
|
paste0(warn_lacking_sir_class[1], ":", warn_lacking_sir_class[length(warn_lacking_sir_class)])
|
||||||
@@ -1176,7 +1177,7 @@ edit_sir <- function(x,
|
|||||||
new_edits[rows, cols] == "NS")
|
new_edits[rows, cols] == "NS")
|
||||||
non_SIR <- !isSIR
|
non_SIR <- !isSIR
|
||||||
if (isFALSE(overwrite) && any(isSIR) && message_not_thrown_before("edit_sir.warning_overwrite")) {
|
if (isFALSE(overwrite) && any(isSIR) && message_not_thrown_before("edit_sir.warning_overwrite")) {
|
||||||
warning_("in {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}: some columns had SIR values which were not overwritten, since {.code overwrite = FALSE}.")
|
warning_("in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: some columns had SIR values which were not overwritten, since {.code overwrite = FALSE}.")
|
||||||
}
|
}
|
||||||
# determine which cells to modify based on overwrite and add_if_missing
|
# determine which cells to modify based on overwrite and add_if_missing
|
||||||
if (isTRUE(overwrite)) {
|
if (isTRUE(overwrite)) {
|
||||||
@@ -1210,7 +1211,7 @@ edit_sir <- function(x,
|
|||||||
})
|
})
|
||||||
suppressWarnings(do_assign())
|
suppressWarnings(do_assign())
|
||||||
warning_(
|
warning_(
|
||||||
"in {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}: value \"", to, "\" added to the factor levels of column",
|
"in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: value \"", to, "\" added to the factor levels of column",
|
||||||
ifelse(length(cols) == 1, "", "s"),
|
ifelse(length(cols) == 1, "", "s"),
|
||||||
" ", vector_and(cols, quotes = "`", sort = FALSE),
|
" ", vector_and(cols, quotes = "`", sort = FALSE),
|
||||||
" because this value was not an existing factor level."
|
" because this value was not an existing factor level."
|
||||||
@@ -1218,7 +1219,7 @@ edit_sir <- function(x,
|
|||||||
txt_warning()
|
txt_warning()
|
||||||
warned <<- FALSE
|
warned <<- FALSE
|
||||||
} else {
|
} else {
|
||||||
warning_("in {.help [{.fun interpretive_rules}](AMR::interpretive_rules)}: ", w$message)
|
warning_("in {.help [{.fun eucast_rules}](AMR::eucast_rules)}: ", w$message)
|
||||||
txt_warning()
|
txt_warning()
|
||||||
}
|
}
|
||||||
},
|
},
|
||||||
|
|||||||
@@ -161,11 +161,11 @@ key_antimicrobials <- function(x = NULL,
|
|||||||
if (is.null(col_mo)) {
|
if (is.null(col_mo)) {
|
||||||
warning_("in {.fun key_antimicrobials}: no column found for {.arg col_mo}, ignoring antibiotics set in {.arg gram_negative} and {.arg gram_positive}, and antimycotics set in {.arg antifungal}")
|
warning_("in {.fun key_antimicrobials}: no column found for {.arg col_mo}, ignoring antibiotics set in {.arg gram_negative} and {.arg gram_positive}, and antimycotics set in {.arg antifungal}")
|
||||||
gramstain <- NA_character_
|
gramstain <- NA_character_
|
||||||
domain <- NA_character_
|
kingdom <- NA_character_
|
||||||
} else {
|
} else {
|
||||||
x.mo <- as.mo(x[, col_mo, drop = TRUE])
|
x.mo <- as.mo(x[, col_mo, drop = TRUE])
|
||||||
gramstain <- mo_gramstain(x.mo, language = NULL)
|
gramstain <- mo_gramstain(x.mo, language = NULL)
|
||||||
domain <- mo_domain(x.mo, language = NULL)
|
kingdom <- mo_kingdom(x.mo, language = NULL)
|
||||||
}
|
}
|
||||||
|
|
||||||
AMR_string <- function(x, values, name, filter, cols = cols) {
|
AMR_string <- function(x, values, name, filter, cols = cols) {
|
||||||
@@ -219,11 +219,11 @@ key_antimicrobials <- function(x = NULL,
|
|||||||
cols = cols
|
cols = cols
|
||||||
)
|
)
|
||||||
|
|
||||||
key_ab[which(domain == "Fungi")] <- AMR_string(
|
key_ab[which(kingdom == "Fungi")] <- AMR_string(
|
||||||
x = x,
|
x = x,
|
||||||
values = antifungal,
|
values = antifungal,
|
||||||
name = "antifungal",
|
name = "antifungal",
|
||||||
filter = domain == "Fungi",
|
filter = kingdom == "Fungi",
|
||||||
cols = cols
|
cols = cols
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|||||||
12
R/mdro.R
12
R/mdro.R
@@ -1511,8 +1511,8 @@ mdro <- function(x = NULL,
|
|||||||
fluoroquinolones <- c(CIP, NOR, LVX) # note 5: ciprofloxacin or norfloxacin or levofloxacin
|
fluoroquinolones <- c(CIP, NOR, LVX) # note 5: ciprofloxacin or norfloxacin or levofloxacin
|
||||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||||
carbapenems_without_imipenem <- carbapenems[carbapenems != IPM]
|
carbapenems_without_imipenem <- carbapenems[carbapenems != IPM]
|
||||||
amino <- AMX %or_if_na% AMP
|
amino <- AMX %or% AMP
|
||||||
third <- CAZ %or_if_na% CTX
|
third <- CAZ %or% CTX
|
||||||
ESBLs <- c(amino, third)
|
ESBLs <- c(amino, third)
|
||||||
ESBLs <- ESBLs[!is.na(ESBLs)]
|
ESBLs <- ESBLs[!is.na(ESBLs)]
|
||||||
if (length(ESBLs) != 2) {
|
if (length(ESBLs) != 2) {
|
||||||
@@ -1524,7 +1524,7 @@ mdro <- function(x = NULL,
|
|||||||
trans_tbl(
|
trans_tbl(
|
||||||
2, # positive, unconfirmed
|
2, # positive, unconfirmed
|
||||||
rows = which(x$order == "Enterobacterales" & col_values(x, ESBLs[1]) == "R" & col_values(x, ESBLs[2]) == "R" & is.na(esbl)),
|
rows = which(x$order == "Enterobacterales" & col_values(x, ESBLs[1]) == "R" & col_values(x, ESBLs[2]) == "R" & is.na(esbl)),
|
||||||
cols = c(AMX %or_if_na% AMP, cephalosporins_3rd),
|
cols = c(AMX %or% AMP, cephalosporins_3rd),
|
||||||
any_all = "all",
|
any_all = "all",
|
||||||
reason = "Enterobacterales: potential ESBL"
|
reason = "Enterobacterales: potential ESBL"
|
||||||
)
|
)
|
||||||
@@ -1634,7 +1634,7 @@ mdro <- function(x = NULL,
|
|||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
rows = which(x$genus == "Enterococcus" & x$species == "faecium"),
|
rows = which(x$genus == "Enterococcus" & x$species == "faecium"),
|
||||||
cols = c(PEN %or_if_na% AMX %or_if_na% AMP, VAN),
|
cols = c(PEN %or% AMX %or% AMP, VAN),
|
||||||
any_all = "all",
|
any_all = "all",
|
||||||
reason = "E. faecium: vancomycin + penicillin group"
|
reason = "E. faecium: vancomycin + penicillin group"
|
||||||
)
|
)
|
||||||
@@ -1677,8 +1677,8 @@ mdro <- function(x = NULL,
|
|||||||
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
||||||
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
|
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
|
||||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||||
amino <- AMX %or_if_na% AMP
|
amino <- AMX %or% AMP
|
||||||
third <- CAZ %or_if_na% CTX
|
third <- CAZ %or% CTX
|
||||||
ESBLs <- c(amino, third)
|
ESBLs <- c(amino, third)
|
||||||
ESBLs <- ESBLs[!is.na(ESBLs)]
|
ESBLs <- ESBLs[!is.na(ESBLs)]
|
||||||
if (length(ESBLs) != 2) {
|
if (length(ESBLs) != 2) {
|
||||||
|
|||||||
95
R/mo.R
95
R/mo.R
@@ -29,7 +29,7 @@
|
|||||||
|
|
||||||
#' Transform Arbitrary Input to Valid Microbial Taxonomy
|
#' Transform Arbitrary Input to Valid Microbial Taxonomy
|
||||||
#'
|
#'
|
||||||
#' Use this function to get a valid microorganism code ([`mo`]) based on arbitrary user input. Determination is done using intelligent rules and the complete taxonomic tree of the domains `r vector_and(unique(microorganisms$domain[which(!grepl("(unknown|Fungi)", microorganisms$domain))]), quotes = FALSE)`, and most microbial species from the domain Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
#' Use this function to get a valid microorganism code ([`mo`]) based on arbitrary user input. Determination is done using intelligent rules and the complete taxonomic tree of the kingdoms `r vector_and(unique(microorganisms$kingdom[which(!grepl("(unknown|Fungi)", microorganisms$kingdom))]), quotes = FALSE)`, and most microbial species from the kingdom Fungi (see *Source*). The input can be almost anything: a full name (like `"Staphylococcus aureus"`), an abbreviated name (such as `"S. aureus"`), an abbreviation known in the field (such as `"MRSA"`), or just a genus. See *Examples*.
|
||||||
#' @param x A [character] vector or a [data.frame] with one or two columns.
|
#' @param x A [character] vector or a [data.frame] with one or two columns.
|
||||||
#' @param Becker A [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (see *Source*). Please see *Details* for a full list of staphylococcal species that will be converted.
|
#' @param Becker A [logical] to indicate whether staphylococci should be categorised into coagulase-negative staphylococci ("CoNS") and coagulase-positive staphylococci ("CoPS") instead of their own species, according to Karsten Becker *et al.* (see *Source*). Please see *Details* for a full list of staphylococcal species that will be converted.
|
||||||
#'
|
#'
|
||||||
@@ -37,14 +37,14 @@
|
|||||||
#' @param Lancefield A [logical] to indicate whether a beta-haemolytic *Streptococcus* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (see *Source*). These streptococci will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L. . Please see *Details* for a full list of streptococcal species that will be converted.
|
#' @param Lancefield A [logical] to indicate whether a beta-haemolytic *Streptococcus* should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield (see *Source*). These streptococci will be categorised in their first group, e.g. *Streptococcus dysgalactiae* will be group C, although officially it was also categorised into groups G and L. . Please see *Details* for a full list of streptococcal species that will be converted.
|
||||||
#'
|
#'
|
||||||
#' This excludes enterococci at default (who are in group D), use `Lancefield = "all"` to also categorise all enterococci as group D.
|
#' This excludes enterococci at default (who are in group D), use `Lancefield = "all"` to also categorise all enterococci as group D.
|
||||||
#' @param minimum_matching_score A numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic domain][microorganisms] and [human pathogenicity][mo_matching_score()].
|
#' @param minimum_matching_score A numeric value to set as the lower limit for the [MO matching score][mo_matching_score()]. When left blank, this will be determined automatically based on the character length of `x`, its [taxonomic kingdom][microorganisms] and [human pathogenicity][mo_matching_score()].
|
||||||
#' @param keep_synonyms A [logical] to indicate if outdated, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. Do note that the term "synonym" is in this case jargon from the field of microbial taxonomy - it is not in place to denote that e.g. "Streptococcus Group A" is a synonym of *S. pyogenes*. Though this is practically the case, taxonomically it is not as "Streptococcus Group A" is not even a valid taxonomic name.
|
#' @param keep_synonyms A [logical] to indicate if outdated, previously valid taxonomic names must be preserved and not be corrected to currently accepted names. Do note that the term "synonym" is in this case jargon from the field of microbial taxonomy - it is not in place to denote that e.g. "Streptococcus Group A" is a synonym of *S. pyogenes*. Though this is practically the case, taxonomically it is not as "Streptococcus Group A" is not even a valid taxonomic name.
|
||||||
#'
|
#'
|
||||||
#' The default is `FALSE`, which will return a note if outdated taxonomic names were processed. The default can be set with the package option [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
|
#' The default is `FALSE`, which will return a note if outdated taxonomic names were processed. The default can be set with the package option [`AMR_keep_synonyms`][AMR-options], i.e. `options(AMR_keep_synonyms = TRUE)` or `options(AMR_keep_synonyms = FALSE)`.
|
||||||
#' @param reference_df A [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
|
#' @param reference_df A [data.frame] to be used for extra reference when translating `x` to a valid [`mo`]. See [set_mo_source()] and [get_mo_source()] to automate the usage of your own codes (e.g. used in your analysis or organisation).
|
||||||
#' @param ignore_pattern A Perl-compatible [regular expression][base::regex] (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the package option [`AMR_ignore_pattern`][AMR-options], e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
#' @param ignore_pattern A Perl-compatible [regular expression][base::regex] (case-insensitive) of which all matches in `x` must return `NA`. This can be convenient to exclude known non-relevant input and can also be set with the package option [`AMR_ignore_pattern`][AMR-options], e.g. `options(AMR_ignore_pattern = "(not reported|contaminated flora)")`.
|
||||||
#' @param cleaning_regex A Perl-compatible [regular expression][base::regex] (case-insensitive) to clean the input of `x`. Every matched part in `x` will be removed. At default, this is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar". The default can be set with the package option [`AMR_cleaning_regex`][AMR-options].
|
#' @param cleaning_regex A Perl-compatible [regular expression][base::regex] (case-insensitive) to clean the input of `x`. Every matched part in `x` will be removed. At default, this is the outcome of [mo_cleaning_regex()], which removes texts between brackets and texts such as "species" and "serovar". The default can be set with the package option [`AMR_cleaning_regex`][AMR-options].
|
||||||
#' @param only_fungi A [logical] to indicate if only fungi must be found, making sure that e.g. misspellings always return records from the domain of Fungi. This can be set globally for [all microorganism functions][mo_property()] with the package option [`AMR_only_fungi`][AMR-options], i.e. `options(AMR_only_fungi = TRUE)`.
|
#' @param only_fungi A [logical] to indicate if only fungi must be found, making sure that e.g. misspellings always return records from the kingdom of Fungi. This can be set globally for [all microorganism functions][mo_property()] with the package option [`AMR_only_fungi`][AMR-options], i.e. `options(AMR_only_fungi = TRUE)`.
|
||||||
#' @param language Language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()]).
|
#' @param language Language to translate text like "no growth", which defaults to the system language (see [get_AMR_locale()]).
|
||||||
#' @param info A [logical] to indicate that info must be printed, e.g. a progress bar when more than 25 items are to be coerced, or a list with outdated taxonomic names. The default is `TRUE` only in interactive mode.
|
#' @param info A [logical] to indicate that info must be printed, e.g. a progress bar when more than 25 items are to be coerced, or a list with outdated taxonomic names. The default is `TRUE` only in interactive mode.
|
||||||
#' @param ... Other arguments passed on to functions.
|
#' @param ... Other arguments passed on to functions.
|
||||||
@@ -64,7 +64,7 @@
|
|||||||
#' | | | \---> subspecies, a 3-5 letter acronym
|
#' | | | \---> subspecies, a 3-5 letter acronym
|
||||||
#' | | \----> species, a 3-6 letter acronym
|
#' | | \----> species, a 3-6 letter acronym
|
||||||
#' | \----> genus, a 4-8 letter acronym
|
#' | \----> genus, a 4-8 letter acronym
|
||||||
#' \----> domain: A (Archaea), AN (Animalia), B (Bacteria),
|
#' \----> kingdom: A (Archaea), AN (Animalia), B (Bacteria),
|
||||||
#' C (Chromista), F (Fungi), PL (Plantae),
|
#' C (Chromista), F (Fungi), PL (Plantae),
|
||||||
#' P (Protozoa)
|
#' P (Protozoa)
|
||||||
#' ```
|
#' ```
|
||||||
@@ -77,7 +77,7 @@
|
|||||||
#'
|
#'
|
||||||
#' ### Coping with Uncertain Results
|
#' ### Coping with Uncertain Results
|
||||||
#'
|
#'
|
||||||
#' Results of non-exact taxonomic input are based on their [matching score][mo_matching_score()]. The lowest allowed score can be set with the `minimum_matching_score` argument. At default this will be determined based on the character length of the input, the [taxonomic domain][microorganisms], and the [human pathogenicity][mo_matching_score()] of the taxonomic outcome. If values are matched with uncertainty, a message will be shown to suggest the user to inspect the results with [mo_uncertainties()], which returns a [data.frame] with all specifications.
|
#' Results of non-exact taxonomic input are based on their [matching score][mo_matching_score()]. The lowest allowed score can be set with the `minimum_matching_score` argument. At default this will be determined based on the character length of the input, the [taxonomic kingdom][microorganisms], and the [human pathogenicity][mo_matching_score()] of the taxonomic outcome. If values are matched with uncertainty, a message will be shown to suggest the user to inspect the results with [mo_uncertainties()], which returns a [data.frame] with all specifications.
|
||||||
#'
|
#'
|
||||||
#' To increase the quality of matching, the `cleaning_regex` argument is used to clean the input. This must be a [regular expression][base::regex] that matches parts of the input that should be removed before the input is matched against the [available microbial taxonomy][microorganisms]. It will be matched Perl-compatible and case-insensitive. The default value of `cleaning_regex` is the outcome of the helper function [mo_cleaning_regex()].
|
#' To increase the quality of matching, the `cleaning_regex` argument is used to clean the input. This must be a [regular expression][base::regex] that matches parts of the input that should be removed before the input is matched against the [available microbial taxonomy][microorganisms]. It will be matched Perl-compatible and case-insensitive. The default value of `cleaning_regex` is the outcome of the helper function [mo_cleaning_regex()].
|
||||||
#'
|
#'
|
||||||
@@ -241,7 +241,7 @@ as.mo <- function(x,
|
|||||||
out[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo] <- toupper(x[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo])
|
out[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo] <- toupper(x[is.na(out) & toupper(x) %in% AMR_env$MO_lookup$mo])
|
||||||
# From full name ----
|
# From full name ----
|
||||||
out[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower] <- AMR_env$MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower], AMR_env$MO_lookup$fullname_lower)]
|
out[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower] <- AMR_env$MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower], AMR_env$MO_lookup$fullname_lower)]
|
||||||
# one exception: "Fungi" matches the domain, but instead it should return the 'unknown' code for fungi
|
# one exception: "Fungi" matches the kingdom, but instead it should return the 'unknown' code for fungi
|
||||||
out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS"
|
out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS"
|
||||||
# From known codes ----
|
# From known codes ----
|
||||||
ind <- is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code
|
ind <- is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code
|
||||||
@@ -300,7 +300,7 @@ as.mo <- function(x,
|
|||||||
|
|
||||||
MO_lookup_current <- AMR_env$MO_lookup
|
MO_lookup_current <- AMR_env$MO_lookup
|
||||||
if (isTRUE(only_fungi)) {
|
if (isTRUE(only_fungi)) {
|
||||||
MO_lookup_current <- MO_lookup_current[MO_lookup_current$domain == "Fungi", , drop = FALSE]
|
MO_lookup_current <- MO_lookup_current[MO_lookup_current$kingdom == "Fungi", , drop = FALSE]
|
||||||
}
|
}
|
||||||
|
|
||||||
# run it
|
# run it
|
||||||
@@ -322,15 +322,6 @@ as.mo <- function(x,
|
|||||||
return(as.character(MO_lookup_current$mo[match(x_out, MO_lookup_current$fullname_lower)]))
|
return(as.character(MO_lookup_current$mo[match(x_out, MO_lookup_current$fullname_lower)]))
|
||||||
}
|
}
|
||||||
|
|
||||||
# Issue #287: "X complex" is not a distinct taxon - strip " complex" and try "X"
|
|
||||||
if (grepl(" complex$", x_out, ignore.case = FALSE)) {
|
|
||||||
x_out <- sub(" complex$", "", x_out)
|
|
||||||
x_search_cleaned <- sub(" [Cc]omplex$", "", x_search_cleaned)
|
|
||||||
if (x_out %in% MO_lookup_current$fullname_lower) {
|
|
||||||
return(as.character(MO_lookup_current$mo[match(x_out, MO_lookup_current$fullname_lower)]))
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# input must not be too short
|
# input must not be too short
|
||||||
if (nchar(x_out) < 3) {
|
if (nchar(x_out) < 3) {
|
||||||
return("UNKNOWN")
|
return("UNKNOWN")
|
||||||
@@ -352,36 +343,6 @@ as.mo <- function(x,
|
|||||||
(MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
|
(MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
|
||||||
MO_lookup_current$subspecies_first == substr(x_parts[2], 1, 1) |
|
MO_lookup_current$subspecies_first == substr(x_parts[2], 1, 1) |
|
||||||
MO_lookup_current$subspecies_first == substr(x_parts[3], 1, 1)))
|
MO_lookup_current$subspecies_first == substr(x_parts[3], 1, 1)))
|
||||||
# Issue #288 (extended): if the species (and subspecies) word(s) in the input
|
|
||||||
# exactly match candidates that all belong to one and the same genus, bypass the
|
|
||||||
# 0.55 cutoff. A species together with its subspecies/autonyms (e.g. Plasmodium
|
|
||||||
# ovale + curtisi + wallikeri) is the same taxon, so for a genus+species input we
|
|
||||||
# collapse to the species-rank record (subspecies == ""). This prevents prevalent
|
|
||||||
# bacteria from outranking a rarer organism whose species epithet is an
|
|
||||||
# unambiguous exact match, e.g. "S. apiospermum" -> Scedosporium, "P. ovale" ->
|
|
||||||
# Plasmodium ovale. If two different genera share the epithet, the genus check
|
|
||||||
# stays FALSE and the normal matching score arbitrates.
|
|
||||||
sp_exact <- tolower(MO_lookup_current$species[filtr]) == x_parts[2]
|
|
||||||
if (length(x_parts) == 3) {
|
|
||||||
sp_exact <- sp_exact & tolower(MO_lookup_current$subspecies[filtr]) == x_parts[3]
|
|
||||||
}
|
|
||||||
exact_idx <- filtr[sp_exact]
|
|
||||||
if (length(exact_idx) >= 1 &&
|
|
||||||
length(unique(MO_lookup_current$genus_lower[exact_idx])) == 1) {
|
|
||||||
if (length(x_parts) == 2) {
|
|
||||||
# genus + species only: collapse to the species-rank record (subspecies == "")
|
|
||||||
is_species_rank <- MO_lookup_current$subspecies[exact_idx] == ""
|
|
||||||
if (any(is_species_rank)) {
|
|
||||||
filtr <- exact_idx[is_species_rank][1]
|
|
||||||
} else {
|
|
||||||
filtr <- exact_idx[1]
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
# explicit subspecies given, unambiguous within the genus
|
|
||||||
filtr <- exact_idx[1]
|
|
||||||
}
|
|
||||||
minimum_matching_score <- 0
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
filtr <- which(MO_lookup_current$full_first == substr(x_parts[1], 1, 1) |
|
filtr <- which(MO_lookup_current$full_first == substr(x_parts[1], 1, 1) |
|
||||||
MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
|
MO_lookup_current$species_first == substr(x_parts[2], 1, 1) |
|
||||||
@@ -424,8 +385,8 @@ as.mo <- function(x,
|
|||||||
minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08)
|
minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08)
|
||||||
# correct back for prevalence
|
# correct back for prevalence
|
||||||
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$prevalence[match(mo_to_search, MO_lookup_current$fullname)]
|
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$prevalence[match(mo_to_search, MO_lookup_current$fullname)]
|
||||||
# correct back for domain
|
# correct back for kingdom
|
||||||
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$domain_index[match(mo_to_search, MO_lookup_current$fullname)]
|
minimum_matching_score_current <- minimum_matching_score_current / MO_lookup_current$kingdom_index[match(mo_to_search, MO_lookup_current$fullname)]
|
||||||
minimum_matching_score_current <- pmax(minimum_matching_score_current, m)
|
minimum_matching_score_current <- pmax(minimum_matching_score_current, m)
|
||||||
if (length(x_parts) > 1 && all(m <= 0.55, na.rm = TRUE)) {
|
if (length(x_parts) > 1 && all(m <= 0.55, na.rm = TRUE)) {
|
||||||
# if the highest score is 0.5, we have nothing serious - 0.5 is the lowest for pathogenic group 1
|
# if the highest score is 0.5, we have nothing serious - 0.5 is the lowest for pathogenic group 1
|
||||||
@@ -686,7 +647,7 @@ NA_mo_ <- set_clean_class(NA_character_,
|
|||||||
pillar_shaft.mo <- function(x, ...) {
|
pillar_shaft.mo <- function(x, ...) {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
out <- trimws(format(x))
|
out <- trimws(format(x))
|
||||||
# grey out the domain (part until first "_")
|
# grey out the kingdom (part until first "_")
|
||||||
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)], perl = TRUE)
|
||||||
# and grey out every _
|
# and grey out every _
|
||||||
out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
|
out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
|
||||||
@@ -712,7 +673,9 @@ pillar_shaft.mo <- function(x, ...) {
|
|||||||
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
|
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
|
||||||
# markup old mo codes
|
# markup old mo codes
|
||||||
out[!x %in% all_mos] <- font_italic(
|
out[!x %in% all_mos] <- font_italic(
|
||||||
pillar::style_na(x[!x %in% all_mos]),
|
pillar::style_na(x[!x %in% all_mos],
|
||||||
|
collapse = NULL
|
||||||
|
),
|
||||||
collapse = NULL
|
collapse = NULL
|
||||||
)
|
)
|
||||||
# throw a warning with the affected column name(s)
|
# throw a warning with the affected column name(s)
|
||||||
@@ -722,7 +685,7 @@ pillar_shaft.mo <- function(x, ...) {
|
|||||||
col <- "The data"
|
col <- "The data"
|
||||||
}
|
}
|
||||||
warning_(
|
warning_(
|
||||||
col, " contains old MO codes (from another AMR package version). ",
|
col, " contains old MO codes (from a previous AMR package version). ",
|
||||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
|
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)}.",
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
@@ -1039,19 +1002,17 @@ print.mo_uncertainties <- function(x, n = 10, ...) {
|
|||||||
message_(out2, as_note = FALSE)
|
message_(out2, as_note = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (x[i, ]$candidates != "") {
|
other_matches <- paste0(
|
||||||
other_matches <- paste0(
|
"Also matched: ",
|
||||||
"Also matched: ",
|
vector_and(
|
||||||
vector_and(
|
paste0(
|
||||||
paste0(
|
candidates_formatted,
|
||||||
candidates_formatted,
|
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
||||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
),
|
||||||
),
|
quotes = FALSE, sort = FALSE
|
||||||
quotes = FALSE, sort = FALSE
|
|
||||||
)
|
|
||||||
)
|
)
|
||||||
message_(other_matches, as_note = FALSE)
|
)
|
||||||
}
|
message_(other_matches, as_note = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(any_maxed_out)) {
|
if (isTRUE(any_maxed_out)) {
|
||||||
@@ -1267,13 +1228,13 @@ replace_old_mo_codes <- function(x, property) {
|
|||||||
solved_unique <- unlist(lapply(
|
solved_unique <- unlist(lapply(
|
||||||
strsplit(affected_unique, ""),
|
strsplit(affected_unique, ""),
|
||||||
function(m) {
|
function(m) {
|
||||||
domain <- paste0("^", m[1])
|
kingdom <- paste0("^", m[1])
|
||||||
name <- m[3:length(m)]
|
name <- m[3:length(m)]
|
||||||
name[name == "_"] <- " "
|
name[name == "_"] <- " "
|
||||||
name <- tolower(paste0(name, ".*", collapse = ""))
|
name <- tolower(paste0(name, ".*", collapse = ""))
|
||||||
name <- gsub(" .*", " ", name, fixed = TRUE)
|
name <- gsub(" .*", " ", name, fixed = TRUE)
|
||||||
name <- paste0("^", name)
|
name <- paste0("^", name)
|
||||||
results <- AMR_env$MO_lookup$mo[AMR_env$MO_lookup$domain %like_case% domain &
|
results <- AMR_env$MO_lookup$mo[AMR_env$MO_lookup$kingdom %like_case% kingdom &
|
||||||
AMR_env$MO_lookup$fullname_lower %like_case% name]
|
AMR_env$MO_lookup$fullname_lower %like_case% name]
|
||||||
if (length(results) > 1) {
|
if (length(results) > 1) {
|
||||||
all_direct_matches <<- FALSE
|
all_direct_matches <<- FALSE
|
||||||
@@ -1297,14 +1258,14 @@ replace_old_mo_codes <- function(x, property) {
|
|||||||
warning_(
|
warning_(
|
||||||
"in {.help [{.fun mo_", property, "}](AMR::mo_", property, ")}: the input contained ", n_matched,
|
"in {.help [{.fun mo_", property, "}](AMR::mo_", property, ")}: the input contained ", n_matched,
|
||||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||||
" (", n_unique, "from another AMR package version). ",
|
" (", n_unique, "from a previous AMR package version). ",
|
||||||
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)} to increase speed."
|
"Please update your MO codes with {.help [{.fun as.mo}](AMR::as.mo)} to increase speed."
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
warning_(
|
warning_(
|
||||||
"in {.help [{.fun as.mo}](AMR::as.mo)}: the input contained ", n_matched,
|
"in {.help [{.fun as.mo}](AMR::as.mo)}: the input contained ", n_matched,
|
||||||
" old MO code", ifelse(n_matched == 1, "", "s"),
|
" old MO code", ifelse(n_matched == 1, "", "s"),
|
||||||
" (", n_unique, "from another AMR package version). ",
|
" (", n_unique, "from a previous AMR package version). ",
|
||||||
n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
|
n_solved, " old MO code", ifelse(n_solved == 1, "", "s"),
|
||||||
ifelse(n_solved == 1, " was", " were"),
|
ifelse(n_solved == 1, " was", " were"),
|
||||||
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
ifelse(all_direct_matches, " updated ", font_bold(" guessed ")),
|
||||||
|
|||||||
@@ -47,7 +47,7 @@
|
|||||||
#' * \eqn{l_n} is the length of \eqn{n};
|
#' * \eqn{l_n} is the length of \eqn{n};
|
||||||
#' * \eqn{lev} is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance) (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change \eqn{x} into \eqn{n};
|
#' * \eqn{lev} is the [Levenshtein distance function](https://en.wikipedia.org/wiki/Levenshtein_distance) (counting any insertion as 1, and any deletion or substitution as 2) that is needed to change \eqn{x} into \eqn{n};
|
||||||
#' * \eqn{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
|
#' * \eqn{p_n} is the human pathogenic prevalence group of \eqn{n}, as described below;
|
||||||
#' * \eqn{k_n} is the taxonomic domain ('kingdom' until taxonomic reclassification of 2024) of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Chromista = 1.75, Archaea = 2, others = 3.
|
#' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 1.25, Protozoa = 1.5, Chromista = 1.75, Archaea = 2, others = 3.
|
||||||
#'
|
#'
|
||||||
#' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups:
|
#' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups:
|
||||||
#'
|
#'
|
||||||
@@ -122,8 +122,8 @@ mo_matching_score <- function(x, n) {
|
|||||||
|
|
||||||
# human pathogenic prevalence (1 to 3), see ?as.mo
|
# human pathogenic prevalence (1 to 3), see ?as.mo
|
||||||
p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
|
p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
|
||||||
# domain index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
|
# kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
|
||||||
k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "domain_index", drop = TRUE]
|
k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
|
||||||
|
|
||||||
# matching score:
|
# matching score:
|
||||||
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
|
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
|
||||||
|
|||||||
117
R/mo_property.R
117
R/mo_property.R
@@ -42,23 +42,21 @@
|
|||||||
#' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note about the renaming)
|
#' - `mo_ref("Enterobacter aerogenes")` will return `"Tindall et al., 2017"` (with a note about the renaming)
|
||||||
#' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a once-per-session warning that the name is outdated)
|
#' - `mo_ref("Enterobacter aerogenes", keep_synonyms = TRUE)` will return `"Hormaeche et al., 1960"` (with a once-per-session warning that the name is outdated)
|
||||||
#'
|
#'
|
||||||
#' [mo_ref()] returns the abbreviated authority of the nomenclatural act that created the queried name combination. When `keep_synonyms = FALSE` (default), this is the authority of the currently accepted name. When `keep_synonyms = TRUE`, this is the authority under which the queried (possibly outdated) name was published. Emendations (changes to the species description without a name change) are not reflected; only the combination or original description authority is returned.
|
#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will be considered *Escherichia coli*. As a result, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
|
||||||
#'
|
#'
|
||||||
#' The short name ([mo_shortname()]) returns the first character of the genus and the full species, such as `"E. coli"`, for species and subspecies. Exceptions are abbreviations of staphylococci (such as *"CoNS"*, Coagulase-Negative Staphylococci) and beta-haemolytic streptococci (such as *"GBS"*, Group B Streptococci). Please bear in mind that e.g. *E. coli* could mean *Escherichia coli* (kingdom of Bacteria) as well as *Entamoeba coli* (kingdom of Protozoa). Returning to the full name will be done using [as.mo()] internally, giving priority to bacteria and human pathogens, i.e. `"E. coli"` will always be considered *Escherichia coli*. As a result, `mo_fullname(mo_shortname("Entamoeba coli"))` returns `"Escherichia coli"`.
|
#' Since the top-level of the taxonomy is sometimes referred to as 'kingdom' and sometimes as 'domain', the functions [mo_kingdom()] and [mo_domain()] return the exact same results.
|
||||||
#'
|
|
||||||
#' Following the formal introduction of the new kingdom rank into prokaryotic nomenclature in 2024 (\doi{10.1099/ijsem.0.006242}), [mo_kingdom()] and [mo_domain()] return different results for bacteria and archaea: [mo_kingdom()] returns the new formal kingdom (e.g. "Pseudomonadati", "Bacillati"), while [mo_domain()] returns the new domain (e.g. "Bacteria", "Archaea"). For non-prokaryotic organisms, both functions return identical results.
|
|
||||||
#'
|
#'
|
||||||
#' Determination of human pathogenicity ([mo_pathogenicity()]) is strongly based on Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}). This function returns a [factor] with the levels *Pathogenic*, *Potentially pathogenic*, *Non-pathogenic*, and *Unknown*.
|
#' Determination of human pathogenicity ([mo_pathogenicity()]) is strongly based on Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}). This function returns a [factor] with the levels *Pathogenic*, *Potentially pathogenic*, *Non-pathogenic*, and *Unknown*.
|
||||||
#'
|
#'
|
||||||
#' Determination of the Gram stain ([mo_gramstain()] is based on the taxonomic kingdom and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318/)), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were later renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, [PMID 34694987](https://pubmed.ncbi.nlm.nih.gov/34694987/)). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
#' Determination of the Gram stain ([mo_gramstain()]) will be based on the taxonomic kingdom and phylum. Originally, Cavalier-Smith defined the so-called subkingdoms Negibacteria and Posibacteria (2002, [PMID 11837318](https://pubmed.ncbi.nlm.nih.gov/11837318/)), and only considered these phyla as Posibacteria: Actinobacteria, Chloroflexi, Firmicutes, and Tenericutes. These phyla were later renamed to Actinomycetota, Chloroflexota, Bacillota, and Mycoplasmatota (2021, [PMID 34694987](https://pubmed.ncbi.nlm.nih.gov/34694987/)). Bacteria in these phyla are considered Gram-positive in this `AMR` package, except for members of the class Negativicutes (within phylum Bacillota) which are Gram-negative. All other bacteria are considered Gram-negative. Species outside the kingdom of Bacteria will return a value `NA`. Functions [mo_is_gram_negative()] and [mo_is_gram_positive()] always return `TRUE` or `FALSE` (or `NA` when the input is `NA` or the MO code is `UNKNOWN`), thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
||||||
#'
|
#'
|
||||||
#' Determination of yeasts ([mo_is_yeast()]) is based on the taxonomic kingdom and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
|
#' Determination of yeasts ([mo_is_yeast()]) will be based on the taxonomic kingdom and class. *Budding yeasts* are yeasts that reproduce asexually through a process called budding, where a new cell develops from a small protrusion on the parent cell. Taxonomically, these are members of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes) or Pichiomycetes. *True yeasts* quite specifically refers to yeasts in the underlying order Saccharomycetales (such as *Saccharomyces cerevisiae*). Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes or Pichiomycetes, the function will return `TRUE`. It returns `FALSE` otherwise (or `NA` when the input is `NA` or the MO code is `UNKNOWN`).
|
||||||
#'
|
#'
|
||||||
#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) is based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antimicrobials).
|
#' Determination of intrinsic resistance ([mo_is_intrinsic_resistant()]) will be based on the [intrinsic_resistant] data set, which is based on `r format_eucast_version_nr(names(EUCAST_VERSION_EXPECTED_PHENOTYPES[1]))`. The [mo_is_intrinsic_resistant()] function can be vectorised over both argument `x` (input for microorganisms) and `ab` (input for antimicrobials).
|
||||||
#'
|
#'
|
||||||
#' Determination of both bacterial oxygen tolerance ([mo_oxygen_tolerance()]) and morphology ([mo_morphology()]) are based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicating an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
#' Determination of bacterial oxygen tolerance ([mo_oxygen_tolerance()]) will be based on BacDive, see *Source*. The function [mo_is_anaerobic()] only returns `TRUE` if the oxygen tolerance is `"anaerobe"`, indicting an obligate anaerobic species or genus. It always returns `FALSE` for species outside the taxonomic kingdom of Bacteria.
|
||||||
#'
|
#'
|
||||||
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) is used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
|
#' The function [mo_url()] will return the direct URL to the online database entry, which also shows the scientific reference of the concerned species. [This MycoBank URL](`r TAXONOMY_VERSION$MycoBank$url`) will be used for fungi wherever available , [this LPSN URL](`r TAXONOMY_VERSION$MycoBank$url`) for bacteria wherever available, and [this GBIF link](`r TAXONOMY_VERSION$GBIF$url`) otherwise.
|
||||||
#'
|
#'
|
||||||
#' SNOMED codes ([mo_snomed()]) was last updated on `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
|
#' SNOMED codes ([mo_snomed()]) was last updated on `r documentation_date(TAXONOMY_VERSION$SNOMED$accessed_date)`. See *Source* and the [microorganisms] data set for more info.
|
||||||
#'
|
#'
|
||||||
@@ -83,7 +81,6 @@
|
|||||||
#' @examples
|
#' @examples
|
||||||
#' # taxonomic tree -----------------------------------------------------------
|
#' # taxonomic tree -----------------------------------------------------------
|
||||||
#'
|
#'
|
||||||
#' mo_domain("Klebsiella pneumoniae")
|
|
||||||
#' mo_kingdom("Klebsiella pneumoniae")
|
#' mo_kingdom("Klebsiella pneumoniae")
|
||||||
#' mo_phylum("Klebsiella pneumoniae")
|
#' mo_phylum("Klebsiella pneumoniae")
|
||||||
#' mo_class("Klebsiella pneumoniae")
|
#' mo_class("Klebsiella pneumoniae")
|
||||||
@@ -93,8 +90,6 @@
|
|||||||
#' mo_species("Klebsiella pneumoniae")
|
#' mo_species("Klebsiella pneumoniae")
|
||||||
#' mo_subspecies("Klebsiella pneumoniae")
|
#' mo_subspecies("Klebsiella pneumoniae")
|
||||||
#'
|
#'
|
||||||
#' # all in one go
|
|
||||||
#' mo_taxonomy("Klebsiella pneumoniae")
|
|
||||||
#'
|
#'
|
||||||
#' # full names and short names -----------------------------------------------
|
#' # full names and short names -----------------------------------------------
|
||||||
#'
|
#'
|
||||||
@@ -105,17 +100,14 @@
|
|||||||
#'
|
#'
|
||||||
#' # other properties ---------------------------------------------------------
|
#' # other properties ---------------------------------------------------------
|
||||||
#'
|
#'
|
||||||
#' mo_morphology("Klebsiella pneumoniae")
|
|
||||||
#' mo_gramstain("Klebsiella pneumoniae")
|
|
||||||
#' mo_gramstain("Klebsiella pneumoniae", add_morphology = TRUE)
|
|
||||||
#' mo_pathogenicity("Klebsiella pneumoniae")
|
#' mo_pathogenicity("Klebsiella pneumoniae")
|
||||||
|
#' mo_gramstain("Klebsiella pneumoniae")
|
||||||
#' mo_snomed("Klebsiella pneumoniae")
|
#' mo_snomed("Klebsiella pneumoniae")
|
||||||
#' mo_type("Klebsiella pneumoniae")
|
#' mo_type("Klebsiella pneumoniae")
|
||||||
#' mo_rank("Klebsiella pneumoniae")
|
#' mo_rank("Klebsiella pneumoniae")
|
||||||
#' mo_url("Klebsiella pneumoniae")
|
#' mo_url("Klebsiella pneumoniae")
|
||||||
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
#' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
|
||||||
#'
|
#'
|
||||||
#' mo_group_members("Streptococcus group A")
|
|
||||||
#' mo_group_members(c(
|
#' mo_group_members(c(
|
||||||
#' "Streptococcus group A",
|
#' "Streptococcus group A",
|
||||||
#' "Streptococcus group C",
|
#' "Streptococcus group C",
|
||||||
@@ -159,7 +151,6 @@
|
|||||||
#'
|
#'
|
||||||
#' mo_fullname("Staph epidermidis")
|
#' mo_fullname("Staph epidermidis")
|
||||||
#' mo_fullname("Staph epidermidis", Becker = TRUE)
|
#' mo_fullname("Staph epidermidis", Becker = TRUE)
|
||||||
#'
|
|
||||||
#' mo_shortname("Staph epidermidis")
|
#' mo_shortname("Staph epidermidis")
|
||||||
#' mo_shortname("Staph epidermidis", Becker = TRUE)
|
#' mo_shortname("Staph epidermidis", Becker = TRUE)
|
||||||
#'
|
#'
|
||||||
@@ -168,7 +159,6 @@
|
|||||||
#'
|
#'
|
||||||
#' mo_fullname("Strep agalactiae")
|
#' mo_fullname("Strep agalactiae")
|
||||||
#' mo_fullname("Strep agalactiae", Lancefield = TRUE)
|
#' mo_fullname("Strep agalactiae", Lancefield = TRUE)
|
||||||
#'
|
|
||||||
#' mo_shortname("Strep agalactiae")
|
#' mo_shortname("Strep agalactiae")
|
||||||
#' mo_shortname("Strep agalactiae", Lancefield = TRUE)
|
#' mo_shortname("Strep agalactiae", Lancefield = TRUE)
|
||||||
#'
|
#'
|
||||||
@@ -181,10 +171,10 @@
|
|||||||
#' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
|
#' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
|
||||||
#' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
|
#' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
|
||||||
#'
|
#'
|
||||||
#' # mo_type is equal to mo_domain, but mo_domain will remain untranslated
|
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
|
||||||
#' mo_domain("Klebsiella pneumoniae")
|
#' mo_kingdom("Klebsiella pneumoniae")
|
||||||
#' mo_type("Klebsiella pneumoniae")
|
#' mo_type("Klebsiella pneumoniae")
|
||||||
#' mo_domain("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
|
#' mo_kingdom("Klebsiella pneumoniae", language = "zh") # Chinese, no effect
|
||||||
#' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
|
#' mo_type("Klebsiella pneumoniae", language = "zh") # Chinese, translated
|
||||||
#'
|
#'
|
||||||
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "de")
|
#' mo_fullname("S. pyogenes", Lancefield = TRUE, language = "de")
|
||||||
@@ -259,8 +249,8 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
|||||||
}
|
}
|
||||||
|
|
||||||
# get first char of genus and complete species in English
|
# get first char of genus and complete species in English
|
||||||
genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms, ...)
|
genera <- mo_genus(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||||
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms, ...)))
|
shortnames <- paste0(substr(genera, 1, 1), ". ", replace_empty(mo_species(x.mo, language = NULL, keep_synonyms = keep_synonyms)))
|
||||||
|
|
||||||
# exceptions for where no species is known
|
# exceptions for where no species is known
|
||||||
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
|
shortnames[shortnames %like% ".[.] spp[.]"] <- genera[shortnames %like% ".[.] spp[.]"]
|
||||||
@@ -272,7 +262,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
|||||||
# unknown species etc.
|
# unknown species etc.
|
||||||
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
|
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws2(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
|
||||||
|
|
||||||
shortnames[mo_rank(x.mo, keep_synonyms = TRUE, ...) %in% c("domain", "kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo[mo_rank(x.mo, keep_synonyms = TRUE, ...) %in% c("domain", "kingdom", "phylum", "class", "order", "family")], language = NULL, keep_synonyms = keep_synonyms, ...)
|
shortnames[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")] <- mo_name(x.mo[mo_rank(x.mo) %in% c("kingdom", "phylum", "class", "order", "family")], language = NULL, keep_synonyms = keep_synonyms)
|
||||||
|
|
||||||
shortnames[is.na(x.mo)] <- NA_character_
|
shortnames[is.na(x.mo)] <- NA_character_
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
@@ -389,18 +379,7 @@ mo_kingdom <- function(x, language = get_AMR_locale(), keep_synonyms = getOption
|
|||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
translate_into_language(mo_validate(x = x, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
||||||
for (new_kingdom in c("Archaea", "Bacteria")) {
|
|
||||||
if (any(mo_domain(x.mo) == new_kingdom, na.rm = TRUE) && message_not_thrown_before("mo_kingdom", new_kingdom, entire_session = TRUE)) {
|
|
||||||
message_(
|
|
||||||
"Since {.pkg AMR v3.1.0}, {.help [{.fun mo_kingdom}](AMR::mo_kingdom)} returns the taxonomic kingdom as defined by G\u00f6ker and Oren (2024), who formally introduced a new kingdom rank into prokaryotic nomenclature ({.href [DOI: 10.1099/ijsem.0.006242](https://doi.org/10.1099/ijsem.0.006242)}). ",
|
|
||||||
"{.strong The former kingdom of ", new_kingdom, "} was divided into four new kingdoms under the {.strong new domain of ", new_kingdom, "}. ",
|
|
||||||
"For the old behaviour, use {.help [{.fun mo_domain}](AMR::mo_domain)}. ",
|
|
||||||
"This note will be shown once per session."
|
|
||||||
)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
translate_into_language(mo_validate(x = x.mo, property = "kingdom", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname mo_property
|
#' @rdname mo_property
|
||||||
@@ -410,11 +389,7 @@ mo_domain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption(
|
|||||||
# this tries to find the data and an 'mo' column
|
# this tries to find the data and an 'mo' column
|
||||||
x <- find_mo_col(fn = "mo_domain")
|
x <- find_mo_col(fn = "mo_domain")
|
||||||
}
|
}
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
mo_kingdom(x = x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||||
language <- validate_language(language)
|
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
|
||||||
|
|
||||||
translate_into_language(mo_validate(x = x, property = "domain", language = language, keep_synonyms = keep_synonyms, ...), language = language, only_unknown = TRUE)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname mo_property
|
#' @rdname mo_property
|
||||||
@@ -429,8 +404,7 @@ mo_type <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
|||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||||
out <- mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
out <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||||
out <- gsub(" \\{.*\\}", "", out) # strip curly brackets
|
|
||||||
out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
|
out[which(mo_is_yeast(x.mo, keep_synonyms = keep_synonyms))] <- "Yeasts"
|
||||||
translate_into_language(out, language = language, only_unknown = FALSE)
|
translate_into_language(out, language = language, only_unknown = FALSE)
|
||||||
}
|
}
|
||||||
@@ -466,7 +440,7 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
|||||||
metadata <- get_mo_uncertainties()
|
metadata <- get_mo_uncertainties()
|
||||||
|
|
||||||
prev <- AMR_env$MO_lookup$prevalence[match(x.mo, AMR_env$MO_lookup$mo)]
|
prev <- AMR_env$MO_lookup$prevalence[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||||
kngd <- AMR_env$MO_lookup$domain[match(x.mo, AMR_env$MO_lookup$mo)]
|
kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||||
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||||
|
|
||||||
out <- factor(
|
out <- factor(
|
||||||
@@ -486,9 +460,8 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
|||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname mo_property
|
#' @rdname mo_property
|
||||||
#' @param add_morphology a [logical] to indicate whether the morphology (from [mo_morphology()]) should be added to the Gram stain result, e.g. `"Gram-negative rods"` instead of `"Gram-negative"`. The default is `FALSE`.
|
|
||||||
#' @export
|
#' @export
|
||||||
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), add_morphology = FALSE, ...) {
|
mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||||
if (missing(x)) {
|
if (missing(x)) {
|
||||||
# this tries to find the data and an 'mo' column
|
# this tries to find the data and an 'mo' column
|
||||||
x <- find_mo_col(fn = "mo_gramstain")
|
x <- find_mo_col(fn = "mo_gramstain")
|
||||||
@@ -496,14 +469,13 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
|||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
meet_criteria(add_morphology, allow_class = "logical", has_length = 1)
|
|
||||||
|
|
||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||||
metadata <- get_mo_uncertainties()
|
metadata <- get_mo_uncertainties()
|
||||||
|
|
||||||
x <- rep(NA_character_, length(x))
|
x <- rep(NA_character_, length(x))
|
||||||
# make all bacteria Gram negative
|
# make all bacteria Gram negative
|
||||||
x[mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
|
x[mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms) == "Bacteria"] <- "Gram-negative"
|
||||||
# overwrite these 4 phyla with Gram-positives
|
# overwrite these 4 phyla with Gram-positives
|
||||||
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
|
# Source: https://itis.gov/servlet/SingleRpt/SingleRpt?search_topic=TSN&search_value=956097 (Cavalier-Smith, 2002)
|
||||||
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
|
x[(mo_phylum(x.mo, language = NULL, keep_synonyms = keep_synonyms) %in% c(
|
||||||
@@ -522,12 +494,6 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
|
|||||||
# and of course our own ID for Gram-positives
|
# and of course our own ID for Gram-positives
|
||||||
| x.mo %in% c("B_GRAMP", "B_ANAER-POS")] <- "Gram-positive"
|
| x.mo %in% c("B_GRAMP", "B_ANAER-POS")] <- "Gram-positive"
|
||||||
|
|
||||||
if (isTRUE(add_morphology)) {
|
|
||||||
morphs <- mo_morphology(x.mo, language = NULL)
|
|
||||||
morphs[is.na(x)] <- ""
|
|
||||||
x[!is.na(x)] <- paste(x[!is.na(x)], tolower(morphs[!is.na(x)]))
|
|
||||||
}
|
|
||||||
|
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
translate_into_language(x, language = language, only_unknown = FALSE)
|
translate_into_language(x, language = language, only_unknown = FALSE)
|
||||||
}
|
}
|
||||||
@@ -586,12 +552,12 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
|||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||||
metadata <- get_mo_uncertainties()
|
metadata <- get_mo_uncertainties()
|
||||||
|
|
||||||
x.domain <- mo_domain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||||
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
|
||||||
|
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
|
|
||||||
out <- x.mo == "F_YEAST" | (x.domain == "Fungi" & x.class %in% c("Saccharomycetes", "Pichiomycetes"))
|
out <- x.mo == "F_YEAST" | (x.kingdom == "Fungi" & x.class %in% c("Saccharomycetes", "Pichiomycetes"))
|
||||||
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
|
||||||
out
|
out
|
||||||
}
|
}
|
||||||
@@ -668,21 +634,6 @@ mo_is_anaerobic <- function(x, language = get_AMR_locale(), keep_synonyms = getO
|
|||||||
out
|
out
|
||||||
}
|
}
|
||||||
|
|
||||||
#' @rdname mo_property
|
|
||||||
#' @export
|
|
||||||
mo_morphology <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
|
||||||
if (missing(x)) {
|
|
||||||
# this tries to find the data and an 'mo' column
|
|
||||||
x <- find_mo_col(fn = "mo_morphology")
|
|
||||||
}
|
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
|
||||||
language <- validate_language(language)
|
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
|
||||||
|
|
||||||
out <- mo_validate(x = x, property = "morphology", language = language, keep_synonyms = keep_synonyms, ...)
|
|
||||||
gsub("^(\\w)", "\\U\\1", out, perl = TRUE)
|
|
||||||
}
|
|
||||||
|
|
||||||
#' @rdname mo_property
|
#' @rdname mo_property
|
||||||
#' @export
|
#' @export
|
||||||
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
mo_snomed <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
|
||||||
@@ -813,19 +764,18 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
|||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||||
metadata <- get_mo_uncertainties()
|
metadata <- get_mo_uncertainties()
|
||||||
|
|
||||||
out <- list(
|
out <- list(
|
||||||
domain = mo_domain(x.mo, language = language, keep_synonyms = keep_synonyms),
|
kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
kingdom = suppressMessages(mo_kingdom(x.mo, language = language, keep_synonyms = keep_synonyms)),
|
phylum = mo_phylum(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
phylum = mo_phylum(x.mo, language = language, keep_synonyms = keep_synonyms),
|
class = mo_class(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
class = mo_class(x.mo, language = language, keep_synonyms = keep_synonyms),
|
order = mo_order(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
order = mo_order(x.mo, language = language, keep_synonyms = keep_synonyms),
|
family = mo_family(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
family = mo_family(x.mo, language = language, keep_synonyms = keep_synonyms),
|
genus = mo_genus(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
genus = mo_genus(x.mo, language = language, keep_synonyms = keep_synonyms),
|
species = mo_species(x, language = language, keep_synonyms = keep_synonyms),
|
||||||
species = mo_species(x.mo, language = language, keep_synonyms = keep_synonyms),
|
subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
|
||||||
subspecies = mo_subspecies(x.mo, language = language, keep_synonyms = keep_synonyms)
|
|
||||||
)
|
)
|
||||||
|
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
@@ -935,7 +885,6 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
|
|||||||
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
|
status = mo_status(y, language = language, keep_synonyms = keep_synonyms),
|
||||||
synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
|
synonyms = mo_synonyms(y, keep_synonyms = keep_synonyms),
|
||||||
gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
|
gramstain = mo_gramstain(y, language = language, keep_synonyms = keep_synonyms),
|
||||||
morphology = mo_morphology(y, language = language, keep_synonyms = keep_synonyms),
|
|
||||||
oxygen_tolerance = mo_oxygen_tolerance(y, language = language, keep_synonyms = keep_synonyms),
|
oxygen_tolerance = mo_oxygen_tolerance(y, language = language, keep_synonyms = keep_synonyms),
|
||||||
url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
|
url = unname(mo_url(y, open = FALSE, keep_synonyms = keep_synonyms)),
|
||||||
ref = mo_ref(y, keep_synonyms = keep_synonyms),
|
ref = mo_ref(y, keep_synonyms = keep_synonyms),
|
||||||
@@ -1029,11 +978,11 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
|||||||
|
|
||||||
dots <- list(...)
|
dots <- list(...)
|
||||||
Becker <- dots$Becker
|
Becker <- dots$Becker
|
||||||
if (is.null(Becker) || property %in% c("domain", "kingdom", "phylum", "class", "order", "family", "genus")) {
|
if (is.null(Becker) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||||
Becker <- FALSE
|
Becker <- FALSE
|
||||||
}
|
}
|
||||||
Lancefield <- dots$Lancefield
|
Lancefield <- dots$Lancefield
|
||||||
if (is.null(Lancefield) || property %in% c("domain", "kingdom", "phylum", "class", "order", "family", "genus")) {
|
if (is.null(Lancefield) || property %in% c("kingdom", "phylum", "class", "order", "family", "genus")) {
|
||||||
Lancefield <- FALSE
|
Lancefield <- FALSE
|
||||||
}
|
}
|
||||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
|
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
|
||||||
|
|||||||
@@ -482,7 +482,7 @@ scale_x_sir <- function(colours_SIR = c(
|
|||||||
R = "#ED553B"
|
R = "#ED553B"
|
||||||
),
|
),
|
||||||
language = get_AMR_locale(),
|
language = get_AMR_locale(),
|
||||||
eucast_I = getOption("AMR_guideline", "EUCAST") %like% "EUCAST",
|
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
|
||||||
...) {
|
...) {
|
||||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
@@ -499,7 +499,7 @@ scale_colour_sir <- function(colours_SIR = c(
|
|||||||
R = "#ED553B"
|
R = "#ED553B"
|
||||||
),
|
),
|
||||||
language = get_AMR_locale(),
|
language = get_AMR_locale(),
|
||||||
eucast_I = getOption("AMR_guideline", "EUCAST") %like% "EUCAST",
|
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
|
||||||
...) {
|
...) {
|
||||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
@@ -528,7 +528,7 @@ scale_fill_sir <- function(colours_SIR = c(
|
|||||||
R = "#ED553B"
|
R = "#ED553B"
|
||||||
),
|
),
|
||||||
language = get_AMR_locale(),
|
language = get_AMR_locale(),
|
||||||
eucast_I = getOption("AMR_guideline", "EUCAST") %like% "EUCAST",
|
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
|
||||||
...) {
|
...) {
|
||||||
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
|
|||||||
12
R/proportion.R
Executable file → Normal file
12
R/proportion.R
Executable file → Normal file
@@ -100,7 +100,7 @@
|
|||||||
#' ```
|
#' ```
|
||||||
#'
|
#'
|
||||||
#' Using `only_all_tested` has no impact when only using one antibiotic as input.
|
#' Using `only_all_tested` has no impact when only using one antibiotic as input.
|
||||||
#' @references **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
#' @source **M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 5th Edition**, 2022, *Clinical and Laboratory Standards Institute (CLSI)*. <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||||
#' @seealso [AMR::count()] to count resistant and susceptible isolates.
|
#' @seealso [AMR::count()] to count resistant and susceptible isolates.
|
||||||
#' @return A [double] or, when `as_percent = TRUE`, a [character].
|
#' @return A [double] or, when `as_percent = TRUE`, a [character].
|
||||||
#' @rdname proportion
|
#' @rdname proportion
|
||||||
@@ -236,11 +236,6 @@ resistance <- function(...,
|
|||||||
only_all_tested = FALSE,
|
only_all_tested = FALSE,
|
||||||
guideline = getOption("AMR_guideline", "EUCAST")) {
|
guideline = getOption("AMR_guideline", "EUCAST")) {
|
||||||
# other arguments for meet_criteria are handled by sir_calc()
|
# other arguments for meet_criteria are handled by sir_calc()
|
||||||
if (guideline %like% "EUCAST") {
|
|
||||||
guideline <- "EUCAST"
|
|
||||||
} else if (guideline %like% "CLSI") {
|
|
||||||
guideline <- "CLSI"
|
|
||||||
}
|
|
||||||
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
||||||
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("resistance", "eucast_default", entire_session = TRUE)) {
|
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("resistance", "eucast_default", entire_session = TRUE)) {
|
||||||
message_("{.help [{.fun resistance}](AMR::resistance)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
message_("{.help [{.fun resistance}](AMR::resistance)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
||||||
@@ -269,11 +264,6 @@ susceptibility <- function(...,
|
|||||||
only_all_tested = FALSE,
|
only_all_tested = FALSE,
|
||||||
guideline = getOption("AMR_guideline", "EUCAST")) {
|
guideline = getOption("AMR_guideline", "EUCAST")) {
|
||||||
# other arguments for meet_criteria are handled by sir_calc()
|
# other arguments for meet_criteria are handled by sir_calc()
|
||||||
if (guideline %like% "EUCAST") {
|
|
||||||
guideline <- "EUCAST"
|
|
||||||
} else if (guideline %like% "CLSI") {
|
|
||||||
guideline <- "CLSI"
|
|
||||||
}
|
|
||||||
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
meet_criteria(guideline, allow_class = "character", is_in = c("EUCAST", "CLSI"), has_length = 1)
|
||||||
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("susceptibility", "eucast_default", entire_session = TRUE)) {
|
if (is.null(getOption("AMR_guideline")) && missing(guideline) && message_not_thrown_before("susceptibility", "eucast_default", entire_session = TRUE)) {
|
||||||
message_("{.help [{.fun susceptibility}](AMR::susceptibility)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
message_("{.help [{.fun susceptibility}](AMR::susceptibility)} assumes the EUCAST guideline and thus considers the 'I' category susceptible. Set the {.arg guideline} argument or the {.code AMR_guideline} option to either \"CLSI\" or \"EUCAST\", see {.topic [AMR-options](AMR::AMR-options)}.")
|
||||||
|
|||||||
32
R/sir.R
32
R/sir.R
@@ -73,7 +73,6 @@ VALID_SIR_LEVELS <- c("S", "SDD", "I", "R", "NI", "WT", "NWT", "NS")
|
|||||||
#' @param threshold Maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*.
|
#' @param threshold Maximum fraction of invalid antimicrobial interpretations of `x`, see *Examples*.
|
||||||
#' @param conserve_capped_values Deprecated, use `capped_mic_handling` instead.
|
#' @param conserve_capped_values Deprecated, use `capped_mic_handling` instead.
|
||||||
#' @param ... For using on a [data.frame]: selection of columns to apply `as.sir()` to. Supports [tidyselect language][tidyselect::starts_with()] such as `where(is.mic)`, `starts_with(...)`, or `column1:column4`, and can thus also be [antimicrobial selectors][amr_selector()], e.g. `as.sir(df, penicillins())`.
|
#' @param ... For using on a [data.frame]: selection of columns to apply `as.sir()` to. Supports [tidyselect language][tidyselect::starts_with()] such as `where(is.mic)`, `starts_with(...)`, or `column1:column4`, and can thus also be [antimicrobial selectors][amr_selector()], e.g. `as.sir(df, penicillins())`.
|
||||||
#' @param enforce_method A [character] string to force interpretation as a specific method, useful when the S3 class of `x` is lost (e.g., when called from Python via rpy2). Must be one of `"auto"` (default), `"mic"`, or `"disk"`.
|
|
||||||
#'
|
#'
|
||||||
#' Otherwise: arguments passed on to methods.
|
#' Otherwise: arguments passed on to methods.
|
||||||
#' @details
|
#' @details
|
||||||
@@ -176,7 +175,7 @@ VALID_SIR_LEVELS <- c("S", "SDD", "I", "R", "NI", "WT", "NWT", "NS")
|
|||||||
#' @aliases sir
|
#' @aliases sir
|
||||||
#' @export
|
#' @export
|
||||||
#' @seealso [as.mic()], [as.disk()], [as.mo()]
|
#' @seealso [as.mic()], [as.disk()], [as.mo()]
|
||||||
#' @references
|
#' @source
|
||||||
#' For interpretations of minimum inhibitory concentration (MIC) values and disk diffusion diameters:
|
#' For interpretations of minimum inhibitory concentration (MIC) values and disk diffusion diameters:
|
||||||
#'
|
#'
|
||||||
#' - **CLSI M39: Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data**, `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`, *Clinical and Laboratory Standards Institute* (CLSI). <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
#' - **CLSI M39: Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data**, `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, guideline %like% "CLSI")$guideline)))`, *Clinical and Laboratory Standards Institute* (CLSI). <https://clsi.org/standards/products/microbiology/documents/m39/>.
|
||||||
@@ -386,15 +385,8 @@ VALID_SIR_LEVELS <- c("S", "SDD", "I", "R", "NI", "WT", "NWT", "NS")
|
|||||||
#' # mutate(across(where(is_sir_eligible), as.sir))
|
#' # mutate(across(where(is_sir_eligible), as.sir))
|
||||||
#' }
|
#' }
|
||||||
#' }
|
#' }
|
||||||
as.sir <- function(x, ..., enforce_method = "auto") {
|
as.sir <- function(x, ...) {
|
||||||
meet_criteria(enforce_method, allow_class = "character", has_length = 1, is_in = c("auto", "mic", "disk"))
|
UseMethod("as.sir")
|
||||||
if (enforce_method == "mic") {
|
|
||||||
as.sir.mic(x, ...)
|
|
||||||
} else if (enforce_method == "disk") {
|
|
||||||
as.sir.disk(x, ...)
|
|
||||||
} else {
|
|
||||||
UseMethod("as.sir")
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
as_sir_structure <- function(x,
|
as_sir_structure <- function(x,
|
||||||
@@ -533,7 +525,7 @@ as.sir.default <- function(x,
|
|||||||
} else if (!all(is.na(x)) && !identical(levels(x), VALID_SIR_LEVELS) && !all(x %in% c(VALID_SIR_LEVELS, NA))) {
|
} else if (!all(is.na(x)) && !identical(levels(x), VALID_SIR_LEVELS) && !all(x %in% c(VALID_SIR_LEVELS, NA))) {
|
||||||
if (all(x %unlike% "(S|I|R)", na.rm = TRUE) && !all(x %in% c(1, 2, 3, 4, 5), na.rm = TRUE)) {
|
if (all(x %unlike% "(S|I|R)", na.rm = TRUE) && !all(x %in% c(1, 2, 3, 4, 5), na.rm = TRUE)) {
|
||||||
# check if they are actually MICs or disks
|
# check if they are actually MICs or disks
|
||||||
if (all_valid_mics(x) && !(all_valid_disks(x) && identical(x, tryCatch(floor(x), error = function(e) NULL)))) {
|
if (all_valid_mics(x)) {
|
||||||
warning_("in {.help [{.fun as.sir}](AMR::as.sir)}: input values were guessed to be MIC values - preferably transform them with {.help [{.fun as.mic}](AMR::as.mic)} before running {.help [{.fun as.sir}](AMR::as.sir)}.")
|
warning_("in {.help [{.fun as.sir}](AMR::as.sir)}: input values were guessed to be MIC values - preferably transform them with {.help [{.fun as.mic}](AMR::as.mic)} before running {.help [{.fun as.sir}](AMR::as.sir)}.")
|
||||||
return(as.sir(as.mic(x), ...))
|
return(as.sir(as.mic(x), ...))
|
||||||
} else if (all_valid_disks(x)) {
|
} else if (all_valid_disks(x)) {
|
||||||
@@ -1662,7 +1654,7 @@ as_sir_method <- function(method_short,
|
|||||||
mo_current_other <- structure("UNKNOWN", class = c("mo", "character"))
|
mo_current_other <- structure("UNKNOWN", class = c("mo", "character"))
|
||||||
# formatted for notes
|
# formatted for notes
|
||||||
mo_formatted <- mo_current_name
|
mo_formatted <- mo_current_name
|
||||||
if (!mo_current_rank %in% c("domain", "kingdom", "phylum", "class", "order")) {
|
if (!mo_current_rank %in% c("kingdom", "phylum", "class", "order")) {
|
||||||
mo_formatted <- font_italic(mo_formatted, collapse = NULL)
|
mo_formatted <- font_italic(mo_formatted, collapse = NULL)
|
||||||
}
|
}
|
||||||
ab_formatted <- paste0(
|
ab_formatted <- paste0(
|
||||||
@@ -2119,7 +2111,7 @@ pillar_shaft.sir <- function(x, ...) {
|
|||||||
out[is.na(x)] <- pillar::style_subtle(" NA")
|
out[is.na(x)] <- pillar::style_subtle(" NA")
|
||||||
out[x == "S"] <- font_green_bg(" S ") # has font_black internally
|
out[x == "S"] <- font_green_bg(" S ") # has font_black internally
|
||||||
out[x == "SDD"] <- font_green_lighter_bg(" SDD ") # has font_black internally
|
out[x == "SDD"] <- font_green_lighter_bg(" SDD ") # has font_black internally
|
||||||
if (getOption("AMR_guideline", "EUCAST")[1] %like% "EUCAST") {
|
if (getOption("AMR_guideline", "EUCAST")[1] == "EUCAST") {
|
||||||
out[x == "I"] <- font_green_lighter_bg(" I ") # has font_black internally
|
out[x == "I"] <- font_green_lighter_bg(" I ") # has font_black internally
|
||||||
} else {
|
} else {
|
||||||
out[x == "I"] <- font_orange_bg(" I ") # has font_black internally
|
out[x == "I"] <- font_orange_bg(" I ") # has font_black internally
|
||||||
@@ -2300,12 +2292,12 @@ c.sir <- function(...) {
|
|||||||
lst <- list(...)
|
lst <- list(...)
|
||||||
|
|
||||||
# TODO for #170
|
# TODO for #170
|
||||||
# guideline <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$guideline %||% NA_character_)
|
# guideline <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$guideline %or% NA_character_)
|
||||||
# mo <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$mo %||% NA_character_)
|
# mo <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$mo %or% NA_character_)
|
||||||
# ab <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ab %||% NA_character_)
|
# ab <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ab %or% NA_character_)
|
||||||
# method <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$method %||% NA_character_)
|
# method <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$method %or% NA_character_)
|
||||||
# ref_tbl <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_tbl %||% NA_character_)
|
# ref_tbl <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_tbl %or% NA_character_)
|
||||||
# ref_breakpoints <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_breakpoints %||% NA_character_)
|
# ref_breakpoints <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_breakpoints %or% NA_character_)
|
||||||
|
|
||||||
out <- as.sir(unlist(lapply(list(...), as.character)))
|
out <- as.sir(unlist(lapply(list(...), as.character)))
|
||||||
|
|
||||||
|
|||||||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
0
R/tidymodels.R
Executable file → Normal file
0
R/tidymodels.R
Executable file → Normal file
@@ -29,88 +29,73 @@
|
|||||||
|
|
||||||
#' Filter Top *n* Microorganisms
|
#' Filter Top *n* Microorganisms
|
||||||
#'
|
#'
|
||||||
#' Filters a data set to include only the top *n* microorganisms based on a specified property, such as taxonomic family or genus. For example, it can filter a data set to the top 3 species, to any species in the top 5 genera, or to the top 3 species in each of the top 5 genera.
|
#' This function filters a data set to include only the top *n* microorganisms based on a specified property, such as taxonomic family or genus. For example, it can filter a data set to the top 3 species, or to any species in the top 5 genera, or to the top 3 species in each of the top 5 genera.
|
||||||
#' @param x A data frame containing microbial data.
|
#' @param x A data frame containing microbial data.
|
||||||
#' @param n A positive whole number specifying the maximum number of unique values of `property` to include in the output.
|
#' @param n An integer specifying the maximum number of unique values of the `property` to include in the output.
|
||||||
#' @param property A character string indicating the microorganism property to use for filtering. Must be one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. If `NULL`, the raw values from `col_mo` will be used without transformation. When using `"species"` (default) or `"subspecies"`, the genus is prepended to ensure each name is unambiguous.
|
#' @param property A character string indicating the microorganism property to use for filtering. Must be one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, documentation = TRUE)`. If `NULL`, the raw values from `col_mo` will be used without transformation. When using `"species"` (default) or `"subpecies"`, the genus will be added to make sure each (sub)species still belongs to the right genus.
|
||||||
#' @param n_for_each An optional positive whole number specifying the maximum number of distinct microorganism groups at the level of `property_for_each` to retain within each of the top *n* groups. Only used when `property_for_each` is also set.
|
#' @param n_for_each An optional integer specifying the maximum number of rows to retain for each value of the selected property. If `NULL`, all rows within the top *n* groups will be included.
|
||||||
#' @param property_for_each The microorganism property to use for sub-grouping within each top *n* group. Must be one of the column names of the [microorganisms] data set and at a strictly lower taxonomic rank than `property` (allowed order: domain > kingdom > phylum > class > order > family > genus > species > subspecies). Defaults to `"species"`. Only relevant when `n_for_each` is set.
|
|
||||||
#' @param col_mo A character string indicating the column in `x` that contains microorganism names or codes. Defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
#' @param col_mo A character string indicating the column in `x` that contains microorganism names or codes. Defaults to the first column of class [`mo`]. Values will be coerced using [as.mo()].
|
||||||
#' @param ... Additional arguments passed on to [mo_property()] when `property` is not `NULL`.
|
#' @param ... Additional arguments passed on to [mo_property()] when `property` is not `NULL`.
|
||||||
#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data.
|
#' @details This function is useful for preprocessing data before creating [antibiograms][antibiogram()] or other analyses that require focused subsets of microbial data. For example, it can filter a data set to only include isolates from the top 10 species.
|
||||||
#' @export
|
#' @export
|
||||||
#' @seealso [mo_property()], [as.mo()], [antibiogram()]
|
#' @seealso [mo_property()], [as.mo()], [antibiogram()]
|
||||||
#' @examples
|
#' @examples
|
||||||
#' # filter to the top 3 species:
|
#' # filter to the top 3 species:
|
||||||
#' top_n_microorganisms(example_isolates, n = 3)
|
#' top_n_microorganisms(example_isolates,
|
||||||
|
#' n = 3
|
||||||
|
#' )
|
||||||
#'
|
#'
|
||||||
#' # filter to any species in the top 5 genera:
|
#' # filter to any species in the top 5 genera:
|
||||||
#' top_n_microorganisms(example_isolates, n = 5, property = "genus")
|
#' top_n_microorganisms(example_isolates,
|
||||||
|
#' n = 5, property = "genus"
|
||||||
|
#' )
|
||||||
#'
|
#'
|
||||||
#' # filter to the top 3 species in each of the top 5 genera:
|
#' # filter to the top 3 species in each of the top 5 genera:
|
||||||
#' top_n_microorganisms(example_isolates,
|
#' top_n_microorganisms(example_isolates,
|
||||||
#' n = 5, property = "genus", n_for_each = 3
|
#' n = 5, property = "genus", n_for_each = 3
|
||||||
#' )
|
#' )
|
||||||
#'
|
top_n_microorganisms <- function(x, n, property = "species", n_for_each = NULL, col_mo = NULL, ...) {
|
||||||
#' # filter to the top 2 genera in each of the top 3 families:
|
|
||||||
#' top_n_microorganisms(example_isolates,
|
|
||||||
#' n = 3, property = "family", n_for_each = 2, property_for_each = "genus"
|
|
||||||
#' )
|
|
||||||
top_n_microorganisms <- function(x, n, property = "species", n_for_each = NULL, property_for_each = "species", col_mo = NULL, ...) {
|
|
||||||
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
meet_criteria(x, allow_class = "data.frame") # also checks dimensions to be >0
|
||||||
meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
|
meet_criteria(n, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE)
|
||||||
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms), allow_NULL = TRUE)
|
meet_criteria(property, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms))
|
||||||
meet_criteria(n_for_each, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE, allow_NULL = TRUE)
|
meet_criteria(n_for_each, allow_class = c("numeric", "integer"), has_length = 1, is_finite = TRUE, is_positive = TRUE, allow_NULL = TRUE)
|
||||||
meet_criteria(property_for_each, allow_class = "character", has_length = 1, is_in = colnames(AMR::microorganisms), allow_NULL = TRUE)
|
|
||||||
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
meet_criteria(col_mo, allow_class = "character", has_length = 1, allow_NULL = TRUE, is_in = colnames(x))
|
||||||
|
|
||||||
if (is.null(col_mo)) {
|
if (is.null(col_mo)) {
|
||||||
col_mo <- search_type_in_df(x = x, type = "mo", info = TRUE)
|
col_mo <- search_type_in_df(x = x, type = "mo", info = TRUE)
|
||||||
stop_if(is.null(col_mo), "{.arg col_mo} must be set")
|
stop_if(is.null(col_mo), "{.arg col_mo} must be set")
|
||||||
}
|
}
|
||||||
|
|
||||||
.taxonomic_ranks <- c("domain", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies")
|
|
||||||
if (!is.null(n_for_each) && !is.null(property) && !is.null(property_for_each)) {
|
|
||||||
prop_rank <- match(property, .taxonomic_ranks)
|
|
||||||
each_rank <- match(property_for_each, .taxonomic_ranks)
|
|
||||||
if (!is.na(prop_rank) && !is.na(each_rank) && each_rank <= prop_rank) {
|
|
||||||
stop_(
|
|
||||||
"`property_for_each` (\"", property_for_each, "\") must be at a lower ",
|
|
||||||
"taxonomic rank than `property` (\"", property, "\")"
|
|
||||||
)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
x.bak <- x
|
x.bak <- x
|
||||||
|
|
||||||
x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE)
|
x[, col_mo] <- as.mo(x[, col_mo, drop = TRUE], keep_synonyms = TRUE)
|
||||||
|
|
||||||
get_prop_val <- function(prop) {
|
if (is.null(property)) {
|
||||||
if (is.null(prop)) {
|
x$prop_val <- x[[col_mo]]
|
||||||
x[[col_mo]]
|
} else if (property == "species") {
|
||||||
} else if (prop == "species") {
|
x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...))
|
||||||
paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...))
|
} else if (property == "subspecies") {
|
||||||
} else if (prop == "subspecies") {
|
x$prop_val <- paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...), mo_subspecies(x[[col_mo]], ...))
|
||||||
paste(mo_genus(x[[col_mo]], ...), mo_species(x[[col_mo]], ...), mo_subspecies(x[[col_mo]], ...))
|
} else {
|
||||||
} else {
|
x$prop_val <- mo_property(x[[col_mo]], property = property, ...)
|
||||||
mo_property(x[[col_mo]], property = prop, ...)
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
x$prop_val <- get_prop_val(property)
|
|
||||||
counts <- sort(table(x$prop_val), decreasing = TRUE)
|
counts <- sort(table(x$prop_val), decreasing = TRUE)
|
||||||
n <- min(as.integer(n), length(counts))
|
|
||||||
filtered_rows <- which(x$prop_val %in% names(counts)[seq_len(n)])
|
n <- as.integer(n)
|
||||||
|
if (length(counts) < n) {
|
||||||
|
n <- length(counts)
|
||||||
|
}
|
||||||
|
count_values <- names(counts)[seq_len(n)]
|
||||||
|
filtered_rows <- which(x$prop_val %in% count_values)
|
||||||
|
|
||||||
if (!is.null(n_for_each)) {
|
if (!is.null(n_for_each)) {
|
||||||
n_for_each <- as.integer(n_for_each)
|
n_for_each <- as.integer(n_for_each)
|
||||||
x$prop_val_each <- get_prop_val(property_for_each)
|
|
||||||
filtered_x <- x[filtered_rows, , drop = FALSE]
|
filtered_x <- x[filtered_rows, , drop = FALSE]
|
||||||
filtered_x$.orig_row <- filtered_rows
|
|
||||||
filtered_rows <- do.call(
|
filtered_rows <- do.call(
|
||||||
c,
|
c,
|
||||||
lapply(split(filtered_x, filtered_x$prop_val), function(group) {
|
lapply(split(filtered_x, filtered_x$prop_val), function(group) {
|
||||||
top_each <- names(sort(table(group$prop_val_each), decreasing = TRUE)[seq_len(n_for_each)])
|
top_values <- names(sort(table(group[[col_mo]]), decreasing = TRUE)[seq_len(n_for_each)])
|
||||||
group$.orig_row[group$prop_val_each %in% top_each[!is.na(top_each)]]
|
top_values <- top_values[!is.na(top_values)]
|
||||||
|
which(x[[col_mo]] %in% top_values)
|
||||||
})
|
})
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -31,7 +31,7 @@
|
|||||||
#'
|
#'
|
||||||
#' All antimicrobial drugs and their official names, ATC codes, ATC groups and defined daily dose (DDD) are included in this package, using the WHO Collaborating Centre for Drug Statistics Methodology.
|
#' All antimicrobial drugs and their official names, ATC codes, ATC groups and defined daily dose (DDD) are included in this package, using the WHO Collaborating Centre for Drug Statistics Methodology.
|
||||||
#' @section WHOCC:
|
#' @section WHOCC:
|
||||||
#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/index_en.htm>).
|
#' This package contains **all ~550 antibiotic, antimycotic and antiviral drugs** and their Anatomical Therapeutic Chemical (ATC) codes, ATC groups and Defined Daily Dose (DDD) from the World Health Organization Collaborating Centre for Drug Statistics Methodology (WHOCC, <https://atcddd.fhi.no>) and the Pharmaceuticals Community Register of the European Commission (<https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>).
|
||||||
#'
|
#'
|
||||||
#' These have become the gold standard for international drug utilisation monitoring and research.
|
#' These have become the gold standard for international drug utilisation monitoring and research.
|
||||||
#'
|
#'
|
||||||
|
|||||||
@@ -70,13 +70,6 @@ as.data.frame.deprecated_amr_dataset <- function(x, ...) {
|
|||||||
# - `antibiotics` in `antibiogram()`
|
# - `antibiotics` in `antibiogram()`
|
||||||
# - `converse_capped_values` in `as.sir()`
|
# - `converse_capped_values` in `as.sir()`
|
||||||
|
|
||||||
#' @rdname AMR-deprecated
|
|
||||||
#' @export
|
|
||||||
custom_eucast_rules <- function(...) {
|
|
||||||
deprecation_warning("custom_eucast_rules", "custom_interpretive_rules", is_function = TRUE)
|
|
||||||
custom_interpretive_rules(...)
|
|
||||||
}
|
|
||||||
|
|
||||||
#' @rdname AMR-deprecated
|
#' @rdname AMR-deprecated
|
||||||
#' @export
|
#' @export
|
||||||
ab_class <- function(...) {
|
ab_class <- function(...) {
|
||||||
|
|||||||
8
R/zzz.R
8
R/zzz.R
@@ -86,10 +86,10 @@ AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
|
|||||||
AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
|
AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
|
||||||
|
|
||||||
# take cli symbols and error function if available
|
# take cli symbols and error function if available
|
||||||
AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %||% "*"
|
AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
|
||||||
AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %||% "..."
|
AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
|
||||||
AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %||% "i"
|
AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
|
||||||
AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %||% "*"
|
AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
|
||||||
AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
|
AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
|
||||||
AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
|
AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
|
||||||
|
|
||||||
|
|||||||
@@ -11,7 +11,6 @@ knitr::opts_chunk$set(
|
|||||||
# fig.path = "man/figures/README-",
|
# fig.path = "man/figures/README-",
|
||||||
out.width = "100%"
|
out.width = "100%"
|
||||||
)
|
)
|
||||||
options(width = 100)
|
|
||||||
AMR:::reset_all_thrown_messages()
|
AMR:::reset_all_thrown_messages()
|
||||||
```
|
```
|
||||||
|
|
||||||
@@ -22,8 +21,8 @@ Please visit our comprehensive package website <https://amr-for-r.org> to read m
|
|||||||
Overview:
|
Overview:
|
||||||
|
|
||||||
* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach
|
* Provides an **all-in-one solution** for antimicrobial resistance (AMR) data analysis in a One Health approach
|
||||||
* **Peer-reviewed**, used in over 175 countries, cited over 100 times, available in `r length(AMR:::LANGUAGES_SUPPORTED)` languages
|
* Peer-reviewed, used in over 175 countries, available in `r length(AMR:::LANGUAGES_SUPPORTED)` languages
|
||||||
* Generates **antibiograms** - WISCA for empiric coverage estimates, or traditional/syndromic for AMR surveillance
|
* Generates **antibiograms** - traditional, combined, syndromic, and even WISCA
|
||||||
* Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs
|
* Provides the **full microbiological taxonomy** of `r AMR:::format_included_data_number(AMR::microorganisms)` distinct species and extensive info of `r AMR:::format_included_data_number(NROW(AMR::antimicrobials) + NROW(AMR::antivirals))` antimicrobial drugs
|
||||||
* Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation
|
* Applies **CLSI `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("CLSI", guideline))$guideline)))`** and **EUCAST `r min(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(AMR::clinical_breakpoints, grepl("EUCAST", guideline))$guideline)))`** clinical and veterinary breakpoints, and ECOFFs, for MIC and disk zone interpretation
|
||||||
* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class
|
* Corrects for duplicate isolates, **calculates** and **predicts** AMR per antimicrobial class
|
||||||
@@ -32,9 +31,7 @@ Overview:
|
|||||||
|
|
||||||
----
|
----
|
||||||
|
|
||||||
The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods.
|
The `AMR` package is a peer-reviewed, free and open-source R package with zero dependencies to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
||||||
|
|
||||||
**Our aim has always been to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
|
|
||||||
|
|
||||||
The `AMR` package supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
The `AMR` package supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl) and the [University Medical Center Groningen](https://www.umcg.nl).
|
||||||
|
|
||||||
|
|||||||
18
README.md
18
README.md
@@ -10,11 +10,10 @@ Overview:
|
|||||||
|
|
||||||
- Provides an **all-in-one solution** for antimicrobial resistance (AMR)
|
- Provides an **all-in-one solution** for antimicrobial resistance (AMR)
|
||||||
data analysis in a One Health approach
|
data analysis in a One Health approach
|
||||||
- **Peer-reviewed**, used in over 175 countries, cited over 100 times,
|
- Peer-reviewed, used in over 175 countries, available in 28 languages
|
||||||
available in 28 languages
|
- Generates **antibiograms** - traditional, combined, syndromic, and
|
||||||
- Generates **antibiograms** - WISCA for empiric coverage estimates, or
|
even WISCA
|
||||||
traditional/syndromic for AMR surveillance
|
- Provides the **full microbiological taxonomy** of ~79 000 distinct
|
||||||
- Provides the **full microbiological taxonomy** of ~97 000 distinct
|
|
||||||
species and extensive info of ~620 antimicrobial drugs
|
species and extensive info of ~620 antimicrobial drugs
|
||||||
- Applies **CLSI 2011-2026** and **EUCAST 2011-2026** clinical and
|
- Applies **CLSI 2011-2026** and **EUCAST 2011-2026** clinical and
|
||||||
veterinary breakpoints, and ECOFFs, for MIC and disk zone
|
veterinary breakpoints, and ECOFFs, for MIC and disk zone
|
||||||
@@ -32,11 +31,10 @@ The `AMR` package is a peer-reviewed, free and open-source R package
|
|||||||
with zero dependencies to simplify the analysis and prediction of
|
with zero dependencies to simplify the analysis and prediction of
|
||||||
Antimicrobial Resistance (AMR) and to work with microbial and
|
Antimicrobial Resistance (AMR) and to work with microbial and
|
||||||
antimicrobial data and properties, by using evidence-based methods.
|
antimicrobial data and properties, by using evidence-based methods.
|
||||||
|
**Our aim is to provide a standard** for clean and reproducible AMR data
|
||||||
**Our aim has always been to provide a standard** for clean and
|
analysis, that can therefore empower epidemiological analyses to
|
||||||
reproducible AMR data analysis, that can therefore empower
|
continuously enable surveillance and treatment evaluation in any
|
||||||
epidemiological analyses to continuously enable surveillance and
|
setting.
|
||||||
treatment evaluation in any setting.
|
|
||||||
|
|
||||||
The `AMR` package supports and can read any data format, including
|
The `AMR` package supports and can read any data format, including
|
||||||
WHONET data. This package works on Windows, macOS and Linux with all
|
WHONET data. This package works on Windows, macOS and Linux with all
|
||||||
|
|||||||
12
_pkgdown.yml
12
_pkgdown.yml
@@ -56,7 +56,7 @@ footer:
|
|||||||
left: [devtext]
|
left: [devtext]
|
||||||
right: [logo]
|
right: [logo]
|
||||||
components:
|
components:
|
||||||
devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU GPL 2.0</a>. Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in The Netherlands, in collaboration with <a href="https://amr-for-r.org/authors.html">many colleagues from around the world</a>.'
|
devtext: '<code>AMR</code> (for R). Free and open-source, licenced under the <a target="_blank" href="https://github.com/msberends/AMR/blob/main/LICENSE">GNU General Public License version 2.0 (GPL-2)</a>.<br>Developed at the <a target="_blank" href="https://www.rug.nl">University of Groningen</a> and <a target="_blank" href="https://www.umcg.nl">University Medical Center Groningen</a> in The Netherlands.'
|
||||||
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://amr-for-r.org/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://amr-for-r.org/logo_umcg.svg" style="max-width: 150px;"></a>'
|
logo: '<a target="_blank" href="https://www.rug.nl"><img src="https://amr-for-r.org/logo_rug.svg" style="max-width: 150px;"></a><a target="_blank" href="https://www.umcg.nl"><img src="https://amr-for-r.org/logo_umcg.svg" style="max-width: 150px;"></a>'
|
||||||
|
|
||||||
home:
|
home:
|
||||||
@@ -156,17 +156,17 @@ reference:
|
|||||||
- "`atc_online_property`"
|
- "`atc_online_property`"
|
||||||
- "`add_custom_antimicrobials`"
|
- "`add_custom_antimicrobials`"
|
||||||
|
|
||||||
- title: "Interpreting data: antimicrobial results"
|
- title: "Preparing data: antimicrobial results"
|
||||||
desc: >
|
desc: >
|
||||||
With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values.
|
With `as.mic()` and `as.disk()` you can transform your raw input to valid MIC or disk diffusion values.
|
||||||
Use `as.sir()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as SIR based on the lastest EUCAST and CLSI guidelines.
|
Use `as.sir()` for cleaning raw data to let it only contain "R", "I" and "S", or to interpret MIC or disk diffusion values as SIR based on the lastest EUCAST and CLSI guidelines.
|
||||||
Afterwards, you can extend antibiotic interpretations by applying interpretive rules, for example [from EUCAST](https://www.eucast.org/expert_rules_and_intrinsic_resistance/) with `interpretive_rules()`.
|
Afterwards, you can extend antibiotic interpretations by applying [EUCAST rules](https://www.eucast.org/expert_rules_and_intrinsic_resistance/) with `eucast_rules()`.
|
||||||
contents:
|
contents:
|
||||||
- "`as.sir`"
|
- "`as.sir`"
|
||||||
- "`as.mic`"
|
- "`as.mic`"
|
||||||
- "`as.disk`"
|
- "`as.disk`"
|
||||||
- "`interpretive_rules`"
|
- "`eucast_rules`"
|
||||||
- "`custom_interpretive_rules`"
|
- "`custom_eucast_rules`"
|
||||||
|
|
||||||
- title: "Analysing data"
|
- title: "Analysing data"
|
||||||
desc: >
|
desc: >
|
||||||
@@ -265,7 +265,7 @@ reference:
|
|||||||
|
|
||||||
- title: "Other: statistical tests"
|
- title: "Other: statistical tests"
|
||||||
desc: >
|
desc: >
|
||||||
Some statistical tests or methods usable for AMR analyses are not part of base R and were added to this package for convenience.
|
Some statistical tests or methods are not part of base R and were added to this package for convenience.
|
||||||
contents:
|
contents:
|
||||||
- "`g.test`"
|
- "`g.test`"
|
||||||
- "`kurtosis`"
|
- "`kurtosis`"
|
||||||
|
|||||||
@@ -33,20 +33,18 @@
|
|||||||
rm -rf ../PythonPackage/AMR/*
|
rm -rf ../PythonPackage/AMR/*
|
||||||
mkdir -p ../PythonPackage/AMR/AMR
|
mkdir -p ../PythonPackage/AMR/AMR
|
||||||
|
|
||||||
# Output files
|
# Output Python file
|
||||||
setup_file="../PythonPackage/AMR/setup.py"
|
setup_file="../PythonPackage/AMR/setup.py"
|
||||||
init_file="../PythonPackage/AMR/AMR/__init__.py"
|
|
||||||
engine_file="../PythonPackage/AMR/AMR/_engine.py"
|
|
||||||
datasets_file="../PythonPackage/AMR/AMR/datasets.py"
|
|
||||||
functions_file="../PythonPackage/AMR/AMR/functions.py"
|
functions_file="../PythonPackage/AMR/AMR/functions.py"
|
||||||
beta_file="../PythonPackage/AMR/AMR/beta.py"
|
datasets_file="../PythonPackage/AMR/AMR/datasets.py"
|
||||||
|
init_file="../PythonPackage/AMR/AMR/__init__.py"
|
||||||
description_file="../DESCRIPTION"
|
description_file="../DESCRIPTION"
|
||||||
|
|
||||||
# ---- _engine.py: R environment setup and installation logic ---- #
|
# Write header to the datasets Python file, including the convert_to_python function
|
||||||
|
cat <<EOL > "$datasets_file"
|
||||||
cat <<'EOL' > "$engine_file"
|
|
||||||
import os
|
import os
|
||||||
import sys
|
import sys
|
||||||
|
import pandas as pd
|
||||||
import importlib.metadata as metadata
|
import importlib.metadata as metadata
|
||||||
|
|
||||||
# Get the path to the virtual environment
|
# Get the path to the virtual environment
|
||||||
@@ -58,127 +56,48 @@ os.makedirs(r_lib_path, exist_ok=True)
|
|||||||
os.environ['R_LIBS_SITE'] = r_lib_path
|
os.environ['R_LIBS_SITE'] = r_lib_path
|
||||||
|
|
||||||
from rpy2 import robjects
|
from rpy2 import robjects
|
||||||
from rpy2.robjects.vectors import StrVector
|
from rpy2.robjects.conversion import localconverter
|
||||||
|
from rpy2.robjects import default_converter, numpy2ri, pandas2ri
|
||||||
from rpy2.robjects.packages import importr, isinstalled
|
from rpy2.robjects.packages import importr, isinstalled
|
||||||
|
|
||||||
# Import base and utils once
|
# Import base and utils
|
||||||
base = importr('base')
|
base = importr('base')
|
||||||
utils = importr('utils')
|
utils = importr('utils')
|
||||||
|
|
||||||
# Silence R console output entirely
|
base.options(warn=-1)
|
||||||
robjects.r('suppressMessages(suppressWarnings(sink(tempfile())))')
|
|
||||||
|
# Ensure library paths explicitly
|
||||||
base._libPaths(r_lib_path)
|
base._libPaths(r_lib_path)
|
||||||
|
|
||||||
_installed_source = None
|
# Check if the AMR package is installed in R
|
||||||
|
if not isinstalled('AMR', lib_loc=r_lib_path):
|
||||||
|
print(f"AMR: Installing latest AMR R package to {r_lib_path}...", flush=True)
|
||||||
|
utils.install_packages('AMR', repos='beta.amr-for-r.org', quiet=True)
|
||||||
|
|
||||||
def _r_version():
|
# Retrieve Python AMR version
|
||||||
"""Return the currently installed AMR R package version, or None."""
|
try:
|
||||||
|
python_amr_version = str(metadata.version('AMR'))
|
||||||
|
except metadata.PackageNotFoundError:
|
||||||
|
python_amr_version = str('')
|
||||||
|
|
||||||
|
# Retrieve R AMR version
|
||||||
|
r_amr_version = robjects.r(f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')
|
||||||
|
r_amr_version = str(r_amr_version[0])
|
||||||
|
|
||||||
|
# Compare R and Python package versions
|
||||||
|
if r_amr_version != python_amr_version:
|
||||||
try:
|
try:
|
||||||
return str(robjects.r(
|
print(f"AMR: Updating AMR package in {r_lib_path}...", flush=True)
|
||||||
f'as.character(packageVersion("AMR", lib.loc = "{r_lib_path}"))')[0])
|
utils.install_packages('AMR', repos='beta.amr-for-r.org', quiet=True)
|
||||||
except Exception:
|
except Exception as e:
|
||||||
return None
|
print(f"AMR: Could not update: {e}", flush=True)
|
||||||
|
|
||||||
def _py_version():
|
print(f"AMR: Setting up R environment and AMR datasets...", flush=True)
|
||||||
"""Return the Python AMR package version from metadata, or empty string."""
|
|
||||||
try:
|
|
||||||
return str(metadata.version('AMR'))
|
|
||||||
except metadata.PackageNotFoundError:
|
|
||||||
return ''
|
|
||||||
|
|
||||||
def _install_cran():
|
# Activate the automatic conversion between R and pandas DataFrames
|
||||||
"""Install AMR from CRAN into the isolated library."""
|
with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
|
||||||
print("AMR: Installing from CRAN...", flush=True)
|
# example_isolates
|
||||||
utils.install_packages(
|
example_isolates = robjects.r('''
|
||||||
'AMR',
|
|
||||||
repos='https://cloud.r-project.org',
|
|
||||||
lib=r_lib_path,
|
|
||||||
quiet=True
|
|
||||||
)
|
|
||||||
|
|
||||||
def _install_github():
|
|
||||||
"""Install AMR development version from GitHub into the isolated library."""
|
|
||||||
print("AMR: Installing development version from GitHub...", flush=True)
|
|
||||||
utils.install_packages(
|
|
||||||
StrVector(['remotes', 'desc']),
|
|
||||||
repos='https://cloud.r-project.org',
|
|
||||||
lib=r_lib_path,
|
|
||||||
quiet=True
|
|
||||||
)
|
|
||||||
remotes = importr('remotes', lib_loc=r_lib_path)
|
|
||||||
remotes.install_github('msberends/AMR', lib=r_lib_path, quiet=True)
|
|
||||||
|
|
||||||
def ensure_amr(source="cran"):
|
|
||||||
"""Ensure AMR is installed from the requested source. Idempotent per source."""
|
|
||||||
global _installed_source
|
|
||||||
|
|
||||||
if _installed_source == source:
|
|
||||||
return
|
|
||||||
|
|
||||||
install_fn = _install_github if source == "github" else _install_cran
|
|
||||||
|
|
||||||
if not isinstalled('AMR', lib_loc=r_lib_path):
|
|
||||||
install_fn()
|
|
||||||
else:
|
|
||||||
# Check for version mismatch and update if needed
|
|
||||||
r_ver = _r_version()
|
|
||||||
py_ver = _py_version()
|
|
||||||
if r_ver != py_ver:
|
|
||||||
try:
|
|
||||||
install_fn()
|
|
||||||
except Exception as e:
|
|
||||||
print(f"AMR: Could not update ({e})", flush=True)
|
|
||||||
|
|
||||||
print(f"AMR: R package version {_r_version()} ready.", flush=True)
|
|
||||||
_installed_source = source
|
|
||||||
|
|
||||||
def restore_sink():
|
|
||||||
"""Restore R console output after setup is complete."""
|
|
||||||
try:
|
|
||||||
robjects.r('sink()')
|
|
||||||
except Exception:
|
|
||||||
pass
|
|
||||||
EOL
|
|
||||||
|
|
||||||
# ---- datasets.py: only dataset loading ---- #
|
|
||||||
|
|
||||||
cat <<'EOL' > "$datasets_file"
|
|
||||||
import pandas as pd
|
|
||||||
from rpy2 import robjects
|
|
||||||
from rpy2.robjects.conversion import localconverter
|
|
||||||
from rpy2.robjects import default_converter, numpy2ri, pandas2ri
|
|
||||||
|
|
||||||
from ._engine import ensure_amr, restore_sink
|
|
||||||
|
|
||||||
_cache = {}
|
|
||||||
_loaded_source = None
|
|
||||||
|
|
||||||
def _load_datasets(source="cran"):
|
|
||||||
"""Load all AMR datasets into the module cache."""
|
|
||||||
global _loaded_source
|
|
||||||
|
|
||||||
if _cache and _loaded_source == source:
|
|
||||||
return
|
|
||||||
|
|
||||||
if _cache and _loaded_source != source:
|
|
||||||
_cache.clear()
|
|
||||||
|
|
||||||
ensure_amr(source)
|
|
||||||
|
|
||||||
with localconverter(default_converter + numpy2ri.converter + pandas2ri.converter):
|
|
||||||
_cache['example_isolates'] = _load_example_isolates()
|
|
||||||
_cache['microorganisms'] = robjects.r(
|
|
||||||
'AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]')
|
|
||||||
_cache['antimicrobials'] = robjects.r(
|
|
||||||
'AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]')
|
|
||||||
_cache['clinical_breakpoints'] = robjects.r(
|
|
||||||
'AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]')
|
|
||||||
|
|
||||||
restore_sink()
|
|
||||||
_loaded_source = source
|
|
||||||
|
|
||||||
def _load_example_isolates():
|
|
||||||
df = robjects.r('''
|
|
||||||
df <- AMR::example_isolates
|
df <- AMR::example_isolates
|
||||||
df[] <- lapply(df, function(x) {
|
df[] <- lapply(df, function(x) {
|
||||||
if (inherits(x, c("Date", "POSIXt", "factor"))) {
|
if (inherits(x, c("Date", "POSIXt", "factor"))) {
|
||||||
@@ -190,72 +109,26 @@ def _load_example_isolates():
|
|||||||
df <- df[, !sapply(df, is.list)]
|
df <- df[, !sapply(df, is.list)]
|
||||||
df
|
df
|
||||||
''')
|
''')
|
||||||
df['date'] = pd.to_datetime(df['date'])
|
example_isolates['date'] = pd.to_datetime(example_isolates['date'])
|
||||||
return df
|
|
||||||
|
|
||||||
def get(name, source="cran"):
|
# microorganisms
|
||||||
"""Retrieve a dataset by name, installing AMR if needed."""
|
microorganisms = robjects.r('AMR::microorganisms[, !sapply(AMR::microorganisms, is.list)]')
|
||||||
_load_datasets(source)
|
antimicrobials = robjects.r('AMR::antimicrobials[, !sapply(AMR::antimicrobials, is.list)]')
|
||||||
return _cache[name]
|
clinical_breakpoints = robjects.r('AMR::clinical_breakpoints[, !sapply(AMR::clinical_breakpoints, is.list)]')
|
||||||
|
|
||||||
|
base.options(warn = 0)
|
||||||
|
|
||||||
|
print(f"AMR: Done.", flush=True)
|
||||||
EOL
|
EOL
|
||||||
|
|
||||||
# ---- __init__.py: lazy module, CRAN by default ---- #
|
echo "from .datasets import example_isolates" >> $init_file
|
||||||
|
echo "from .datasets import microorganisms" >> $init_file
|
||||||
|
echo "from .datasets import antimicrobials" >> $init_file
|
||||||
|
echo "from .datasets import clinical_breakpoints" >> $init_file
|
||||||
|
|
||||||
cat <<'EOL' > "$init_file"
|
|
||||||
import sys
|
|
||||||
|
|
||||||
_DATASETS = frozenset({
|
# Write header to the functions Python file, including the convert_to_python function
|
||||||
'example_isolates', 'microorganisms',
|
cat <<EOL > "$functions_file"
|
||||||
'antimicrobials', 'clinical_breakpoints'
|
|
||||||
})
|
|
||||||
|
|
||||||
class _AMRModule(type(sys.modules[__name__])):
|
|
||||||
"""Lazy-loading module: nothing runs until an attribute is accessed."""
|
|
||||||
|
|
||||||
def __getattr__(self, name):
|
|
||||||
if name in _DATASETS:
|
|
||||||
from .datasets import get
|
|
||||||
return get(name, source="cran")
|
|
||||||
try:
|
|
||||||
from . import functions
|
|
||||||
return getattr(functions, name)
|
|
||||||
except AttributeError:
|
|
||||||
raise AttributeError(
|
|
||||||
f"module 'AMR' has no attribute '{name}'")
|
|
||||||
|
|
||||||
sys.modules[__name__].__class__ = _AMRModule
|
|
||||||
EOL
|
|
||||||
|
|
||||||
# ---- beta.py: GitHub development version ---- #
|
|
||||||
|
|
||||||
cat <<'EOL' > "$beta_file"
|
|
||||||
import sys
|
|
||||||
|
|
||||||
_DATASETS = frozenset({
|
|
||||||
'example_isolates', 'microorganisms',
|
|
||||||
'antimicrobials', 'clinical_breakpoints'
|
|
||||||
})
|
|
||||||
|
|
||||||
class _BetaModule(type(sys.modules[__name__])):
|
|
||||||
"""Lazy-loading module: installs AMR from GitHub on first access."""
|
|
||||||
|
|
||||||
def __getattr__(self, name):
|
|
||||||
if name in _DATASETS:
|
|
||||||
from .datasets import get
|
|
||||||
return get(name, source="github")
|
|
||||||
try:
|
|
||||||
from . import functions
|
|
||||||
return getattr(functions, name)
|
|
||||||
except AttributeError:
|
|
||||||
raise AttributeError(
|
|
||||||
f"module 'AMR.beta' has no attribute '{name}'")
|
|
||||||
|
|
||||||
sys.modules[__name__].__class__ = _BetaModule
|
|
||||||
EOL
|
|
||||||
|
|
||||||
# ---- functions.py: R-to-Python wrapper functions ---- #
|
|
||||||
|
|
||||||
cat <<'EOL' > "$functions_file"
|
|
||||||
import functools
|
import functools
|
||||||
import rpy2.robjects as robjects
|
import rpy2.robjects as robjects
|
||||||
from rpy2.robjects.packages import importr
|
from rpy2.robjects.packages import importr
|
||||||
@@ -265,10 +138,7 @@ from rpy2.robjects import default_converter, numpy2ri, pandas2ri
|
|||||||
import pandas as pd
|
import pandas as pd
|
||||||
import numpy as np
|
import numpy as np
|
||||||
|
|
||||||
from ._engine import ensure_amr
|
# Import the AMR R package
|
||||||
|
|
||||||
# Ensure AMR is available before importing it in R
|
|
||||||
ensure_amr("cran")
|
|
||||||
amr_r = importr('AMR')
|
amr_r = importr('AMR')
|
||||||
|
|
||||||
def convert_to_r(value):
|
def convert_to_r(value):
|
||||||
@@ -334,11 +204,12 @@ def r_to_python(r_func):
|
|||||||
return wrapper
|
return wrapper
|
||||||
EOL
|
EOL
|
||||||
|
|
||||||
# ---- Generate wrapper functions from .Rd files ---- #
|
# Directory where the .Rd files are stored (update path as needed)
|
||||||
|
|
||||||
rd_dir="../man"
|
rd_dir="../man"
|
||||||
|
|
||||||
|
# Iterate through each .Rd file in the man directory
|
||||||
for rd_file in "$rd_dir"/*.Rd; do
|
for rd_file in "$rd_dir"/*.Rd; do
|
||||||
|
# Extract function names and their arguments from the .Rd files
|
||||||
awk '
|
awk '
|
||||||
BEGIN {
|
BEGIN {
|
||||||
usage_started = 0
|
usage_started = 0
|
||||||
@@ -421,19 +292,18 @@ for rd_file in "$rd_dir"/*.Rd; do
|
|||||||
' "$rd_file"
|
' "$rd_file"
|
||||||
done
|
done
|
||||||
|
|
||||||
|
# Output completion message
|
||||||
echo "Python wrapper functions generated in $functions_file."
|
echo "Python wrapper functions generated in $functions_file."
|
||||||
echo "Python wrapper functions listed in $init_file."
|
echo "Python wrapper functions listed in $init_file."
|
||||||
|
|
||||||
# ---- README ---- #
|
|
||||||
|
|
||||||
cp ../vignettes/AMR_for_Python.Rmd ../PythonPackage/AMR/README.md
|
cp ../vignettes/AMR_for_Python.Rmd ../PythonPackage/AMR/README.md
|
||||||
sed -i '1,/^# Introduction$/d' ../PythonPackage/AMR/README.md
|
sed -i '1,/^# Introduction$/d' ../PythonPackage/AMR/README.md
|
||||||
echo "README copied."
|
echo "README copied"
|
||||||
|
|
||||||
# ---- setup.py ---- #
|
|
||||||
|
|
||||||
|
# Extract the relevant fields from DESCRIPTION
|
||||||
version=$(grep "^Version:" "$description_file" | awk '{print $2}')
|
version=$(grep "^Version:" "$description_file" | awk '{print $2}')
|
||||||
|
|
||||||
|
# Write the setup.py file
|
||||||
cat <<EOL > "$setup_file"
|
cat <<EOL > "$setup_file"
|
||||||
from setuptools import setup, find_packages
|
from setuptools import setup, find_packages
|
||||||
|
|
||||||
@@ -464,10 +334,10 @@ setup(
|
|||||||
)
|
)
|
||||||
EOL
|
EOL
|
||||||
|
|
||||||
echo "setup.py generated."
|
# Output completion message
|
||||||
|
echo "setup.py has been generated in $setup_file."
|
||||||
# ---- Build ---- #
|
|
||||||
|
|
||||||
cd ../PythonPackage/AMR
|
cd ../PythonPackage/AMR
|
||||||
pip3 install build
|
pip3 install build
|
||||||
python3 -m build
|
python3 -m build
|
||||||
|
# python3 setup.py sdist bdist_wheel
|
||||||
|
|||||||
@@ -42,9 +42,9 @@ pre_commit_lst <- list()
|
|||||||
|
|
||||||
usethis::ui_info(paste0("Updating internal package data"))
|
usethis::ui_info(paste0("Updating internal package data"))
|
||||||
|
|
||||||
# See 'data-raw/interpretive_rules.tsv' for the interpretive rules reference file
|
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
|
||||||
pre_commit_lst$INTERPRETIVE_RULES_DF <- utils::read.delim(
|
pre_commit_lst$EUCAST_RULES_DF <- utils::read.delim(
|
||||||
file = "data-raw/interpretive_rules.tsv",
|
file = "data-raw/eucast_rules.tsv",
|
||||||
skip = 9,
|
skip = 9,
|
||||||
sep = "\t",
|
sep = "\t",
|
||||||
stringsAsFactors = FALSE,
|
stringsAsFactors = FALSE,
|
||||||
@@ -109,11 +109,11 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
|||||||
which(MO_staph$species %in% c(
|
which(MO_staph$species %in% c(
|
||||||
"coagulase-negative", "argensis", "arlettae",
|
"coagulase-negative", "argensis", "arlettae",
|
||||||
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
||||||
"carnosus", "casei", "caseorum", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
||||||
"croceilyticus",
|
"croceilyticus",
|
||||||
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
||||||
"equorum", "felis", "fleurettii", "gallinarum", "halotolerans",
|
"equorum", "felis", "fleurettii", "gallinarum",
|
||||||
"haemolyticus", "hominis", "hsinchuensis", "jettensis", "kloosii",
|
"haemolyticus", "hominis", "jettensis", "kloosii",
|
||||||
"lentus", "lugdunensis", "massiliensis", "microti",
|
"lentus", "lugdunensis", "massiliensis", "microti",
|
||||||
"muscae", "nepalensis", "pasteuri", "petrasii",
|
"muscae", "nepalensis", "pasteuri", "petrasii",
|
||||||
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
|
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
|
||||||
@@ -142,8 +142,7 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
|||||||
"pseudintermedius", "pseudointermedius",
|
"pseudintermedius", "pseudointermedius",
|
||||||
"schweitzeri", "simiae",
|
"schweitzeri", "simiae",
|
||||||
"roterodami",
|
"roterodami",
|
||||||
"singaporensis",
|
"singaporensis"
|
||||||
"ursi"
|
|
||||||
) |
|
) |
|
||||||
# old, now renamed to S. coagulans (but still as synonym in our data of course):
|
# old, now renamed to S. coagulans (but still as synonym in our data of course):
|
||||||
(MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
|
(MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
|
||||||
@@ -281,7 +280,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
|
|||||||
"Malbranchea",
|
"Malbranchea",
|
||||||
"Metagonimus",
|
"Metagonimus",
|
||||||
"Meyerozyma",
|
"Meyerozyma",
|
||||||
"Microascus",
|
|
||||||
"Microsporidium",
|
"Microsporidium",
|
||||||
"Microsporum",
|
"Microsporum",
|
||||||
"Millerozyma",
|
"Millerozyma",
|
||||||
@@ -308,7 +306,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
|
|||||||
"Piedraia",
|
"Piedraia",
|
||||||
"Pithomyces",
|
"Pithomyces",
|
||||||
"Pityrosporum",
|
"Pityrosporum",
|
||||||
"Plasmodium",
|
|
||||||
"Pneumocystis",
|
"Pneumocystis",
|
||||||
"Pseudallescheria",
|
"Pseudallescheria",
|
||||||
"Pseudoscopulariopsis",
|
"Pseudoscopulariopsis",
|
||||||
@@ -326,7 +323,6 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
|
|||||||
"Sarcoptes",
|
"Sarcoptes",
|
||||||
"Scedosporium",
|
"Scedosporium",
|
||||||
"Schistosoma",
|
"Schistosoma",
|
||||||
"Schizophyllum",
|
|
||||||
"Schizosaccharomyces",
|
"Schizosaccharomyces",
|
||||||
"Scolecobasidium",
|
"Scolecobasidium",
|
||||||
"Scopulariopsis",
|
"Scopulariopsis",
|
||||||
@@ -368,7 +364,7 @@ pre_commit_lst$MO_RELEVANT_GENERA <- c(
|
|||||||
)
|
)
|
||||||
|
|
||||||
# antibiotic groups
|
# antibiotic groups
|
||||||
# (these will also be used for interpretive_rules() and understanding data-raw/interpretive_rules.tsv)
|
# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv)
|
||||||
pre_commit_lst$AB_AMINOGLYCOSIDES <- antimicrobials %>%
|
pre_commit_lst$AB_AMINOGLYCOSIDES <- antimicrobials %>%
|
||||||
filter(group %like% "aminoglycoside|paromomycin|spectinomycin") %>%
|
filter(group %like% "aminoglycoside|paromomycin|spectinomycin") %>%
|
||||||
pull(ab)
|
pull(ab)
|
||||||
|
|||||||
@@ -293,7 +293,7 @@ breakpoints_new <- breakpoints |>
|
|||||||
host = ifelse(BREAKPOINT_TYPE == "ECOFF", "ECOFF", tolower(HOST)),
|
host = ifelse(BREAKPOINT_TYPE == "ECOFF", "ECOFF", tolower(HOST)),
|
||||||
method = TEST_METHOD,
|
method = TEST_METHOD,
|
||||||
site = SITE_OF_INFECTION,
|
site = SITE_OF_INFECTION,
|
||||||
mo = as.mo(mo),
|
mo,
|
||||||
rank_index = case_when(
|
rank_index = case_when(
|
||||||
is.na(mo_rank(mo, keep_synonyms = TRUE)) ~ 6, # for UNKNOWN, B_GRAMN, B_ANAER, B_ANAER-NEG, etc.
|
is.na(mo_rank(mo, keep_synonyms = TRUE)) ~ 6, # for UNKNOWN, B_GRAMN, B_ANAER, B_ANAER-NEG, etc.
|
||||||
mo_rank(mo, keep_synonyms = TRUE) %like% "(infra|sub)" ~ 1,
|
mo_rank(mo, keep_synonyms = TRUE) %like% "(infra|sub)" ~ 1,
|
||||||
@@ -453,9 +453,6 @@ breakpoints_new$breakpoint_R[breakpoints_new$guideline %like% "EUCAST" & breakpo
|
|||||||
breakpoints_new <- breakpoints_new |>
|
breakpoints_new <- breakpoints_new |>
|
||||||
filter(!(guideline %like% "EUCAST (2024|2025|2026)" & ref_tbl == "PK/PD"))
|
filter(!(guideline %like% "EUCAST (2024|2025|2026)" & ref_tbl == "PK/PD"))
|
||||||
|
|
||||||
# WHONET still contains generic anaerobic rules for EUCAST >= 2021, but this was ended from v12 (2022) on
|
|
||||||
breakpoints_new <- breakpoints_new |>
|
|
||||||
filter(!(guideline %like% "EUCAST (2022|2023|2024|2025|2026)" & ref_tbl %like% "anaerob"))
|
|
||||||
|
|
||||||
# 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 2023 guideline: S <= 8 and R > 8
|
# EUCAST 2023 guideline: S <= 8 and R > 8
|
||||||
@@ -503,72 +500,6 @@ dim(breakpoints_new)
|
|||||||
dim(clinical_breakpoints)
|
dim(clinical_breakpoints)
|
||||||
|
|
||||||
|
|
||||||
# Correct anaerobic bacteria in EUCAST ----
|
|
||||||
|
|
||||||
eucast_anaerobe_corrections <- tibble::tribble(
|
|
||||||
~guideline, ~type, ~host, ~method, ~site, ~mo, ~rank_index, ~ab, ~ref_tbl, ~disk_dose, ~breakpoint_S, ~breakpoint_R, ~uti, ~is_SDD,
|
|
||||||
|
|
||||||
# Prevotella spp.
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Prevotella"), 3, as.ab("AMP"), "Prevotella", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Prevotella"), 3, as.ab("AMP"), "Prevotella", "2 mcg", 25, 25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Prevotella"), 3, as.ab("SAM"), "Prevotella", "10/10 mcg", 33, 33, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Prevotella"), 3, as.ab("AMX"), "Prevotella", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Prevotella"), 3, as.ab("AMC"), "Prevotella", "2/1 mcg", 24, 24, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Prevotella"), 3, as.ab("ETP"), "Prevotella", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Prevotella"), 3, as.ab("ETP"), "Prevotella", "10 mcg", 29, 29, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Prevotella"), 3, as.ab("IPM"), "Prevotella", NA, 0.125, 0.125, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Prevotella"), 3, as.ab("IPM"), "Prevotella", "10 mcg", 35, 35, FALSE, FALSE,
|
|
||||||
|
|
||||||
# Fusobacterium necrophorum
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("AMP"), "F. necrophorum", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("AMP"), "F. necrophorum", "2 mcg", 27, 27, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("SAM"), "F. necrophorum", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("SAM"), "F. necrophorum", "10/10 mcg", 33, 33, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("AMX"), "F. necrophorum", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("AMC"), "F. necrophorum", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("AMC"), "F. necrophorum", "2/1 mcg", 23, 23, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("ETP"), "F. necrophorum", NA, 0.06, 0.06, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("ETP"), "F. necrophorum", "10 mcg", 35, 35, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("IPM"), "F. necrophorum", NA, 0.125, 0.125, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Fusobacterium necrophorum"), 2, as.ab("IPM"), "F. necrophorum", "10 mcg", 36, 36, FALSE, FALSE,
|
|
||||||
|
|
||||||
# Clostridium perfringens
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("AMP"), "C. perfringens", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Clostridium perfringens"), 2, as.ab("AMP"), "C. perfringens", "2 mcg", 23, 23, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("SAM"), "C. perfringens", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Clostridium perfringens"), 2, as.ab("SAM"), "C. perfringens", "10/10 mcg", 27, 27, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("AMX"), "C. perfringens", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("AMC"), "C. perfringens", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Clostridium perfringens"), 2, as.ab("AMC"), "C. perfringens", "2/1 mcg", 23, 23, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("ETP"), "C. perfringens", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Clostridium perfringens"), 2, as.ab("ETP"), "C. perfringens", "10 mcg", 24, 24, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Clostridium perfringens"), 2, as.ab("IPM"), "C. perfringens", NA, 0.5, 0.5, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Clostridium perfringens"), 2, as.ab("IPM"), "C. perfringens", "10 mcg", 25, 25, FALSE, FALSE,
|
|
||||||
|
|
||||||
# Cutibacterium acnes
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("AMP"), "C. acnes", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("AMP"), "C. acnes", "2 mcg", 23, 23, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("SAM"), "C. acnes", "10/10 mcg", 33, 33, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("AMX"), "C. acnes", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("AMC"), "C. acnes", "2/1 mcg", 24, 24, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("CTX"), "C. acnes", "5 mcg", 26, 26, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("CRO"), "C. acnes", NA, 0.06, 0.06, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("CRO"), "C. acnes", "30 mcg", 33, 33, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("ETP"), "C. acnes", NA, 0.25, 0.25, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("ETP"), "C. acnes", "10 mcg", 28, 28, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("IPM"), "C. acnes", NA, 0.03, 0.03, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("IPM"), "C. acnes", "10 mcg", 39, 39, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "MIC", NA, as.mo("Cutibacterium acnes"), 2, as.ab("LNZ"), "C. acnes", NA, 2, 2, FALSE, FALSE,
|
|
||||||
"EUCAST 2025", "human", "human", "DISK", NA, as.mo("Cutibacterium acnes"), 2, as.ab("LNZ"), "C. acnes", "10 mcg", 34, 34, FALSE, FALSE
|
|
||||||
)
|
|
||||||
|
|
||||||
breakpoints_new <- clinical_breakpoints |>
|
|
||||||
bind_rows(eucast_anaerobe_corrections) |>
|
|
||||||
bind_rows(eucast_anaerobe_corrections |> mutate(guideline = "EUCAST 2026")) |>
|
|
||||||
bind_rows(eucast_anaerobe_corrections |> mutate(guideline = "EUCAST 2023")) |>
|
|
||||||
bind_rows(eucast_anaerobe_corrections |> mutate(guideline = "EUCAST 2024"))
|
|
||||||
|
|
||||||
|
|
||||||
# SAVE TO PACKAGE ----
|
# SAVE TO PACKAGE ----
|
||||||
|
|
||||||
# determine rank again now that some changes were made on taxonomic level (genus -> species)
|
# determine rank again now that some changes were made on taxonomic level (genus -> species)
|
||||||
|
|||||||
@@ -35,13 +35,13 @@ for (i in seq_len(nrow(antimicrobials))) {
|
|||||||
colnames(int_resis)[ncol(int_resis)] <- antimicrobials$ab[i]
|
colnames(int_resis)[ncol(int_resis)] <- antimicrobials$ab[i]
|
||||||
}
|
}
|
||||||
|
|
||||||
int_resis <- interpretive_rules(int_resis,
|
int_resis <- eucast_rules(int_resis,
|
||||||
interpretive_rules_df = subset(
|
eucast_rules_df = subset(
|
||||||
AMR:::INTERPRETIVE_RULES_DF,
|
AMR:::EUCAST_RULES_DF,
|
||||||
is.na(have_these_values) & reference.rule_group == "Expected phenotypes" & reference.version == 1.2
|
is.na(have_these_values) & reference.rule_group == "Expected phenotypes" & reference.version == 1.2
|
||||||
),
|
),
|
||||||
overwrite = TRUE,
|
overwrite = TRUE,
|
||||||
info = FALSE
|
info = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
int_resis2 <- int_resis[, sapply(int_resis, function(x) any(!is.sir(x) | x == "R")), drop = FALSE] %>%
|
int_resis2 <- int_resis[, sapply(int_resis, function(x) any(!is.sir(x) | x == "R")), drop = FALSE] %>%
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -1 +1 @@
|
|||||||
634c5e23bed1e92783eeb4739c0d1486
|
45068afc4cd9770dea329782c1aed045
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -298,6 +298,7 @@
|
|||||||
"B_HACEK" "B_HMPHL_PSCM" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus piscium"
|
"B_HACEK" "B_HMPHL_PSCM" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus piscium"
|
||||||
"B_HACEK" "B_HMPHL_PTTM" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus pittmaniae"
|
"B_HACEK" "B_HMPHL_PTTM" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus pittmaniae"
|
||||||
"B_HACEK" "B_ACTNB_PLRP" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus pleuropneumoniae"
|
"B_HACEK" "B_ACTNB_PLRP" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus pleuropneumoniae"
|
||||||
|
"B_HACEK" "B_HMPHL_QNTN" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus quentini"
|
||||||
"B_HACEK" "B_AGGRG_SGNS" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus segnis"
|
"B_HACEK" "B_AGGRG_SGNS" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus segnis"
|
||||||
"B_HACEK" "B_HMPHL_SMNL" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus seminalis"
|
"B_HACEK" "B_HMPHL_SMNL" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus seminalis"
|
||||||
"B_HACEK" "B_HMPHL_SPTR" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus sputorum"
|
"B_HACEK" "B_HMPHL_SPTR" "Haemophilus, Aggregatibacter, Cardiobacterium, Eikenella, Kingella (HACEK)" "Haemophilus sputorum"
|
||||||
@@ -318,6 +319,7 @@
|
|||||||
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae"
|
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae"
|
||||||
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN_QSPN" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae quasipneumoniae"
|
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN_QSPN" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae quasipneumoniae"
|
||||||
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN_SMLP" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae similipneumoniae"
|
"B_KLBSL_PNMN-C" "B_KLBSL_QSPN_SMLP" "Klebsiella pneumoniae complex" "Klebsiella quasipneumoniae similipneumoniae"
|
||||||
|
"B_KLBSL_PNMN-C" "B_KLBSL_QSVR" "Klebsiella pneumoniae complex" "Klebsiella quasivariicola"
|
||||||
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL" "Klebsiella pneumoniae complex" "Klebsiella variicola"
|
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL" "Klebsiella pneumoniae complex" "Klebsiella variicola"
|
||||||
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL_TRPC" "Klebsiella pneumoniae complex" "Klebsiella variicola tropica"
|
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL_TRPC" "Klebsiella pneumoniae complex" "Klebsiella variicola tropica"
|
||||||
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL_LNSS" "Klebsiella pneumoniae complex" "Klebsiella variicola tropicalensis"
|
"B_KLBSL_PNMN-C" "B_KLBSL_VRCL_LNSS" "Klebsiella pneumoniae complex" "Klebsiella variicola tropicalensis"
|
||||||
@@ -330,20 +332,22 @@
|
|||||||
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii japonica"
|
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii japonica"
|
||||||
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii muhira"
|
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii muhira"
|
||||||
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii pseudoguilliermondii"
|
"F_MYRZY_GLLR-C" "F_MYRZY_GLLR" "Meyerozyma guilliermondii complex" "Meyerozyma guilliermondii pseudoguilliermondii"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM" "Mycobacterium avium complex" "Mycobacterium avium"
|
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM" "Mycobacterium avium-intracellulare complex" "Mycobacterium avium"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_AVIM" "Mycobacterium avium complex" "Mycobacterium avium avium"
|
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_AVIM" "Mycobacterium avium-intracellulare complex" "Mycobacterium avium avium"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_PRTB" "Mycobacterium avium complex" "Mycobacterium avium paratuberculosis"
|
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_PRTB" "Mycobacterium avium-intracellulare complex" "Mycobacterium avium paratuberculosis"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_SLVT" "Mycobacterium avium complex" "Mycobacterium avium silvaticum"
|
"B_MYCBC_AVIM-C" "B_MYCBC_AVIM_SLVT" "Mycobacterium avium-intracellulare complex" "Mycobacterium avium silvaticum"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE" "Mycobacterium avium complex" "Mycobacterium intracellulare"
|
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE" "Mycobacterium avium-intracellulare complex" "Mycobacterium intracellulare"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_CHMR" "Mycobacterium avium complex" "Mycobacterium intracellulare chimaera"
|
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_CHMR" "Mycobacterium avium-intracellulare complex" "Mycobacterium intracellulare chimaera"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_INTR" "Mycobacterium avium complex" "Mycobacterium intracellulare intracellulare"
|
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_INTR" "Mycobacterium avium-intracellulare complex" "Mycobacterium intracellulare intracellulare"
|
||||||
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_CHMR" "Mycobacterium avium complex" "Mycobacterium intracellulare yongonense"
|
"B_MYCBC_AVIM-C" "B_MYCBC_LLRE_CHMR" "Mycobacterium avium-intracellulare complex" "Mycobacterium intracellulare yongonense"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium africanum"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium africanum"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis bovis"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis bovis"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis caprae"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium bovis caprae"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium caprae"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium caprae"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium microti"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium microti"
|
||||||
|
"B_MYCBC_TBRC-C" "B_MYCBC_MUNG" "Mycobacterium tuberculosis complex" "Mycobacterium mungi"
|
||||||
|
"B_MYCBC_TBRC-C" "B_MYCBC_ORYG" "Mycobacterium tuberculosis complex" "Mycobacterium orygis"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium pinnipedii"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium pinnipedii"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium tuberculosis"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium tuberculosis"
|
||||||
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium tuberculosis caprae"
|
"B_MYCBC_TBRC-C" "B_MYCBC_TBRC" "Mycobacterium tuberculosis complex" "Mycobacterium tuberculosis caprae"
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
1533
data-raw/eucast_rules.tsv
Normal file
1533
data-raw/eucast_rules.tsv
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1 +1 @@
|
|||||||
ec377180475ec3cd61ffaed401643e9a
|
990cbdfa55a1c2340aecfa67e8ac84d6
|
||||||
|
|||||||
@@ -1 +1 @@
|
|||||||
5fba98b9dd8845adc9f83d52b28f8254
|
6ef98bb1bcd27052fde453bb12c0b285
|
||||||
|
|||||||
@@ -1 +1 @@
|
|||||||
43f0086ac00f84bbda973c6c5e332c49
|
dfdbbebfe1a542270d63b94c12889860
|
||||||
|
|||||||
@@ -1 +1 @@
|
|||||||
7613ad032fa1078b6c2ad46d7ae8236f
|
6dc4dded108052760bfb626df03435e2
|
||||||
|
|||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user