#' @title modifyParam.R
#' @description copy parameter set to new set, cs, and modify lower
#' and upper limits of one parameter id. If parameter is
#' discrete then change list of permitted values.
#'
#' @param ps - a parameter set, class(ps) = "ParamSet"
#' @param cs - a constraint set, class(ps) = "ParamSet"
#' @param id - id/name of parameter to alter in new set, character
#' @param lower - new lower limit for id - integer, numeric, character or list of character
#' @param upper - new upper limit for id - integer, numeric, character or list of character
#'
#' @return cs - the new constraint set with class(cs) = "ParamSet"
#
#
# usage example:
# cs = modifyParam(ps, id="power", lower = 333, upper = 333)
# cs = modifyParam(ps, id="gas", lower = list("Argon", "Nitrogen"))
# if modifying an existing constraint set
# cs = modifyParam(ps, cs, id="gas", lower = "Argon", upper="Nitrogen")
modifyParam = function(ps, cs = NULL, id = NULL, lower = NULL, upper = NULL) {
psParamIDs = getParamIds(ps)
if (is.null(cs) || !(class(cs) == "ParamSet")) {
cs = ps
}
csParamIDs = getParamIds(cs)
if (!(is.null(id))) {
if (id %in% psParamIDs) {
# if param id is in parameter set but not constraint set copy to cs
if (!(id %in% csParamIDs)) {
cs[["pars"]][[id]] = ps[["pars"]][[id]]
}
# for parameters of type integer or numeric
if (cs[["pars"]][[id]][["type"]] == "integer" ||
cs[["pars"]][[id]][["type"]] == "numeric") {
# if lower is not NULL and within valid limits then set to new lower
cs[["pars"]][[id]][["lower"]] = validNum(ps, id, lower, "lower")
# if upper is not NULL and within valid limits then set to new upper
cs[["pars"]][[id]][["upper"]] = validNum(ps, id, upper, "upper")
# for parameters of type discrete
} else if (cs[["pars"]][[id]][["type"]] == "discrete") {
values = ps[["pars"]][[id]][["values"]]
appVal = 0L
# if lower is not NULL and in ps's set of param IDs then copy value to cs
if (!(is.null(lower))) {
if (class(lower) == "character" && length(lower) == 1) {
if (lower %in% values) {
appVal = 2L
} else {
warning(lower, " not a valid value for ", id,
", using values from parameter set\n")
appVal = 1L
}
} else if (class(lower) == "list") {
apndLow = list()
for (low in lower) {
if (low %in% values) {
apndLow = append(apndLow, low)
appVal = 2L
} else {
warning(low, " not a valid value for ", id, "\n")
}
}
}
}
# if upper is not NULL and in ps's set of param IDs then copy value to cs
if (!(is.null(upper))) {
if (class(upper) == "character" && length(upper) == 1L) {
if (upper %in% values) {
if (appVal == 0L) appVal = 3L
if (appVal == 2L) appVal = 4L
} else {
warning(upper, " not a valid value for ", id,
", using values from parameter set\n")
appVal = 1L
}
} else if (class(upper) == "list") {
apndUp = list()
for (up in upper) {
if (up %in% values) {
apndUp = append(apndUp, up)
if (appVal == 0L) appVal = 3L
if (appVal == 2L) appVal = 4L
} else {
warning(up, " not a valid value for ", id, "\n")
}
}
}
}
# determine how to append values to a discrete parameter
if (appVal >= 2L) {
cs[["pars"]][[id]][["values"]] = NULL
if (appVal == 2L) {
if (class(lower) == "character") apnd = list(lower)
if (class(lower) == "list") apnd = apndLow
} else if (appVal == 3L) {
if (class(upper) == "character") apnd = list(upper)
if (class(upper) == "list") apnd = apndUp
} else if (appVal == 4L) {
if (class(lower) == "list") {
apnd = append(lower, upper)
} else if (class(lower) == "character" && class(upper) == "list") {
apnd = append(upper, lower)
} else {
apnd = list(lower, upper)
}
}
apnd = unique(apnd)
cs[["pars"]][[id]][["values"]] = apnd
names(cs[["pars"]][[id]][["values"]]) = apnd
}
# other types of parameters not supported
} else {
stopf("modifyParam only implemented for types of integer, numeric & discrete")
}
} else {
warning(id, " not in parameter set, ignoring constraint\n")
}
}
return(cs)
}
# if limitVal is within limts and "numeric" return limitVal, otherwise return ps limit
validNum = function(ps, id, limitVal, limit) {
ret = ps[["pars"]][[id]][[limit]]
if (!(is.null(limitVal))) {
if (class(limitVal) == "numeric") {
if (limitVal >= ps[["pars"]][[id]][["lower"]] &&
limitVal <= ps[["pars"]][[id]][["upper"]]) {
ret = limitVal
} else {
warning(limitVal, " is outside parameter limits, using limit from parameter set\n")
}
} else {
warning("integer and numeric parameters must have class(value) = numeric\n")
}
}
return(ret)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.