Standardize map() when .f is an index rather than a function

NEWS.md

@@ -5,6 +5,7 @@
     * This helps avoid spurious feedback when comparing code that involves S3 methods. If the user's code differs from the solution code in a way that means a different S3 method is used, the standardized code may gain different default arguments. This could result in feedback about missing or surplus arguments that were added by code standardization rather than by the student, which is not actionable feedback. By no longer looking for default arguments that are missing or surplus in the user code, we ensure that students receive more actionable feedback, likely about the incorrect argument that resulted in the use of a different S3 method.
 * The `gradethis_equal.list()` method is now only used if both `x` and `y` are bare lists (as defined by `rlang::is_bare_list()`) (#357).
     * This fixes a bug where a list could be marked as equal to another object with the same contents but a different class, e.g. `list(a = 1, b = 2)` and `c(a = 1, b = 2)` or `data.frame(a = 1, b = 2)`.
+* Fix bug where `call_standardise_formals()` would fail when given a `purrr::map()` function where `.f` is an index rather than a function (#359).
 
 # gradethis 0.2.13
 

R/call_standardise_formals.R

@@ -157,8 +157,8 @@ dot_args_standardise <- function(code, fn, mappers, dot_args, env) {
     x_arg <- code$.x
     try(x_arg <- rlang::eval_bare(x_arg, env)[[1]], silent = TRUE)
 
-    call <- rlang::call2(f_arg, x_arg, !!!dot_args)
-    n_args <- 1
+    args <- append(dot_args, list(x_arg), after = 0)
+    n_mapped_args <- 1
   } else if (purrr::some(mappers$map2_functions, identical, fn)) {
     f_arg <- code$.f
 
@@ -168,8 +168,8 @@ dot_args_standardise <- function(code, fn, mappers, dot_args, env) {
     y_arg <- code$.y
     try(y_arg <- rlang::eval_bare(y_arg, env)[[1]], silent = TRUE)
 
-    call <- rlang::call2(f_arg, x_arg, y_arg, !!!dot_args)
-    n_args <- 2
+    args <- append(dot_args, list(x_arg, y_arg), after = 0)
+    n_mapped_args <- 2
   } else if (purrr::some(mappers$imap_functions, identical, fn)) {
     f_arg <- code$.f
 
@@ -179,36 +179,44 @@ dot_args_standardise <- function(code, fn, mappers, dot_args, env) {
     x_arg <- x_args[[1]]
     y_arg <- names(x_args)[[1]]
 
-    call <- rlang::call2(f_arg, x_arg, y_arg, !!!dot_args)
-    n_args <- 2
+    args <- append(dot_args, list(x_arg, y_arg), after = 0)
+    n_mapped_args <- 2
   } else if (purrr::some(mappers$lmap_functions, identical, fn)) {
     f_arg <- code$.f
 
     x_arg <- code$.x
     try(x_arg <- rlang::eval_bare(x_arg, env)[1], silent = TRUE)
 
-    call <- rlang::call2(f_arg, x_arg, !!!dot_args)
-    n_args <- 1
+    args <- append(dot_args, list(x_arg), after = 0)
+    n_mapped_args <- 1
   } else if (purrr::some(mappers$pmap_functions, identical, fn)) {
     f_arg <- code$.f
 
     l_arg <- code$.l
     try(l_arg <- rlang::eval_bare(l_arg, env), silent = TRUE)
     try(l_arg <- purrr::map(l_arg, 1), silent = TRUE)
 
-    call <- rlang::call2(f_arg, !!!l_arg, !!!dot_args)
-    n_args <- length(l_arg)
+    args <- append(dot_args, l_arg, after = 0)
+    n_mapped_args <- length(l_arg)
   } else if (purrr::some(mappers$apply_functions, identical, fn)) {
     f_arg <- code$FUN
 
     x_arg <- code$X
     try(x_arg <- rlang::eval_bare(x_arg, env)[[1]], silent = TRUE)
 
-    call <- rlang::call2(f_arg, x_arg, !!!dot_args)
-    n_args <- 1
+    args <- append(dot_args, list(x_arg), after = 0)
+    n_mapped_args <- 1
   }
 
-  return(as.list(call_standardise_formals(call, env))[-seq_len(n_args + 1)])
+  tryCatch(
+    {
+      call <- rlang::call2(f_arg, !!!args)
+      as.list(call_standardise_formals(call, env))[-seq_len(n_mapped_args + 1)]
+    },
+    error = function(e) {
+      dot_args
+    }
+  )
 }
 
 mapping_function_list <- function() {

tests/testthat/test-call_standardise_formals.R

@@ -153,6 +153,21 @@ test_that("Standardize call with passed ... args", {
     )
   )
 
+  expect_equal(
+    call_standardise_formals(quote(
+      purrr::map2(list(1:2, 1:3), list(1:2, 1:3), mean, TRUE)
+    )),
+    quote(
+      purrr::map2(
+        .x = list(1:2, 1:3),
+        .y = list(1:2, 1:3),
+        .f = mean,
+        na.rm = TRUE,
+        .progress = FALSE
+      )
+    )
+  )
+
   expect_equal(
     call_standardise_formals(quote(
       purrr::imap(c("0" = 1), mean, TRUE)
@@ -180,6 +195,20 @@ test_that("Standardize call with passed ... args", {
     )
   )
 
+  expect_equal(
+    call_standardise_formals(quote(
+      purrr::pmap(list(list(1:2, 1:3), list(1:2, 1:3)), mean, TRUE)
+    )),
+    quote(
+      purrr::pmap(
+        .l = list(list(1:2, 1:3), list(1:2, 1:3)),
+        .f = mean,
+        na.rm = TRUE,
+        .progress = FALSE
+      )
+    )
+  )
+
   a <- quote(vapply(list(1:3, 4:6), mean, numeric(1), 0, TRUE))
   b <- quote(vapply(list(1:3, 4:6), mean, numeric(1), trim = 0, TRUE))
   c <- quote(vapply(list(1:3, 4:6), mean, numeric(1), 0, na.rm = TRUE))
@@ -204,6 +233,30 @@ test_that("Standardize call with passed ... args", {
   testthat::expect_equal(call_standardise_formals(d), xd)
 })
 
+test_that("Standardize map() when .f is an index", {
+  expect_equal(
+    call_standardise_formals(quote(
+      purrr::map(list(c(1, 2), c("a", "b")), 2)
+    )),
+    quote(
+      purrr::map(.x = list(c(1, 2), c("a", "b")), .f = 2, .progress = FALSE)
+    )
+  )
+
+  expect_equal(
+    call_standardise_formals(quote(
+      purrr::map(list(c(a = 1, b = 2), c(a = "a", b = "b")), "b")
+    )),
+    quote(
+      purrr::map(
+        .x = list(c(a = 1, b = 2), c(a = "a", b = "b")),
+        .f = "b",
+        .progress = FALSE
+      )
+    )
+  )
+})
+
 test_that("Standardize call with ggplot2 functions", {
   skip_if_not_installed("ggplot2")
   withr::local_package("ggplot2")