R/extract_parameter_set_dials.R

In tidyclust: A Common API to Clustering

#' @rdname extract-tidyclust
#' @export
extract_parameter_set_dials.cluster_spec <- function(x, ...) {
  all_args <- generics::tunable(x)
  tuning_param <- generics::tune_args(x)

  res <-
    dplyr::inner_join(
      tuning_param %>% dplyr::select(-tunable, -component_id),
      all_args,
      by = c("name", "source", "component")
    ) %>%
    dplyr::mutate(object = map(call_info, eval_call_info))

  dials::parameters_constr(
    res$name,
    res$id,
    res$source,
    res$component,
    res$component_id,
    res$object
  )
}

eval_call_info <- function(x) {
  if (!is.null(x)) {
    # Look for other options
    allowed_opts <- c("range", "trans", "values")
    if (any(names(x) %in% allowed_opts)) {
      opts <- x[names(x) %in% allowed_opts]
    } else {
      opts <- list()
    }
    res <- try(
      rlang::eval_tidy(rlang::call2(x$fun, .ns = x$pkg, !!!opts)),
      silent = TRUE
    )
    if (inherits(res, "try-error")) {
      rlang::abort(
        glue::glue(
          "Error when calling {x$fun}(): {as.character(res)}"
        )
      )
    }
  } else {
    res <- NA
  }
  res
}