feat: dictionary_sugar_get does string comparison with other given dictionaries for error message

R/Dictionary.R

@@ -177,16 +177,18 @@ Dictionary = R6::R6Class("Dictionary",
   )
 )
 
-dictionary_get = function(self, key, ...) {
-  obj = dictionary_retrieve_item(self, key)
+dictionary_get = function(self, key, ..., .dicts_suggest) {
+  obj = dictionary_retrieve_item(self, key, .dicts_suggest)
   dots = assert_list(list(...), names = "unique", .var.name = "arguments passed to Dictionary")
   dictionary_initialize_item(key, obj, dots)
 }
 
-dictionary_retrieve_item = function(self, key) {
+dictionary_retrieve_item = function(self, key, dicts_suggest) {
   obj = get0(key, envir = self$items, inherits = FALSE, ifnotfound = NULL)
   if (is.null(obj)) {
-    stopf("Element with key '%s' not found in %s!%s", key, class(self)[1L], did_you_mean(key, self$keys()))
+    stopf("Element with key '%s' not found in %s!%s%s", key, class(self)[1L],
+          did_you_mean(key, self$keys()),
+          did_you_mean_dicts(key, dicts_suggest))
   }
   obj
 }
@@ -207,7 +209,6 @@ dictionary_initialize_item = function(key, obj, cargs = list()) {
   }
 }
 
-
 #' @export
 as.data.table.Dictionary = function(x, ...) {
   setkeyv(as.data.table(list(key = x$keys())), "key")[]

R/dictionary_sugar.R

@@ -24,6 +24,8 @@
 #'   Keys of the objects to construct.
 #' @param ... (`any`)\cr
 #'   See description.
+#' @param .dicts_suggest (named [`list`])
+#'   Named list of [dictionaries][Dictionary] used to look up suggestions for `.key` in cases of misspelling.
 #' @return [R6::R6Class()]
 #' @export
 #' @examples
@@ -32,19 +34,20 @@
 #' d = Dictionary$new()
 #' d$add("key", item)
 #' dictionary_sugar_get(d, "key", x = 2)
-dictionary_sugar_get = function(dict, .key, ...) {
+dictionary_sugar_get = function(dict, .key, ..., .dicts_suggest = NULL) {
   assert_class(dict, "Dictionary")
   if (missing(.key)) {
     return(dict)
   }
   assert_string(.key)
+  assert_list(.dicts_suggest, "Dictionary", any.missing = FALSE, min.len = 1, unique = TRUE, names = "named", null.ok = TRUE)
   if (...length() == 0L) {
-    return(dictionary_get(dict, .key))
+    return(dictionary_get(dict, .key, .dicts_suggest = .dicts_suggest))
   }
   dots = assert_list(list(...), .var.name = "additional arguments passed to Dictionary")
   assert_list(dots[!is.na(names2(dots))], names = "unique", .var.name = "named arguments passed to Dictionary")
 
-  obj = dictionary_retrieve_item(dict, .key)
+  obj = dictionary_retrieve_item(dict, .key, .dicts_suggest)
   if (length(dots) == 0L) {
     return(assert_r6(dictionary_initialize_item(.key, obj)))
   }
@@ -55,7 +58,6 @@ dictionary_sugar_get = function(dict, .key, ...) {
   instance = assert_r6(dictionary_initialize_item(.key, obj, dots[ii]))
   dots = dots[!ii]
 
-
   # set params in ParamSet
   if (length(dots) && exists("param_set", envir = instance, inherits = FALSE)) {
     param_ids = instance$param_set$ids()
@@ -74,7 +76,7 @@ dictionary_sugar_get = function(dict, .key, ...) {
     for (i in seq_along(dots)) {
       nn = ndots[[i]]
       if (!exists(nn, envir = instance, inherits = FALSE)) {
-        stopf("Cannot set argument '%s' for '%s' (not a constructor argument, not a parameter, not a field.%s",
+        stopf("Cannot set argument '%s' for '%s' (not a constructor argument, not a parameter, not a field).%s",
           nn, class(instance)[1L], did_you_mean(nn, c(constructor_args, param_ids, setdiff(names(instance), ".__enclos_env__")))) # nolint
       }
       instance[[nn]] = dots[[i]]
@@ -90,11 +92,11 @@ dictionary_sugar = dictionary_sugar_get
 
 #' @rdname dictionary_sugar_get
 #' @export
-dictionary_sugar_mget = function(dict, .keys, ...) {
+dictionary_sugar_mget = function(dict, .keys, ..., .dicts_suggest = NULL) {
   if (missing(.keys)) {
     return(dict)
   }
-  objs = lapply(.keys, dictionary_sugar_get, dict = dict, ...)
+  objs = lapply(.keys, dictionary_sugar_get, dict = dict, .dicts_suggest = .dicts_suggest, ...)
   if (!is.null(names(.keys))) {
     nn = names2(.keys)
     ii = which(!is.na(nn))
@@ -132,10 +134,10 @@ fields = function(x) {
 #' @title A Quick Way to Initialize Objects from Dictionaries with Incremented ID
 #'
 #' @description
-#' Covenience wrapper around [dictionary_sugar_get] and [dictionary_sugar_mget] to allow easier avoidance of of ID
+#' Covenience wrapper around [dictionary_sugar_get] and [dictionary_sugar_mget] to allow easier avoidance of ID
 #' clashes which is useful when the same object is used multiple times and the ids have to be unique.
 #' Let `<key>` be the key of the object to retrieve. When passing the `<key>_<n>` to this
-#' function, where `<n>` is any natural numer, the object with key `<key>` is retrieved and the
+#' function, where `<n>` is any natural number, the object with key `<key>` is retrieved and the
 #' suffix `_<n>` is appended to the id after the object is constructed.
 #'
 #' @param dict ([Dictionary])\cr
@@ -163,25 +165,24 @@ fields = function(x) {
 #' map(objs, "id")
 #'
 #' @export
-dictionary_sugar_inc_get = function(dict, .key, ...) {
+dictionary_sugar_inc_get = function(dict, .key, ..., .dicts_suggest = NULL) {
   m = regexpr("_\\d+$", .key)
   if (attr(m, "match.length") == -1L)  {
-    return(dictionary_sugar_get(dict = dict, .key = .key, ...))
+    return(dictionary_sugar_get(dict = dict, .key = .key, ..., .dicts_suggest = .dicts_suggest))
   }
   assert_true(!methods::hasArg("id"))
   split = regmatches(.key, m, invert = NA)[[1L]]
   newkey = split[[1L]]
   suffix = split[[2L]]
-  obj = dictionary_sugar_get(dict = dict, .key = newkey, ...)
+  obj = dictionary_sugar_get(dict = dict, .key = newkey, ..., .dicts_suggest = .dicts_suggest)
   obj$id = paste0(obj$id, suffix)
   obj
-
 }
 
 #' @rdname dictionary_sugar_inc_get
 #' @export
-dictionary_sugar_inc_mget = function(dict, .keys, ...) {
-  objs = lapply(.keys, dictionary_sugar_inc_get, dict = dict, ...)
+dictionary_sugar_inc_mget = function(dict, .keys, ..., .dicts_suggest = NULL) {
+  objs = lapply(.keys, dictionary_sugar_inc_get, dict = dict, ..., .dicts_suggest = .dicts_suggest)
   if (!is.null(names(.keys))) {
     nn = names2(.keys)
     ii = which(!is.na(nn))

R/did_you_mean.R

@@ -13,12 +13,87 @@
 #' @examples
 #' did_you_mean("yep", c("yes", "no"))
 did_you_mean = function(str, candidates) {
-  candidates = unique(candidates)
-  D = set_names(adist(str, candidates, ignore.case = TRUE, partial = TRUE)[1L, ], candidates)
-  suggested = names(head(sort(D[D <= ceiling(0.2 * nchar(str))]), 3L))
+  suggestions = find_suggestions(str, candidates, threshold = 0.2, max_candidates = 3L, ret_distances = FALSE)
+
+  if (!length(suggestions)) {
+    return("")
+  }
+  sprintf(" Did you mean %s?", str_collapse(suggestions, quote = "'", sep = " / "))
+}
+
+#' @title Suggest Alternatives from Given Dictionaries
+#'
+#' @description
+#' Helps to suggest alternatives for a given key based on the keys of given dictionaries.
+#'
+#' @param key (`character(1)`) \cr
+#'   Key to look for in `dicts`.
+#' @param dicts (named list)\cr
+#'   Named list of [dictionaries][Dictionary].
+#' @return (`character(1)`). Either a phrase suggesting one or more keys based on the dictionaries in `dicts`,
+#'   or an empty string if no close match is found.
+did_you_mean_dicts = function(key, dicts) {
+  # No message if no dictionaries are given
+  if (is.null(dicts)) {
+    return("")
+  }
+
+  suggestions = character(length(dicts))
+  min_distance_per_dict = numeric(length(dicts))
+
+  for (i in seq_along(dicts)) {
+    # Get distances and the corresponding entries for the current dictionary
+    distances = find_suggestions(key, dicts[[i]]$keys(), ret_distances = TRUE)
+    entries = names(distances)
 
-  if (!length(suggested)) {
+    # Handle the case of no matches: skip the dictionary
+    if (!length(entries)) {
+      min_distance_per_dict[[i]] = NA
+      next
+    }
+    # Record the closest distance
+    min_distance_per_dict[[i]] = min(distances)
+
+    # Create a suggestion message for the current dictionary
+    suggestions[[i]] = sprintf("%s: %s", names(dicts)[[i]],
+                               str_collapse(entries, quote = "'", sep = " / "))
+  }
+
+  # Order the suggestions by their closest match
+  suggestions = suggestions[order(min_distance_per_dict)]
+  # Remove empty suggestions (i.e., dictionaries with no close matches)
+  valid_suggestions = suggestions[nchar(suggestions) > 0L]
+  # Only show the 3 dictionaries with the best matches
+  valid_suggestions = head(valid_suggestions, 3L)
+
+  # If no valid suggestions, return an empty string
+  if (!length(valid_suggestions)) {
     return("")
   }
-  sprintf(" Did you mean %s?", str_collapse(suggested, quote = "'", sep = " / "))
+
+  sprintf("\nSimilar entries in other dictionaries, %s.", str_collapse(valid_suggestions, sep = ", or "))
+}
+
+#' @title Find Suggestions
+#'
+#' @param str (`character(1)`)\cr
+#'   String.
+#' @param candidates (`character()`)\cr
+#'   Candidate strings.
+#' @param threshold (`numeric(1)`)\cr
+#'   Percentage value of characters when sorting `candidates` by distance
+#' @param max_candidates (`integer(1)`)\cr
+#'   Maximum number of candidates to return.
+#' @param ret_similarity (`logical(1)`)\cr
+#'   Return similarity values instead of names.
+#' @return (`character(1)`). Either suggested candidates from `candidates` or an empty string if no close match is found.
+find_suggestions = function(str, candidates, threshold = 0.2, max_candidates = 3L, ret_distances = FALSE) {
+  candidates = unique(candidates)
+  D = set_names(adist(str, candidates, ignore.case = TRUE, partial = TRUE)[1L, ], candidates)
+  sorted = head(sort(D[D <= ceiling(threshold * nchar(str))]), max_candidates)
+  if (ret_distances) {
+    sorted
+  } else {
+    names(sorted)
+  }
 }

tests/testthat/test_Dictionary.R

@@ -125,3 +125,24 @@ test_that("#115", {
   d$add("a", function() A$new())
   expect_error(dictionary_sugar_get(d, "a", y = 10), "Did you mean")
 })
+
+test_that("similar entries in other dictionaries", {
+  obj = R6Class("A", public = list(x = NULL))
+
+  d = Dictionary$new()
+  d$add("abc", obj)
+
+  d_lookup1 = Dictionary$new()
+  d_lookup1$add("cde", obj)
+
+  expect_error(dictionary_sugar_get(d, "cde", .dicts_suggest = list("lookup1" = d_lookup1)), "Similar entries in other dictionaries")
+
+  d_lookup2 = Dictionary$new()
+  d_lookup2$add("bcd", obj)
+
+  # Dictionaries ordered by closest match per dictionary
+  expect_error(
+    dictionary_sugar_get(d, "cde", .dicts_suggest = list("lookup1" = d_lookup1, "lookup2" = d_lookup2)),
+    "Similar entries in other dictionaries.*lookup1.*lookup2"
+  )
+})