(v1.4.0.9012) reference_df fix

R/aa_helper_functions.R

@@ -87,7 +87,7 @@ addin_insert_like <- function() {
   current_row_txt <- context$contents[current_row]
   
   pos_preceded_by <- function(txt) {
-    substr(current_row_txt, current_col - nchar(txt), current_col) == txt
+    substr(current_row_txt, current_col - nchar(txt), current_col) %like% paste0("^", txt)
   }
   replace_pos <- function(old, with) {
     modifyRange(document_range(document_position(current_row, current_col - nchar(old)),

R/like.R

@@ -67,6 +67,11 @@
 #' if (require("dplyr")) {
 #'   example_isolates %>%
 #'     filter(mo_name(mo) %like% "^ent")
+#'  
+#'   example_isolates %>% 
+#'     mutate(group = case_when(hospital_id %like% "A|D"        ~ "Group 1",
+#'                              mo_name(mo) %not_like% "^Staph" ~ "Group 2a",
+#'                              TRUE                            ~ "Group 2b"))
 #' }
 #' }
 like <- function(x, pattern, ignore.case = TRUE) {
@@ -168,7 +173,6 @@ like <- function(x, pattern, ignore.case = TRUE) {
   like(x, pattern, ignore.case = FALSE)
 }
 
-
 #' @rdname like
 #' @export
 "%not_like_case%" <- function(x, pattern) {

R/mo.R

@@ -199,31 +199,16 @@ as.mo <- function(x,
   uncertainty_level <- translate_allow_uncertain(allow_uncertain)
 
   if (mo_source_isvalid(reference_df)
-      & isFALSE(Becker)
-      & isFALSE(Lancefield)
-      & !is.null(reference_df)
-      & all(x %in% reference_df[, 1][[1]])) {
+      && isFALSE(Becker)
+      && isFALSE(Lancefield)
+      && !is.null(reference_df)
+      && all(x %in% unlist(reference_df), na.rm = TRUE)) {
 
-    # has valid own reference_df
-    reference_df <- reference_df %pm>% pm_filter(!is.na(mo))
-    # keep only first two columns, second must be mo
-    if (colnames(reference_df)[1] == "mo") {
-      reference_df <- reference_df[, c(2, 1)]
-    } else {
-      reference_df <- reference_df[, c(1, 2)]
-    }
-    # some microbial codes might be old
-    reference_df[, 1] <- as.mo(reference_df[, 1, drop = TRUE])
-    
-    colnames(reference_df)[1] <- "x"
-    # remove factors, just keep characters
-    suppressWarnings(
-      reference_df[] <- lapply(reference_df, as.character)
-    )
+    reference_df <- repair_reference_df(reference_df)
     suppressWarnings(
       y <- data.frame(x = x, stringsAsFactors = FALSE) %pm>%
         pm_left_join(reference_df, by = "x") %pm>%
-        pm_pull("mo")
+        pm_pull(mo) 
     )
 
   } else if (all(x[!is.na(x)] %in% MO_lookup$mo)
@@ -406,22 +391,7 @@ exec_as.mo <- function(x,
   # defined df to check for
   if (!is.null(reference_df)) {
     mo_source_isvalid(reference_df)
-
-    reference_df <- reference_df %pm>% pm_filter(!is.na(mo))
-    # keep only first two columns, second must be named "mo"
-    if (colnames(reference_df)[1] == "mo") {
-      reference_df <- reference_df[, c(2, 1)]
-    } else {
-      reference_df <- reference_df[, c(1, 2)]
-    }
-    # some microbial codes might be old
-    reference_df[, 1] <- as.mo(reference_df[, 1, drop = TRUE])
-    
-    colnames(reference_df)[1] <- "x"
-    # remove factors, just keep characters
-    suppressWarnings(
-      reference_df[] <- lapply(reference_df, as.character)
-    )
+    reference_df <- repair_reference_df(reference_df)
   }
 
   # all empty
@@ -1936,7 +1906,11 @@ replace_old_mo_codes <- function(x, property) {
     if (property != "mo") {
       message_(font_blue("NOTE: The input contained old microbial codes (from previous package versions). Please update your MO codes with as.mo()."))
     } else {
-      message_(font_blue("NOTE:", length(matched), "old microbial codes (from previous package versions) were updated to current used codes."))
+      if (length(matched) == 1) {
+        message_(font_blue("NOTE: 1 old microbial code (from previous package versions) was updated to a current used code."))
+      } else {
+        message_(font_blue("NOTE:", length(matched), "old microbial codes (from previous package versions) were updated to current used codes.")) 
+      }
     }
   }
   x
@@ -1955,6 +1929,27 @@ replace_ignore_pattern <- function(x, ignore_pattern) {
   x
 }
 
+repair_reference_df <- function(reference_df) {
+  # has valid own reference_df
+  reference_df <- reference_df %pm>%
+    pm_filter(!is.na(mo))
+  
+  # keep only first two columns, second must be mo
+  if (colnames(reference_df)[1] == "mo") {
+    reference_df <- reference_df %pm>% pm_select(2, "mo")
+  } else {
+    reference_df <- reference_df %pm>% pm_select(1, "mo")
+  }
+  # some microbial codes might be old
+  reference_df[, 2] <- as.mo(reference_df[, 2, drop = TRUE])
+  # remove factors, just keep characters
+  suppressWarnings(
+    reference_df[] <- lapply(reference_df, as.character)
+  )
+  colnames(reference_df)[1] <- "x"
+  reference_df
+}
+
 left_join_MO_lookup <- function(x, ...) {
   pm_left_join(x = x, y = MO_lookup, ...)
 }

R/mo_matching_score.R

@@ -25,7 +25,9 @@
 
 #' Calculate the matching score for microorganisms
 #' 
-#' This helper function is used by [as.mo()] to determine the most probable match of taxonomic records, based on user input. 
+#' This algorithm is used by [as.mo()] and all the [`mo_*`][mo_property()] functions to determine the most probable match of taxonomic records based on user input. 
+#' @inheritSection lifecycle Stable lifecycle
+#' @author Matthijs S. Berends
 #' @param x Any user input value(s)
 #' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
 #' @section Matching score for microorganisms: