#################################
# mbo shims #
#################################
# mostly because mbo doesn't handle parameters well that are neither numeric nor
# categorical.
# the whole stack down: simplify requirements, types, vectors
simplifyParams = function(parset) {
parset = mboRequirements(parset)
parset = untypeParams(parset)
parset = unvectorParams(parset)
parset
}
# after generating concrete parameters using the simplifyParams() simplified
# parameters, convert these back so the learner receives them as the original
# parameter set.
complicateParams = function(params, origparset) {
simpleTypeOrig = untypeParams(origparset)
types = getParamTypes(simpleTypeOrig, df.cols = TRUE)
for (parin in seq_along(params)) {
params[[parin]] = switch(types[parin],
integer = as.integer,
numeric = as.numeric,
factor = as.character,
stop("complicateParam got bad type"))(params[[parin]])
}
params = as.data.frame(params, stringsAsFactors = FALSE)
params = dfRowsToList(params, simpleTypeOrig)[[1]]
params = removeMissingValues(params)
ret = lapply(names(params), function(parname) {
vals = origparset$pars[[parname]]$values
type = origparset$pars[[parname]]$type
par = params[[parname]]
if (is.null(vals)) {
# don't change anything
return(par)
}
switch(type,
logicalvector = unlist(vals[unlist(par)]),
logical = vals[[par]],
discretevector = lapply(par, function(x) vals[[x]]),
discrete = vals[[par]])
})
names(ret) = names(params)
ret
}
# convert discrete to discrete-string parameters
# also convert logical to discrete parameters
untypeParams = function(parset) {
parset$pars = lapply(parset$pars, function(par) {
if (!is.null(par$values)) {
par$values = as.list(names(par$values))
names(par$values) = par$values
par$type = switch(par$type,
logical = "discrete",
logicalvector = "discretevector",
par$type)
}
par
})
parset
}
# convert vector parameters to multiple nonvector parameters
unvectorParams = function(parset) {
parset$pars = unlist(recursive = FALSE, lapply(parset$pars, function(par) {
if (!ParamHelpers::isVector(par)) {
return(list(par))
}
lapply(seq_len(par$len), function(i) {
parcpy = par
parcpy$len = 1L
parcpy$id = paste0(parcpy$id, i)
if (!is.null(parcpy$lower)) {
parcpy$lower = parcpy$lower[i]
}
if (!is.null(parcpy$upper)) {
parcpy$upper = parcpy$upper[i]
}
parcpy$type = switch(parcpy$type,
integervector = "integer",
numericvector = "numeric",
discretevector = "discrete",
stopf("Unsupported parameter type '%s'", parcpy$type))
parcpy
})
}))
parset
}
# adapt requirements to parameter simplification we are doing above.
mboRequirements = function(searchspace) {
replacements = list()
for (param in searchspace$pars) {
type = param$type
if (type %in% c("numeric", "integer") ||
(type == "discrete" &&
all(sapply(param$values, test_character, any.missing = FALSE)))) {
# int, num and character nonvector were not affected
next
}
replaceStr = "c(%s)"
if (ParamHelpers::isVector(param)) {
if (!test_integer(param$len, len = 1, lower = 1, any.missing = FALSE)) {
stopf("Parameter '%s' is a vector param with undefined length'",
param$id)
}
replaceStr = sprintf(replaceStr,
paste0(param$id, seq_len(param$len), collapse = ", "))
} else {
replaceStr = sprintf(replaceStr, param$id)
}
replaceQuote = asQuoted(replaceStr)
if (isDiscrete(param)) {
objectText = capture.output(dput(param$values))
fullObject = try(asQuoted(collapse(objectText, sep = "\n")),
silent = TRUE)
if (is.error(fullObject)) {
fullObject = substitute(stop(sprintf(
"Parameter %s cannot be used in requirements.", pname)),
list(pname = param$id))
}
insert = list(fullObject = fullObject, index = replaceQuote)
template = switch(type,
# we index into fullObject to get a list
discretevector = quote(fullObject[index]),
# unlike for 'discretevector', we want to get a vector out of this.
logicalvector = quote(unlist(fullObject[index])),
# index is a single element, and we want to get a single element.
quote(fullObject[[index]]))
replaceQuote = do.call(substitute, list(template, insert))
}
replacements[[param$id]] = replaceQuote
}
for (param in names(searchspace$pars)) {
req = searchspace$pars[[param]]$requires
if (is.null(req)) {
next
}
searchspace$pars[[param]]$requires = replaceRequires(req, replacements)
}
searchspace
}
#################################
# irace shims #
#################################
# handle requirements and multidimensional parameters
# irace treats everything that is not a number as a string, which breaks our
# requirements. Here we repair these requirements by turning <logical> into
# (<logical> == TRUE) and <discrete> into discreteValuesList[<discrete>].
# We also handle vectors.
iraceRequirements = function(searchspace) {
replacements = list()
for (param in searchspace$pars) {
type = param$type
if (type == "discrete" &&
all(sapply(param$values, test_character, any.missing = FALSE))) {
# irace handles character discrete vectors well, so go right through
next
}
replaceStr = switch(type,
numeric = "%s",
numericvector = "c(%s)",
integer = "as.integer(%s)",
integervector = "as.integer(c(%s))",
logical = "(%s == 'TRUE')",
logicalvector = "(c(%s) == 'TRUE')",
discrete = "%s",
discretevector = "c(%s)",
stopf("Unsupported type '%s' of parameter '%s'.", type, param$id))
if (ParamHelpers::isVector(param)) {
if (!test_numeric(param$len, len = 1, lower = 1, any.missing = FALSE)) {
stopf("Parameter '%s' is a vector param with undefined length'",
param$id)
}
replaceStr = sprintf(replaceStr,
paste0(param$id, seq_len(param$len), collapse = ", "))
} else {
replaceStr = sprintf(replaceStr, param$id)
}
replaceQuote = asQuoted(replaceStr)
if (type %in% c("discrete", "discretevector")) {
assertList(param$values, names = "named")
objectText = capture.output(dput(param$values))
fullObject = try(asQuoted(collapse(objectText, sep = "")), silent = TRUE)
if (!is.error(fullObject)) {
}
if (is.error(fullObject) || length(all.vars(fullObject)) > 0) {
# irace does not like '\n' in their requirements.
# but it DOES accept 'eval(parse("\\n"))'
# this also fixes the problem that parameters in lists of functions show
# up on 'all.vars' even though they shouldn't, for irace's sake.
objectText = collapse(objectText, sep = "\n")
fullObject = asQuoted(paste0("eval(parse(text = ",
capture.output(dput(objectText)), "))"))
}
if (type == "discrete") {
replaceQuote = substitute(fullObject[[index]],
list(fullObject = fullObject, index = replaceQuote))
} else { # discretevector
replaceQuote = substitute(fullObject[index],
list(fullObject = fullObject, index = replaceQuote))
}
}
replacements[[param$id]] = replaceQuote
}
for (param in names(searchspace$pars)) {
req = searchspace$pars[[param]]$requires
if (is.null(req)) {
next
}
searchspace$pars[[param]]$requires = replaceRequires(req, replacements)
}
searchspace
}
# This function is a slightly modified version of the convertParamSet.R file in
# the ParamHelpers project (https://github.com/berndbischl/ParamHelpers).
#
# This file was distributed with a BSD 3 clause license as follows. Changes that
# I made are shown in the git history of this file.
#
# Copyright (c) 2013-2014, Bernd Bischl, Michel Lang, Daniel Horn
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in
# the documentation and/or other materials provided with the
# distribution.
#
# Neither the name of the TU Dortmund University nor the names of its
# contributors may be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
convertParamSetToIrace = function(par.set, as.chars = FALSE) {
assertClass(par.set, "ParamSet")
assertFlag(as.chars)
if (!is.null(par.set$forbidden))
stopf("Operation not allowed for param set with forbidden region currently!")
if (!hasFiniteBoxConstraints(par.set))
stop("convertParamSetToIrace requires finite box constraints for all numeric and integer params!")
requirePackages("irace", why = "convertParamSetToIrace", default.method = "load")
lines = character(0)
count = 1L
for (i in seq_along(par.set$pars)) {
p = par.set$pars[[i]]
type = switch(
p$type,
numeric = "r",
numericvector = "r",
integer = "i",
integervector = "i",
discrete = "c",
discretevector = "c",
logical = "c",
logicalvector = "c",
ordered = "o"
)
for (j in seq_len(p$len)) {
id = if (p$len == 1) p$id else paste(p$id, j, sep = "")
if (p$type %in% c("numeric", "numericvector"))
line = sprintf('%s "" %s (%g, %g)', id, type, p$lower[j], p$upper[j])
else if (p$type %in% c("integer", "integervector"))
line = sprintf('%s "" %s (%i, %i)', id, type, p$lower[j], p$upper[j])
else if (p$type %in% c("discrete", "discretevector", "logical", "logicalvector")) {
v = paste("\"", names(p$values), "\"", sep = "")
line = sprintf('%s "" %s (%s)', id, type, collapse(v))
} else {
stopf("Unknown parameter type: %s", p$type)
}
if (!is.null(p$requires)) {
line = paste(line, collapse(capture.output(p$requires), sep=""), sep = " | ")
}
lines[count] = line
count = count + 1L
}
}
if (as.chars) {
return(lines)
} else {
lines = collapse(lines, "\n")
params = irace::readParameters(text = lines, digits = .Machine$integer.max)
# assert that the boundaries have the correct class and values
for (i in seq_along(par.set$pars)) {
if (par.set$pars[[i]]$type %in% c("numeric", "numericvector"))
params$boundary[[i]] = as.numeric(unlist(par.set$pars[[i]][c("lower", "upper")]))
else if (par.set$pars[[i]]$type %in% c("integer", "integervector"))
params$boundary[[i]] = as.integer(params$boundary[[i]])
}
return(params)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.