add dials parameters and a tunable method

DESCRIPTION

@@ -14,7 +14,9 @@ Depends:
     recipes
 Imports: 
     cli,
+    dials,
     dplyr,
+    generics,
     glue,
     IDPmisc,
     purrr,

NAMESPACE

@@ -24,17 +24,22 @@ S3method(tidy,step_measure_input_wide)
 S3method(tidy,step_measure_output_long)
 S3method(tidy,step_measure_output_wide)
 S3method(tidy,step_measure_savitzky_golay)
+S3method(tunable,step_measure_savitzky_golay)
+export(differentiation_order)
 export(step_measure_input_long)
 export(step_measure_input_wide)
 export(step_measure_output_long)
 export(step_measure_output_wide)
 export(step_measure_savitzky_golay)
 export(subtract_rf_baseline)
+export(tunable)
+export(window_side)
 import(recipes)
 import(rlang)
 importFrom(dplyr,arrange)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
+importFrom(generics,tunable)
 importFrom(glue,glue)
 importFrom(tibble,tibble)
 importFrom(utils,globalVariables)

R/parameters.R

@@ -0,0 +1,81 @@
+#' Parameter for measure steps
+#'
+#' `window_side()` and `differentiation_order()` are used with Savitzky-Golay
+#' processing.
+#'
+#' @param range A two-element vector holding the _defaults_ for the smallest and
+#' largest possible values, respectively. If a transformation is specified,
+#' these values should be in the _transformed units_.
+#'
+#' @param trans A `trans` object from the `scales` package, such as
+#' `scales::transform_log10()` or `scales::transform_reciprocal()`. If not provided,
+#' the default is used which matches the units used in `range`. If no
+#' transformation, `NULL`.
+#'
+#' @details
+#' This parameter is often used to correct for zero-count data in tables or
+#' proportions.
+#'
+#' @return A function with classes `"quant_param"` and `"param"`.
+#' @examples
+#' window_side()
+#' differentiation_order()
+#' @export
+window_side <- function(range = c(1L, 5L), trans = NULL) {
+  dials::new_quant_param(
+    type = "integer",
+    range = range,
+    inclusive = c(TRUE, TRUE),
+    trans = trans,
+    label = c(window_side = "Window Size (one side)"),
+    finalize = NULL
+  )
+}
+
+#' @rdname window_side
+#' @export
+differentiation_order <- function(range = c(0L, 4L), trans = NULL) {
+  dials::new_quant_param(
+    type = "integer",
+    range = range,
+    inclusive = c(TRUE, TRUE),
+    trans = trans,
+    label = c(differentiation_order = "Differentiation Order"),
+    finalize = NULL
+  )
+}
+
+
+
+
+# ------------------------------------------------------------------------------
+# Tunable methods
+
+#' @importFrom generics tunable
+#' @export
+generics::tunable
+
+#' tunable methods for measure
+#'
+#' These functions define what parameters _can_ be tuned for specific steps.
+#' They also define the recommended objects from the `dials` package that can be
+#' used to generate new parameter values and other characteristics.
+#' @param x A recipe step object
+#' @param ... Not used.
+#' @name tunable_measure
+#' @return A tibble object.
+#' @keywords internal
+#' @export
+tunable.step_measure_savitzky_golay <- function(x, ...) {
+  tibble::tibble(
+    name = c("window_side", "differentiation_order", "degree"),
+    call_info = list(
+      list(pkg = "measure", fun = "window_side"),
+      list(pkg = "measure", fun = "differentiation_order"),
+      list(pkg = "dials", fun = "degree_int", range = c(1L, 5L))
+    ),
+    source = "recipe",
+    component = "step_measure_savitzky_golay",
+    component_id = x$id
+  )
+}

tests/testthat/_snaps/savitzky_golay.md

@@ -84,3 +84,41 @@
       Caused by error in `prep()`:
       ! The `window_side` argument to `step_measure_savitzky_golay()` should be an integer greater than 0.
 
+# savitzky-golay tuning parameters
+
+    Code
+      window_side()
+    Output
+      Window Size (one side) (quantitative)
+      Range: [1, 5]
+
+---
+
+    Code
+      window_side(c(2, 10))
+    Output
+      Window Size (one side) (quantitative)
+      Range: [2, 10]
+
+---
+
+    Code
+      differentiation_order()
+    Output
+      Differentiation Order (quantitative)
+      Range: [0, 4]
+
+---
+
+    Code
+      recipe(water + fat + protein ~ ., data = meats_long) %>% update_role(id,
+        new_role = "id") %>% step_measure_input_long(transmittance, location = vars(
+        channel)) %>% step_measure_savitzky_golay() %>% tunable()
+    Output
+      # A tibble: 3 x 5
+        name                  call_info        source component           component_id
+        <chr>                 <list>           <chr>  <chr>               <chr>       
+      1 window_side           <named list [2]> recipe step_measure_savit~ measure_sav~
+      2 differentiation_order <named list [2]> recipe step_measure_savit~ measure_sav~
+      3 degree                <named list [3]> recipe step_measure_savit~ measure_sav~
+

tests/testthat/test_savitzky_golay.R

@@ -99,3 +99,18 @@ test_that("savitzky-golay inputs", {
     }
   }
 })
+
+
+test_that("savitzky-golay tuning parameters", {
+  expect_snapshot(window_side())
+  expect_snapshot(window_side(c(2, 10)))
+  expect_snapshot(differentiation_order())
+
+  expect_snapshot(
+    recipe(water + fat + protein ~ ., data = meats_long) %>%
+    update_role(id, new_role = "id") %>%
+    step_measure_input_long(transmittance, location = vars(channel)) %>%
+    step_measure_savitzky_golay() %>%
+    tunable()
+  )
+})