Suggest typo fixes in arg_match() (#913)

Fixes #798

NAMESPACE

@@ -526,5 +526,6 @@ export(wref_value)
 export(zap)
 importFrom(stats,median)
 importFrom(stats,quantile)
+importFrom(utils,adist)
 importFrom(utils,str)
 useDynLib(rlang, .registration = TRUE)

NEWS.md

@@ -1,13 +1,16 @@
 
 # rlang (development version)
 
-* arg_match now gives an error if argument is of length greater than 1 and doesn't exactly match the values input, similar to base `match.arg`. Added as part of Tidyverse Developer Day (#914, @AliciaSchep) 
+* `arg_match()` now detects and suggests possible typos in provided arguments
+  (@jonkeane, #798).
+
+* `arg_match()` now gives an error if argument is of length greater than 1 and doesn't exactly
+  match the values input, similar to base `match.arg` (#914, @AliciaSchep) 
 
 # rlang 0.4.4
 
 * Maintenance release for CRAN.
 
-
 # rlang 0.4.3
 
 * You can now use glue syntax to unquote on the LHS of `:=`. This

R/arg.R

@@ -14,6 +14,7 @@
 #'   the values are taken from the function definition of the [caller
 #'   frame][caller_frame].
 #' @return The string supplied to `arg`.
+#' @importFrom utils adist
 #' @export
 #' @examples
 #' fn <- function(x = c("foo", "bar")) arg_match(x)
@@ -55,6 +56,14 @@ arg_match <- function(arg, values = NULL) {
     i_partial <- pmatch(arg, values)
     if (!is_na(i_partial)) {
       candidate <- values[[i_partial]]
+    }
+
+    i_close <- adist(arg, values) / nchar(values)
+    if (any(i_close <= 0.5)) {
+      candidate <- values[[which.min(i_close)]]
+    }
+
+    if (exists("candidate")) {
       candidate <- chr_quoted(candidate, "\"")
       msg <- paste0(msg, "\n", "Did you mean ", candidate, "?")
     }

tests/testthat/test-arg.R

@@ -4,8 +4,8 @@ test_that("matches arg", {
   myarg <- "foo"
   expect_identical(arg_match(myarg, c("bar", "foo")), "foo")
   expect_error(
-    regex = "`myarg` must be one of \"bar\" or \"baz\"",
-    arg_match(myarg, c("bar", "baz"))
+    arg_match(myarg, c("bar", "baz")),
+    "`myarg` must be one of \"bar\" or \"baz\""
   )
 })
 
@@ -25,11 +25,32 @@ test_that("uses first value when called with all values", {
 test_that("informative error message on partial match", {
   myarg <- "f"
   expect_error(
-    regex = "Did you mean \"foo\"?",
-    arg_match(myarg, c("bar", "foo"))
+    arg_match(myarg, c("bar", "foo")),
+    "Did you mean \"foo\"?"
   )
 })
 
+test_that("informative error message on a typo", {
+  verify_output("test-typo-suggest.txt", {
+    myarg <- "continuuos"
+    arg_match(myarg, c("discrete", "continuous"))
+    myarg <- "fou"
+    arg_match(myarg, c("bar", "foo"))
+    myarg <- "fu"
+    arg_match(myarg, c("ba", "fo"))
+
+    "# No suggestion when the edit distance is too large"
+    myarg <- "foobaz"
+    arg_match(myarg, c("fooquxs", "discrete"))
+    myarg <- "a"
+    arg_match(myarg, c("b", "c"))
+
+    "# Even with small possible typos, if there's a match it returns the match"
+    myarg <- "bas"
+    arg_match(myarg, c("foo", "baz", "bas"))
+  })
+})
+
 test_that("gets choices from function", {
   fn <- function(myarg = c("bar", "foo")) arg_match(myarg)
   expect_error(fn("f"), "Did you mean \"foo\"?")

tests/testthat/test-typo-suggest.txt

@@ -0,0 +1,35 @@
+> myarg <- "continuuos"
+> arg_match(myarg, c("discrete", "continuous"))
+Error: `myarg` must be one of "discrete" or "continuous"
+Did you mean "continuous"?
+
+> myarg <- "fou"
+> arg_match(myarg, c("bar", "foo"))
+Error: `myarg` must be one of "bar" or "foo"
+Did you mean "foo"?
+
+> myarg <- "fu"
+> arg_match(myarg, c("ba", "fo"))
+Error: `myarg` must be one of "ba" or "fo"
+Did you mean "fo"?
+
+
+No suggestion when the edit distance is too large
+=================================================
+
+> myarg <- "foobaz"
+> arg_match(myarg, c("fooquxs", "discrete"))
+Error: `myarg` must be one of "fooquxs" or "discrete"
+
+> myarg <- "a"
+> arg_match(myarg, c("b", "c"))
+Error: `myarg` must be one of "b" or "c"
+
+
+Even with small possible typos, if there's a match it returns the match
+=======================================================================
+
+> myarg <- "bas"
+> arg_match(myarg, c("foo", "baz", "bas"))
+[1] "bas"
+