Adds kf_make_component

NAMESPACE

@@ -8,5 +8,6 @@ export(kf_add_metric)
 export(kf_add_roc)
 export(kf_init_metrics)
 export(kf_init_ui_meta)
+export(kf_make_component)
 export(kf_write_output)
 importFrom(magrittr,"%>%")

R/kf_make_component.R

@@ -1,4 +1,38 @@
-kf_make_component <- function(rfunction, name, description, image) {
+#' Make Kubeflow component from a function
+#'
+#' Given a defined R function export a YAML file for Kubeflow to consume.
+#'
+#' Names of metrics and ui metadata arguments are renamed to required
+#' specifications. Kubeflow likes arguments to be typed, which R doesn't handle
+#' naturally. This function looks for a slug at the end of each argument to
+#' determine the type. For example, `table_name_string` would be considered an
+#' input String. Output paths are identified by ending in `_out`. Supported
+#' translations are:
+#'
+#' Inputs
+#' * `_string` = String
+#' * `_int` = Integer
+#' * `_bool` = Bool
+#' * `_float` = Float
+#'
+#' Outputs
+#' * `_out` = outputPath
+#' * `_metrics` = Metrics
+#' * `_uimeta` = UI_metadata
+#'
+#' @param rfunction Name of target function.
+#' @param name Name of component.
+#' @param description Description of component.
+#' @param image Location of Docker image.
+#' @param file Location to write yaml. Optional.
+#'
+#' @return Component YAML
+#' @export
+#'
+#' @examples
+#' tfun <- function(table_string, pred_count_int, path_metrics) 2 * 2
+#' kf_make_component("tfun", "Test Component", "Test out the component", "gcr.io/test/test")
+kf_make_component <- function(rfunction, name, description, image, file) {
   # Create base YAML
   yaml_base <-
     list(
@@ -15,25 +49,49 @@ kf_make_component <- function(rfunction, name, description, image) {
       )
     )
 
+  # Parse Function Name
+  rfun <- stringr::str_split(rfunction, "::", simplify = TRUE)
+
   # Parse out Input/Output args
-  fun_args <- formalArgs(rfunction)
-  input_args <- purrr::keep(fun_args, stringr::str_ends, pattern = "_string|_num")
-  output_args <- purrr::keep(fun_args, stringr::str_ends, pattern = "_out")
+  fun_args <- methods::formalArgs(rfun[ncol(rfun)])
+  input_args <- purrr::keep(fun_args, stringr::str_ends, pattern = "_string|_int|_bool|_float")
+  output_args <- purrr::keep(fun_args, stringr::str_ends, pattern = "_out|_metrics|_uimeta")
 
   # Write Input/Output args
-  yaml_base$inputs <- purrr::map(input_args, ~list(name = .))
-  yaml_base$outputs <- purrr::map(output_args, ~list(name = .))
+  yaml_base$inputs <- purrr::map(input_args, ~list(name = ., type = find_kf_type(.)))
+  yaml_base$outputs <- purrr::map(output_args, ~list(name = name_fixer(.), type = find_kf_type(.)))
+
+  # Rename metrics/ui outputs
 
   # Write Implementation Args
-  yaml_base$implementation$container$args <- as.list(setNames(fun_args, find_arg_type(fun_args)))
+  yaml_base$implementation$container$args <- purrr::map(fun_args, ~as.list(setNames(name_fixer(.), find_arg_type(.))))
 
   # Write Function Call
-  arg_calls <- paste0("args[", 1:length(fun_args), "]", collapse = ", ")
+  arg_calls <- paste0("args[", 1:length(fun_args), "]", collapse = ",")
   yaml_base$implementation$container$command <- list(
     "Rscript",
-    "-e", "args <- commandArgs(trailingOnly = TRUE)",
-    "-e", paste0(rfunction, '(', arg_calls, ")")
+    "-e", 'args<-commandArgs(trailingOnly=TRUE)',
+    "-e", paste0(paste(rfun, collapse = "::"), '(', arg_calls, ")")
   )
 
-  yaml::as.yaml(yaml_base)
+  if (missing(file)) {
+    return(yaml::as.yaml(yaml_base))
+  }
+
+  yaml::write_yaml(yaml_base, file)
+}
+
+name_fixer <- function(x) {
+  x_stub <- stringr::str_extract(x, "[^_]+$")
+  # When argument ends in "_metrics":
+  if (x_stub == "metrics") {
+    return("mlpipeline_metrics")
+  }
+
+  # When argument ends in "_uimeta":
+  if (x_stub == "uimeta") {
+    return("mlpipeline_ui_metadata")
+  }
+
+  x
 }

R/utils.R

@@ -1,9 +1,13 @@
 find_kf_type <- function(x) {
-  x <- str_extract(x, "[^_]+$")
+  x <- stringr::str_extract(x, "[^_]+$")
 
   lookup <- list(
     string = "String",
-    num = "Numeric"
+    int = "Integer",
+    float = "Float",
+    bool = "Bool",
+    metrics = "Metrics",
+    uimeta = "UI_metadata"
   )
 
   lookup[[x]]
@@ -12,5 +16,5 @@ find_kf_type <- function(x) {
 find_arg_type <- function(x) {
   x <- stringr::str_extract(x, "[^_]+$")
 
-  ifelse(x %in% c("string", "num"), "inputValue", "outputPath")
+  ifelse(x %in% c("string", "int", "float", "bool"), "inputValue", "outputPath")
 }

tests/testthat/test-kf_make_component.R

@@ -0,0 +1,13 @@
+comp_fun <- function(location_string, count_int, weight_float, flag_bool, path_metrics,
+                     path_metaui, results_out) {
+  2 * 2
+}
+
+test_that("File is written", {
+  tfile <- tempfile()
+
+  kf_make_component("mean", "Test Function", "A function for testing",
+                    "docker/docker", file = tfile)
+
+  expect_true(file.exists(tfile))
+})