R/OMLTask_Class.R

In openml/r: Open Machine Learning and Open Data Platform

#' @title Construct OMLTask.
#'
#' @description
#' More details about the elements of a \code{OMLTask} can be found in the
#' \href{https://docs.openml.org/}{documentation}.
#'
#' @param task.id [\code{integer(1)}]\cr
#'   The ID of this task. Generated by the API.
#' @param task.type [\code{character(1)}]\cr
#'   The task type of this task. Task types can be browsed and created on the OpenML website.
#'   See also \code{\link{listOMLTaskTypes}} for a list of all available tasks.
#' @param input [\code{list}]\cr
#'   The inputs given for this task (i.e. data.set, estimation.procedure, evaluation.measures, cost.matrix).
#' @param parameters [\code{list}]\cr
#'   Parameter settings for this task (depends on the task type).
#' @param output [\code{list}]\cr
#'   Outputs expected after running this task.
#' @param tags [\code{character}]\cr
#'   Optional tags describing the (data of the) task.
#' @family task-related functions
#' @export
#' @aliases OMLTask
makeOMLTask = function(task.id, task.type, input, parameters = list(), output, tags = NA_character_) {

  task.id = asInt(task.id)
  assertString(task.type)
  assertList(input)
  assertList(parameters)
  assertList(output)
  assertCharacter(tags, all.missing = TRUE)

  makeS3Obj("OMLTask",
    task.id = task.id,
    task.type = task.type,
    input = input,
    parameters = parameters,
    output = output,
    tags = tags
  )
}

#' @export
print.OMLTask = function(x, ...) {
  catNotNA = function(s, val, fun = identity, ...) {
    if (!all(is.na(val)))
      catf("%s %s", s, fun(val, ...))
  }

  catf("\nOpenML Task %i :: (Data ID = %i)", x$task.id, x$input$data.set$desc$id)
  catNotNA("  Task Type            :", x$task.type)
      catf("  Data Set             : %s :: (Version = %s, OpenML ID = %i)", x$input$data.set$desc$name,
       x$input$data.set$desc$version, x$input$data.set$desc$id)
  catNotNA("  Target Feature(s)    :", x$input$data.set$target.features, fun = collapse, sep = ", ")

  ptasks = paste(x$tags, collapse = ", ")
  if (nchar(ptasks) > 80) {
    tags_cut = BBmisc::clipString(ptasks, 80)
    catNotNA("  Tags                 :", tags_cut)
  } else {
    catNotNA("  Tags                 :", x$tags, fun = collapse, sep = ", ")
  }
  if (!is.na(x$input$estimation.procedure$type)) {
    est.type = x$input$estimation.procedure$type
    strat = x$input$estimation.procedure$parameters$stratified_sampling
    strat = ifelse(!is.null(strat) && as.logical(strat), "Stratified ", "")
    n.rep = x$input$estimation.procedure$parameters$number_repeats
    n.rep = ifelse(!is.null(n.rep), as.character(n.rep), "")
    n.folds = x$input$estimation.procedure$parameters$number_folds
    n.folds = ifelse(!is.null(n.folds) && !is.na(n.folds), paste(" x", n.folds, "folds"), " rep(s)")
    catf("  Estimation Procedure : %s%s (%s%s)", strat, est.type, n.rep, n.folds)
  }
  if (!all(x$input$evaluation.measures == ""))
    catNotNA("  Evaluation Measure(s):", x$input$evaluation.measures, fun = collapse, sep = ", ")
}


#' @export
as.data.frame.OMLTask = function(x, ...) {
  as.data.frame(x$input$data.set$data)
}

#' @export
as.data.table.OMLTask = function(x, ...) {
  as.data.table(x$input$data.set$data)
}