add jsonToParset-Code with license notice

client/R/helpers.R

@@ -0,0 +1 @@
+../../common/helpers.R

client/R/json.R

@@ -0,0 +1 @@
+../../common/json.R

client/R/mboServiceSetConfigKey.R

@@ -1,6 +1,6 @@
 library("httr")
 
-mboServiceSetConfigKey = function(obj, minimize = NULL, noisy = NULL, propose.points = NULL, opt.restarts = NULL, opt.focussearch.maxit = NULL, opt.focussearch.points = NULL) {
+mboServiceSetConfigKey = function(obj, minimize = NULL, noisy = NULL, propose.points = NULL, opt.restarts = NULL, opt.focussearch.maxit = NULL, opt.focussearch.points = NULL, par.set = NULL) {
   if(!is.null(minimize)) {
     if(is.logical(minimize)) {
       mboServiceSetConfigKeyRaw(obj, "minimize", minimize)
@@ -54,4 +54,10 @@ mboServiceSetConfigKey = function(obj, minimize = NULL, noisy = NULL, propose.po
       stop("wrong type")
     }
   }
+
+  if(!is.null(par.set)) {
+    # TODO check type of par.set
+    as_json = parSetToJSON(par.set)
+    mboServiceSetConfigKeyRaw(obj, "par.set", as_json)
+  }
 }

client/tests/simple.R

@@ -1,8 +1,14 @@
+library("ParamHelpers")
 devtools::load_all()
-obj = mboServiceConnect("http://localhost:5000")
+
 data = data.frame(x = c(5,10), y = c(20,30))
-mboServiceSetConfigKeyRaw(obj, "par.set", "{}")
+par.set = makeNumericParamSet(len = 2)
+
+obj = mboServiceConnect("http://localhost:5000")  
+mboServiceSetConfigKey(obj, par.set = par.set)
 mboServiceUpload(obj, data)
+
 point = mboServicePropose(obj)
 print(point)
+
 mboServiceDisconnect(obj)

common/helpers.R

@@ -0,0 +1,107 @@
+# Source: https://github.com/jakob-r/mlrHyperopt/blob/master/R/helpers.R
+# Licensed under BSD 3-Clause License
+# See https://github.com/jakob-r/mlrHyperopt/blob/master/LICENSE
+
+# Convert Expressions to call (what we get from quote)
+convertExpressionToCall = function(req) {
+  if (is.expression(req)) {
+    if (length(req) == 1) {
+      return(req[[1]])
+    } else {
+      return(substitute(eval(x), list(x=req)))
+    }
+  }
+  req
+}
+
+# Checks if a Param Set fits to a Learer
+# @param learner [Learner]
+# @param par.set [ParamSet]
+# @return TRUE/FALSE and attribute "error" why FALSE
+checkLearnerParSet = function(learner, par.set) {
+  x = setdiff(names(par.set$pars), names(getLearnerParamSet(learner)$pars))
+  if (length(x) > 0L) {
+    stopf("The ParConfig contains Params that are not supported by the Learner: %s", collapse(x))
+  }
+  return(TRUE)
+}
+
+# Checks if Learner is valid or creates one
+checkLearner = function(learner) {
+  if (is.character(learner))
+    learner = makeLearner(learner)
+  else
+    assertClass(learner, classes = "Learner")
+  return(learner)
+}
+
+# All supported Values for discrete Parameters
+getSupportedDiscreteValues = function() {
+  c("character", "integer", "numeric", "data.frame", "matrix", "Date", "POSIXt", "factor", "complex", "raw", "logical")
+}
+
+# All arguments that can be stored as JSON, extended,
+# @param extended [logical]
+#   include arguments that need special treatment
+getSupportedParamFields = function(extended = FALSE) {
+  res = c("id", "type", "default", "upper", "lower", "values", "tunable", "allow.inf", "len")
+  if (extended)
+    res = c(res, "requires", "trafo")
+  res
+}
+
+# All arguments that are currently not supported for ex- or import.
+getForbiddenParamFields = function() {
+  c("special.vals")
+}
+
+# Checks if a ParamSet and par.vals make sense together
+# @param par.set - The Parameter Set
+# @param par.vals - the parameter settings that complement the par.set for a given learner
+# @param req.defaults - are defaults required in the param set
+# @param dictionary - necessary to evaluate the bounds
+checkParamSetAndParVals = function(par.set, par.vals = list(), req.defaults = TRUE, dictionary = NULL) {
+
+  if (is.null(dictionary)) {
+    dummy.task = makeClassifTask(id = "dummy", data = data.frame(a = 1:2, y = factor(1:2)), target = "y")
+    dictionary = getTaskDictionary(task = dummy.task)
+  }
+
+  # all params with box constraints?
+  if (!hasFiniteBoxConstraints(par.set, dict = dictionary)) {
+    stop("The ParamSet has infitite box constraints unsuitable for tuning!")
+  }
+
+  # all params have defaults?
+  par.set.ids = getParamIds(par.set)
+  par.set.default.ids = names(getDefaults(par.set, dict = dictionary))
+  no.defaults = setdiff(par.set.ids, par.set.default.ids)
+  if (req.defaults && length(no.defaults) > 0) {
+    stopf("The parameter(s) %s do(es) not have default values!", collapse(no.defaults))
+  }
+
+  # par.vals dont conflict with par.set?
+  conflicting.par.vals = intersect(names(par.vals), par.set.ids)
+  if (length(conflicting.par.vals) > 0) {
+    stopf("The par.vals %s are conflicting with the parameters defined in the par.set!", collapse(conflicting.par.vals))
+  }
+
+  invisible(TRUE)
+}
+
+getURL = function() {
+  #"http://62.113.241.202:3000/parconfigs" #this is the dev server
+  "http://mlrhyperopt.jakob-r.de/parconfigs"
+}
+
+
+#checks if values in y actually overwrite values in x
+# @param x - list
+# @param y - list
+# @return logical(1)
+isParValUpdate = function(x, y) {
+  if (is.null(y)) return(FALSE)
+  if (length(y) == 0) return(FALSE)
+  overwrite.candidates = intersect(names(x), names(y))
+  return(!identical(x[overwrite.candidates], y[overwrite.candidates]))
+}

common/json.R

@@ -0,0 +1,132 @@
+# Source: https://github.com/jakob-r/mlrHyperopt/blob/master/R/json.R
+# Licensed under BSD 3-Clause License
+# See https://github.com/jakob-r/mlrHyperopt/blob/master/LICENSE
+
+## Convert ParamSet To JSON
+
+#' @import jsonlite
+#' @import stringi
+
+# converts a ParamSet to JSON
+# @param par.set [ParamSet]
+# @return JSON
+parSetToJSON = function(par.set) {
+  pars = par.set$pars[order(names(par.set$pars))] # order parameters alphabetically for unified storage and comparable hashes
+  res.list = lapply(pars, paramToJSONList)
+  toJSON(res.list)
+}
+
+# converts a Param to a List
+# @param param [list]
+# @return list
+paramToJSONList = function(param) {
+  res.list = Filter(function(x) !is.null(x) && length(x) > 0, param) #remove empty list entries
+  if (any(names(res.list) %in% getForbiddenParamFields())) {
+    stopf("The Param fields for Param %s are currently not supported: %s", param$id, intersect(names(res.list), getForbiddenParamFields()))
+  }
+  res.list = res.list[names(res.list) %in% getSupportedParamFields()]
+  # deparse all requirements
+  if (!is.null(param$requires)) {
+    res.list$requires = deparse(param$requires)
+  }
+  # deparse all expressions
+  res.list = lapply(res.list, function(x) {
+    if (is.expression(x)) {
+      deparse(x)
+    } else {
+      x
+    }
+  })
+  # handle values for discrete param, currently not supported
+  if (param$type == "discrete") {
+    res.list$values = checkDiscreteJSON(param$values, param$id)
+  }
+  # handle trafo
+  if (!is.null(param$trafo)) {
+    res.list$trafo = deparse(param$trafo)
+  }
+  res.list
+}
+
+# converts json to a List of parameter values
+# @param par.vals [\code{list}]
+# @return JSON
+parValsToJSON = function(par.vals) {
+  par.vals = checkDiscreteJSON(par.vals, "Values")
+  toJSON(par.vals, force = TRUE)
+}
+
+
+## Convert JSON to ParamSet
+
+# converts JSON to a ParamSet
+# @param json [char]
+# @return ParamSet
+JSONtoParSet = function(json) {
+  ps.list = fromJSON(json)
+  param.list.and.keys = lapply(ps.list, JSONListToParam)
+  param.list = extractSubList(param.list.and.keys, "param", simplify = FALSE)
+  param.keys = unique(extractSubList(param.list.and.keys, "keys", simplify = TRUE))
+  par.set = makeParamSet(params = param.list, keys = param.keys)
+  par.set
+}
+
+# converts a list to a Param
+# @param par.list [list()]
+# @return Param
+JSONListToParam = function(par.list) {
+  type = par.list$type
+  par.list$type = NULL
+  # convert Requirement expression
+  if (!is.null(par.list$requires)) {
+    par.list$requires = convertExpressionToCall(parse(text = par.list$requires))
+  }
+  # parse trafo
+  if (!is.null(par.list$trafo)) {
+    par.list$trafo = eval(parse(text = par.list$trafo))
+  }
+  # parse expressions in parameter values and boundaries (actually everywhere)
+  keys = NULL
+  for (i in names(par.list)) {
+    x = par.list[[i]]
+    if (is.character(x)) {
+      if (stri_startswith_fixed(x, "expression(") || stri_startswith_fixed(x, "structure(")) {
+        par.list[[i]] = eval(parse(text = collapse(x, sep = "")))
+        #fixme: dirty way to match all variable names but not the expression
+        keys = c(keys, all.vars(par.list[[i]]))
+      }
+    }
+  }
+  paramFunction = switch(type,
+                         numeric = makeNumericParam,
+                         numericvector = makeNumericVectorParam,
+                         integer = makeIntegerParam,
+                         integervector = makeIntegerVectorParam,
+                         logical = makeLogicalParam,
+                         logicalvector = makeLogicalVectorParam,
+                         discrete = makeDiscreteParam,
+                         discretevector = makeDiscreteVectorParam,
+                         character = makeCharacterParam,
+                         charactervector = makeCharacterVectorParam)
+  supported.args = formalArgs(paramFunction)
+  param = do.call(paramFunction, par.list[names(par.list) %in% supported.args], quote = TRUE)
+  list(param = param, keys = unique(keys))
+}
+
+# converts json to a List of parameter values
+# @param json [\code{character}]
+# @return List
+JSONtoParVals = function(json) {
+  fromJSON(json)
+}
+
+
+## json helpers
+
+checkDiscreteJSON = function(par.vals, param.id = character()) {
+  value.classes = sapply(par.vals, class)
+  if (any(value.classes %nin% getSupportedDiscreteValues())) {
+    stopf("The values for Param %s contain currently unsupported types: %s", param.id, names(value.classes[value.classes %nin% getSupportedDiscreteValues()]))
+  }
+  par.vals
+}

server/image/data_access.R

@@ -1,5 +1,9 @@
-library(rjson)
-library(mlrMBO)
+library("rjson")
+library("mlrMBO")
+library("stringi")
+
+source("helpers.R")
+source("json.R")
 
 return_error = function(msg) {
     cat(paste0("r_error: ", msg, "\n"))
@@ -41,6 +45,9 @@ readData = function(session.id) {
   }
 
   ctrl = makeMBOControl()
+  print("bla")
+  par.set = JSONtoParSet(config$par.set)
+  print("bla2")
   initSMBO(config$par.set, design = all_data, learner = config$learner, minimize = config$minimize, noisy = config$noisy)
 
   # Return mlrMBO object

server/image/helpers.R

@@ -0,0 +1 @@
+../../common/helpers.R

server/image/json.R

@@ -0,0 +1 @@
+../../common/json.R