#' Shiny UI-Module for Function Input
#'
#' \code{featObject_sidebar} is a \href{https://CRAN.R-project.org/package=shiny}{\code{shiny}} UI-component which can be
#' added to your \href{https://CRAN.R-project.org/package=shiny}{\code{shiny}} app so that you can easily generate a
#' feature object by providing all relevant information.
#'
#' @template arg_ui_id
#'
#' @export
featureObject_sidebar = function(id) {
# Create a namespace function using the provided id
ns = shiny::NS(id)
# sidebar for the configuration of different function parameters
shiny::sidebarPanel(
shiny::radioButtons(ns("function_option"), label = "Function input",
choices = list("User defined function" = 1, "smoof" = 2, "BBOB" = 4,
"File-Import" = 3), selected = 1),
# "MPM2" = 5,
shiny::conditionalPanel(
condition = paste0("input['", ns("function_option"), "'] == 1"),
shiny::textInput(ns("function_input"), label = "Function")
),
shiny::conditionalPanel(
condition = paste0("input['", ns("function_option"), "'] == 2"),
shiny::selectInput(ns("smoof_function_select"), label = "Function name",
choices = smoof::filterFunctionsByTags("single-objective"))
),
shiny::conditionalPanel(
condition = paste0("input['", ns("function_option"), "'] == 3"),
shiny::fileInput(ns("import_file"), label = "File to import")
),
shiny::conditionalPanel(
condition = paste0("input['", ns("function_option"), "'] == 4"),
shiny::splitLayout(
shiny::numericInput(ns("BBOB_fid"), label = "BBOB-FID", value = 1),
shiny::numericInput(ns("BBOB_iid"), label = "BBOB-IID", value = 1))
),
shiny::conditionalPanel(
condition = paste0("input['", ns("function_option"), "'] != 3"),
shiny::splitLayout(
shiny::numericInput(ns("dimension_size"), label = "Dimensions", value = 1),
shiny::selectInput(ns("sampletype"), label = "Sample type", choices = c("random","lhs"))
),
# put lower and upper bound in one line
shiny::splitLayout(
shiny::textInput(ns("samplelow"), label = "Lower bound", value = "0"),
shiny::textInput(ns("sampleup"), label = "Upper bound", value = "1")
),
shiny::sliderInput(ns("ssize"), "Sample size", min = 10, max = 5000, value = 100)
),
shiny::textInput(ns("block_input"), label = "Blocks (comma sperated per dimension)", value = "2")
)
}
#' Shiny Server Function for Feature Calculation of Function Input
#'
#' \code{functionInput} is a \href{https://CRAN.R-project.org/package=shiny}{\code{shiny}} server function which controls
#' all aspects of the \code{FlaccoFunctionInput} UI Module. Will be
#' called with \code{\link[shiny]{callModule}}.
#'
#' @template arg_ui_input
#' @template arg_ui_output
#' @template arg_ui_session
#' @template arg_ui_stringsAsFactors
#'
#' @export
functionInput = function(input, output, session, stringsAsFactors) {
# function to control the output data if smoof is selected for function input
smoof_input_createFeatures = shiny::reactive({
# transform the text input for lower and upper bound to an vector with the respective values
shiny::validate(
shiny::need(try({
lowerbound = eval(parse(text = paste("c(", input$samplelow, ")")))
}), "Please insert valid lowerbound defintion") %then%
shiny::need(try({
upperbound = eval(parse(text = paste("c(", input$sampleup, ")")))
}), "Please insert valid upperbound defintion")
)
# get ctrl values for creation of initial sample
ctrl = list(init_sample.type = input$sampletype,
init_sample.lower = lowerbound,
init_sample.upper = upperbound)
X = createInitialSample(n.obs = input$ssize, dim = input$dimension_size, control = ctrl)
f = smoof::makeFunctionsByName(input$smoof_function_select, dimensions = input$dimension_size)[[1L]]
y = apply(X, 1L, f)
#check if input for blocks is available
if (input$block_input != ""){
# validate the input for block
shiny::validate(
shiny::need(try({
blocks = eval(parse(text = paste("c(", input$block_input, ")")))
}), "Please insert valid block defintion") %then%
shiny::need(max(input$dimension_size^blocks) <= 10000, "Block value in combination with the dimensions is too high!") %then%
shiny::need(try({
feat.object = createFeatureObject(X = X, y = y, fun = f, blocks = blocks)
}), "Please insert a valid function")
)
} else {
feat.object = createFeatureObject(X = X, y = y, fun = f)
}
feat.object
})
# function to control the output data if smoof BBOB is selected for function input
smoof_BBOB_input_createFeatures = shiny::reactive({
# transform the text input for lower and upper bound to a vector with the respective values
shiny::validate(
shiny::need(try({
lowerbound = eval(parse(text = paste("c(", input$samplelow, ")")))
}), "Please insert valid lowerbound defintion") %then%
shiny::need(try({
upperbound = eval(parse(text = paste("c(", input$sampleup, ")")))
}), "Please insert valid upperbound defintion")
)
# get ctrl values for creation of initial sample
ctrl = list(init_sample.type = input$sampletype,
init_sample.lower = lowerbound,
init_sample.upper = upperbound)
X = createInitialSample(n.obs = input$ssize, dim = input$dimension_size, control = ctrl)
f = smoof::makeBBOBFunction(dimension = input$dimension_size, fid = input$BBOB_fid, iid = input$BBOB_iid)
y = apply(X, 1L, f)
# check if input for blocks is available
if (input$block_input != ""){
# validate the input for block
shiny::validate(
shiny::need(try({
blocks = eval(parse(text=paste("c(", input$block_input, ")")))
}), "Please insert valid block defintion") %then%
shiny::need(max(input$dimension_size^blocks) <= 10000, "Block value in combination with the dimensions is too high!") %then%
shiny::need(try({
feat.object = createFeatureObject(X = X, y = y, fun = f, blocks=blocks)
}), "Please insert a valid function")
)
} else {
feat.object = createFeatureObject(X = X, y = y, fun = f)
}
feat.object
})
# reactive element which is called when function input is selected and which controlls the output of features
createFeatures_function = shiny::reactive({
# transform the text input for lower and upper bound to an vector with the respective values
shiny::validate(
shiny::need(try({
lowerbound = eval(parse(text = paste("c(", input$samplelow, ")")))
}), "Please insert valid lowerbound defintion") %then%
shiny::need(try({
upperbound = eval(parse(text = paste("c(", input$sampleup, ")")))
}), "Please insert valid upperbound defintion")
)
# get ctrl values for creation of initial Sample
ctrl = list(init_sample.type = input$sampletype,
init_sample.lower = lowerbound,
init_sample.upper = upperbound)
X = createInitialSample(n.obs = input$ssize, dim = input$dimension_size, control = ctrl)
if ((length(lowerbound) == 1) && (input$dimension_size > 1))
lowerbound = rep(lowerbound, input$dimension_size)
if ((length(upperbound) == 1) && (input$dimension_size > 1))
upperbound = rep(upperbound, input$dimension_size)
params = lapply(seq_len(input$dimension_size), function(i) {
ParamHelpers::makeNumericParam(paste0("x", i), lower = lowerbound[i], upper = upperbound[i])
})
# check if there is a block input
if (input$block_input == ""){
# validate if the function the user has put in can be evaluated by R
shiny::validate(
shiny::need(try({
f = eval(parse(text = paste("function(x) ", input$function_input)))
}), "Please insert a valid function") %then%
shiny::need(try({
fun = smoof::makeSingleObjectiveFunction(name = input$function_input,
fn = f, par.set = ParamHelpers::makeParamSet(params = params))
}), "Please insert a valid function") %then%
shiny::need(try({
feat.object = createFeatureObject(X = X, fun = fun)
}), "Please insert a valid function")
)
} else {
shiny::validate(
shiny::need(try({
f = eval(parse(text = paste("function(x) ", input$function_input)))
}), "Please insert a valid function") %then%
shiny::need(try({
blocks = eval(parse(text = paste("c(", input$block_input, ")")))
}), "Please insert valid block defintion") %then%
shiny::need(max(input$dimension_size^blocks) <= 10000,
"Block value in combination with the dimensions is too high!") %then%
shiny::need(try({
fun = smoof::makeSingleObjectiveFunction(
name = input$function_input, fn = f, par.set = ParamHelpers::makeParamSet(params = params))
}), "Please insert a valid function") %then%
shiny::need(try({
feat.object = createFeatureObject(X = X, fun = fun, blocks=blocks)
}), "Please insert a valid function")
)
}
feat.object
})
# function for controlling the file input app
createFeatures_import = shiny::reactive({
# load values from uploaded file
importdata = utils::read.csv(input$import_file$datapath)
# check if input for blocks is available
if (input$block_input != "") {
# validate the input for block
shiny::validate(
shiny::need(try({
blocks = eval(parse(text = paste("c(", input$block_input, ")")))
}), "Please insert valid block defintion") %then%
shiny::need(max(ncol(importdata)^blocks) <= 10000,
"Block value in combination with the dimensions is too high!") %then%
shiny::need(try({
feat.object = createFeatureObject(
X = data.frame(importdata[, -ncol(importdata)]),
y = importdata[, ncol(importdata)], blocks = blocks)
}), "Please insert valid funciton values")
)
} else {
feat.object = createFeatureObject(
X = data.frame(importdata[, -ncol(importdata)]),
y = importdata[, 2L])
}
feat.object
})
featureObject = shiny::reactive({
if (input$function_option == 1) {
createFeatures_function()
} else if (input$function_option == 2) {
smoof_input_createFeatures()
} else if (input$function_option == 3) {
createFeatures_import()
} else if (input$function_option == 4) {
smoof_BBOB_input_createFeatures()
}
})
return(featureObject)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.