initial hyperparameter listing

NAMESPACE

@@ -52,6 +52,7 @@ export(listOMLEvaluationMeasures)
 export(listOMLFlows)
 export(listOMLRunEvaluations)
 export(listOMLRuns)
+export(listOMLSetup)
 export(listOMLStudies)
 export(listOMLTaskTypes)
 export(listOMLTasks)

R/download.R

@@ -116,7 +116,7 @@ doHTTRCall = function(method = "GET", url, query, body = NULL) {
     error = parseError(server.response)
 
     if (!is.null(error$message)) {
-      if (error$message == "No results") {
+      if (grepl("No results", error$message)) {
         messagef("Server response: %s", error$message)
         return(NULL)
       }

R/helpers.R

@@ -101,14 +101,16 @@ assertSortedInt = function(x, ..., .var.name = vname(x)) {
   assertSorted(x, .var.name = .var.name)
 }
 
-generateAPICall = function(api.call, task.id = NULL, flow.id = NULL, run.id = NULL, uploader.id = NULL,
-  task.type = NULL, number.of.instances = NULL, number.of.features = NULL, number.of.classes = NULL,
+generateAPICall = function(api.call, task.id = NULL, flow.id = NULL,
+  setup.id = NULL, run.id = NULL, uploader.id = NULL, task.type = NULL, 
+  number.of.instances = NULL, number.of.features = NULL, number.of.classes = NULL,
   number.of.missing.values = NULL, tag = NULL, data.name = NULL, data.tag = NULL,
   evaluation.measure = NULL, limit = NULL, offset = NULL, status = NULL) {
 
   assertString(api.call)
   task.id = collapseNotScientific(assertIntegerish(task.id, null.ok = TRUE))
   flow.id = collapseNotScientific(assertIntegerish(flow.id, null.ok = TRUE))
+  setup.id = collapseNotScientific(assertIntegerish(setup.id, null.ok = TRUE))
   run.id = collapseNotScientific(assertIntegerish(run.id, null.ok = TRUE))
   uploader.id = collapseNotScientific(assertIntegerish(uploader.id, null.ok = TRUE))
 
@@ -139,6 +141,7 @@ generateAPICall = function(api.call, task.id = NULL, flow.id = NULL, run.id = NU
   url.args = list(
     "task" = task.id,
     "flow" = flow.id,
+    "setup" = setup.id,
     "run" = run.id,
     "uploader" = uploader.id,
     "tag" = tag,

R/listOMLSetup.R

@@ -0,0 +1,91 @@
+.listOMLSetup = function(setup.id = NULL, flow.id = NULL, 
+  limit = 1000, offset = NULL, verbosity = NULL) {
+  api.call = generateAPICall(api.call = "json/setup/list",
+    setup.id = setup.id, flow.id = flow.id, limit = limit, offset = offset)
+
+  content = doAPICall(api.call, file = NULL, method = "GET", verbosity = verbosity)
+  if (is.null(content)) return(data.frame())
+
+  # Get entries, which are grouped by setup.id
+  setups = fromJSON(txt = content, simplifyVector = FALSE)$setups$setup
+
+  setups = extractRecursiveList(setups)
+  if (length(setups) == 0) return(data.frame())
+  # setups = lapply(names(setups), function(i) Map(c, setups[[i]], setup_id = i))
+
+  # We need to postprocess the list
+  setups = lapply(setups, function(setup) {
+    # for each setup.id check if it has one or more than one hyperparameters
+    if (is.null(names(setup))) {
+      # if there are more than two entries (hyperparameters) create a dataframe:
+      ret = rbindlist(lapply(setup, function(x) {
+        replace(x, which(vlapply(x, is.list)), NA_character_)
+      }))
+    } else {
+      # if there is only one entry (hyperparameter) do this to create a dataframe:
+      ret = setDF(replace(setup, which(vlapply(setup, is.list)), NA_character_))
+    }
+  })
+  # rbind the list
+  # FIXME: rbindlist does not work anymore therefore do this:
+  #nrows = vnapply(setups, nrow)
+  #setup.id = rep(names(nrows[nrows != 0]), nrows[nrows != 0])
+  #setups = do.call(rbind, setups)
+  #setups$setup.id = setup.id
+  #setups = cbind(data.frame(setup.id = setup.id, stringsAsFactors = FALSE), setups)
+  #setups = rbindlist(setups, idcol = "setup_id")
+  setups = rbindlist(setups, fill = TRUE)
+  setups = lapply(setups, type.convert, as.is = TRUE)
+  setups = as.data.frame(setups, stringsAsFactors = FALSE)
+
+  #   # We need to postprocess the list
+  #   setups = lapply(names(setups), function(i) {
+  #     if (is.null(names(setups[[i]]))) {
+  #       ret = Map(c, setups[[i]], setup_id = i)
+  #       lapply(ret, function(x) replace(x, which(vlapply(x, is.list)), NA_character_))
+  #     } else {
+  #       list(c(replace(x, which(vlapply(x, is.list)), NA_character_), setup_id = i))
+  #     }
+  #   })
+  #   # rbind the list
+  #   setups = rbindlist(unlist(setups, recursive = FALSE))
+
+  cn = c("setup_id", "flow_id", "parameter_name", "data_type", "default_value", "value")
+  setups = setups[, cn]
+  names(setups) = convertNamesOMLToR(names(setups))
+  return(setups)
+}
+
+extractRecursiveList = function(l) {
+  if ("parameter" %in% names(l)) {
+    setupid = list(setup_id = l$setup_id)
+    lapply(l$parameter, function(x) c(setupid, x))
+  } else {
+    if (is.list(l)) {
+      unlist(lapply(l, function(i) {
+        extractRecursiveList(i)
+      }), recursive = FALSE)
+    } else {
+      return(data.table())
+    }
+  }
+}
+
+#' @title List hyperparameters of Flows.
+#'
+#' @description
+#' Lists hyperparameter settings for flows.
+#'
+#' @template note_memoise
+#'
+#' @param setup.id [\code{integer(1)}]\cr
+#'   ID of the setup (which is basically an ID for the parameter configuration).
+#' @template arg_flow.id
+#' @template arg_limit
+#' @template arg_offset
+#' @template arg_verbosity
+#' @return [\code{data.frame}].
+#' @family listing functions
+#' @export
+#' @example inst/examples/listOMLSetup.R
+listOMLSetup = memoise(.listOMLSetup)

inst/examples/listOMLSetup.R

@@ -0,0 +1,3 @@
+\dontrun{
+  listOMLSetup(limit = 1)
+}

tests/testthat/test_server_listOMLSetup.R

@@ -0,0 +1,44 @@
+context("listOMLSetup")
+
+skip_on_cran()
+
+test_that("listOMLSetup", {
+  exp.cols = c("setup.id", "flow.id", "parameter.name", "data.type", "default.value", "value")
+  df = .listOMLSetup(limit = 1)
+  expect_data_frame(df)
+  if (nrow(df) > 0) {
+    expect_subset(exp.cols, colnames(df))
+    expect_true(length(unique(df$setup.id)) == 1)
+  }
+
+  df = .listOMLSetup(limit = 10)
+  expect_data_frame(df)
+  if (nrow(df) > 0) {
+    expect_subset(exp.cols, colnames(df))
+    expect_true(length(unique(df$setup.id)) <= 10)
+  }
+
+  with_main_server({
+    df = .listOMLSetup(limit = 10)
+    expect_data_frame(df)
+    if (nrow(df) > 0) {
+      expect_subset(exp.cols, colnames(df))
+      expect_true(length(unique(df$setup.id)) <= 10)
+    }
+
+    df = .listOMLSetup(flow.id = 5685)
+    expect_data_frame(df)
+    if (nrow(df) > 0) {
+      expect_subset(exp.cols, colnames(df))
+      expect_true(unique(df$flow.id) == 5685)
+    }
+
+    df = .listOMLSetup(setup.id = 9008)
+    expect_data_frame(df)
+    if (nrow(df) > 0) {
+      expect_subset(exp.cols, colnames(df))
+      expect_true(unique(df$setup.id) == 9008)
+      expect_true(length(unique(df$flow.id)) == 1)
+    }
+  })
+})