convert v4

hubverse-convert-v4.R

# NOTE: this is a WIP. It does not yet work. 

library(hubAdmin)
library(hubUtils)
library(glue)
tasks <- read_config(".", "tasks")

transform_to_v4 <- function(this_output_type,  kind = 1, task = 1, round = 1) {
  if (kind == "sample") {
    class(this_output_type) <- "output_type_item"
    return(this_output_type)
  }
  fun <- glue("create_output_type_{kind}")
  constructor <- match.fun(fun)
  ids <- this_output_type$output_type_id
  is_required <- !is.null(ids$required)
  if (!is.null(ids$required) && !is.null(ids$optional)) {
    cli::cli_alert_warning("In v4, you can have _either_ required or optional
      output_type_ids. 
      The {kind} output type of model task {task} in Round {round} has the following optional {.var output_type_id}s, which will be discarded: {ids$optional}"
    )
    ids$optional <- NULL
  }
  args <- list(
    required = if (is_required) ids$required else ids$optional,
    value_type = this_output_type$value$type,
    is_required = is_required,
    schema_version = "v4.0.0",
    branch = "br-v4.0.0"
  )
  if (kind %in% c("median", "mean")) {
    args$required <- NULL
  }
  if (kind == "quantile") {
    value_add <- list(
      value_minimum = this_output_type$value$minimum,
      value_maximum = this_output_type$value$maximum
    )
    args <- c(args, value_add)
  }
  unclass(do.call(constructor, args))
}

transform_output_types <- function(this_task, task = 1, round = 1) {
  output_types <- this_task$output_type
  ot <- purrr::imap(output_types, transform_to_v4, task = task, round = round)

  this_task$output_type <- list(output_type = ot)#do.call(create_output_type, ot)
  this_task
}

transform_tasks <- function(this_round, round = 1) {
  tasks <- this_round$model_tasks
  tasks <- purrr::imap(tasks, transform_output_types, round = round)
  this_round$model_tasks <- tasks
  this_round
}

transform_rounds <- function(rounds) {
  purrr::imap(rounds, transform_tasks)
}