parameters with choices and multiple = TRUE should use a select…

… input (#2576)

NEWS.md

@@ -3,6 +3,27 @@ rmarkdown 2.29
 
 - `find_external_resources()` now correctly detects knitr child document provided with option like `child = c("child.Rmd")` (thanks, @rempsyc, #2574).
 
+- `knit_params_ask()` uses a `select` input for parameters which allow multiple selected values. Previously, a `radio` input was incorrectly used when the parameter had a small number of choices.
+
+    ```yaml
+    params:
+        primaries:
+            choices: ["red", "yellow", "blue"]
+            multiple: true
+    ```
+    
+    When `multiple` is not enabled, parameter configuration still uses `radio` when there are fewer than five choices.
+
+    The `input` parameter field can still be used to force the configuration control.
+
+    ```yaml
+    params:
+        grade:
+            input: radio
+            choices: ["A", "B", "C", "D", "F"]
+    ```
+
+
 rmarkdown 2.28
 ================================================================================
 

R/params.R

@@ -161,11 +161,13 @@ params_get_input <- function(param) {
   input <- param$input
   if (is.null(input)) {
     if (!is.null(param$choices)) {
-      ## radio buttons for a small number of choices, select otherwise.
-      if (length(param$choices) <= 4) {
-        input <- "radio"
-      } else {
+      ## select for a large number of choices and multiple choices.
+      if (isTRUE(param$multiple)) {
+        input <- "select"
+      } else if (length(param$choices) > 4) {
         input <- "select"
+      } else {
+        input <- "radio"
       }
     } else {
       ## Not choices. Look at the value type to find what input control we
@@ -219,8 +221,7 @@ params_configurable <- function(param) {
   }
   # Some inputs (like selectInput) support the selection of
   # multiple entries through a "multiple" argument.
-  multiple_ok <- (!is.null(param$multiple) && param$multiple)
-  if (multiple_ok) {
+  if (isTRUE(param$multiple)) {
     return(TRUE)
   }
   # sliderInput supports either one or two-value inputs.

tests/testthat/test-params.R

@@ -105,6 +105,86 @@ test_that("parameters are configurable", {
       value = c(10, 20, 30))))
 })
 
+test_that("params_get_input", {
+  # input derived from value type.
+  expect_equal(params_get_input(list(
+    value = TRUE
+  )), "checkbox")
+  expect_equal(params_get_input(list(
+    value = as.integer(42)
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = 7.5
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = "character"
+  )), "text")
+  expect_equal(params_get_input(list(
+    value = Sys.Date()
+  )), "date")
+  expect_equal(params_get_input(list(
+    value = Sys.time()
+  )), "datetime")
+
+  # numeric becomes a slider with both min and max
+  expect_equal(params_get_input(list(
+    value = as.integer(42),
+    min = 0
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = as.integer(42),
+    max = 100
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = as.integer(42),
+    min = 0,
+    max = 100
+  )), "slider")
+  expect_equal(params_get_input(list(
+    value = 7.5,
+    min = 0
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = 7.5,
+    max = 10
+  )), "numeric")
+  expect_equal(params_get_input(list(
+    value = 7.5,
+    min = 0,
+    max = 10
+  )), "slider")
+
+  # choices implies radio or select
+  expect_equal(params_get_input(list(
+    value = "red",
+    choices = c("red", "green", "blue")
+  )), "radio")
+  expect_equal(params_get_input(list(
+    value = "red",
+    multiple = TRUE,
+    choices = c("red", "green", "blue")
+  )), "select")
+  expect_equal(params_get_input(list(
+    value = "red",
+    choices = c("red", "green", "blue", "yellow", "black", "white")
+  )), "select")
+  expect_equal(params_get_input(list(
+    value = "red",
+    multiple = TRUE,
+    choices = c("red", "green", "blue", "yellow", "black", "white")
+  )), "select")
+
+  # explicit input overrides inference
+  expect_equal(params_get_input(list(
+    input = "slider",
+    value = 42
+  )), "slider")
+  expect_equal(params_get_input(list(
+    input = "file",
+    value = "data.csv"
+  )), "file")
+})
+
 test_that("params hidden w/o show_default", {
 
   # file input is always NULL