Nonlinear programming R shiny problems with inputs

Question

I have an error: STRING_ELT () can only be applied to a 'character vector', not a 'NULL'.

If I try add objective function and constraints into raw code to function eval_f, eval_g_eq and eval_g_ineq it calculates everything, but problem is calculate from input. I am not sure if i have bad input for these functions or what is wrong.

library(shiny)
library(shinythemes)
library(nloptr)

eval_f <<- function(x)
{
  return (obj)
}

eval_g_eq <<- function(x)
{
  return(eq)
}

eval_g_ineq <<- function(x)
{
  return(ineq)
}  

ui <- fluidPage(theme = shinytheme("united"),
                navbarPage(" Optimization",
                           tabPanel("Nonlinear programming",
                                    sidebarLayout(
                                      sidebarPanel(
                                        h3('Please enter nonlinear problem for solving'),
                                        textInput('obj', 'Objective  function ', "x[1]*x[4]*(x[1] +x[2] + x[3]) + x[3]"),
                                        textInput('eq', 'Equality constraints ', "x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 - 40"),
                                        textInput('ineq', 'Inequality constraints', "25 - x[1]*x[2]*x[3]*x[4]"),
                                        textInput('lb', 'Lower bounds (comma separated)', "1,1,1,1"),
                                        textInput('ub', 'Upper bounds (comma separated)', "5,5,5,5"),
                                        textInput('x0', 'Initial values (comma separated)', "1,5,5,1"),
                                        submitButton('Submit')
                                      ),
                                      
                                      mainPanel(
                                        h4('The result is:'),
                                        verbatimTextOutput("res")
                                      )
                                    )
                           )
                )
)

server <- function(input, output, session) {
  
  output$res<-renderPrint({ 
    obj<<- as.vector(input$obj)
    eq <<-as.vector(input$eq)
    ineq <<-as.vector(input$ineq)
    lb <<- as.numeric(unlist(strsplit(input$lb,",")))
    ub <<- as.numeric(unlist(strsplit(input$ub,",")))
    x0 <<- as.numeric(unlist(strsplit(input$x0,",")))
    
    
    local_opts <- list( "algorithm" = "NLOPT_GN_ISRES", "xtol_rel" = 1.0e-15 )
    opts <- list( "algorithm"= "NLOPT_GN_ISRES",
                  "xtol_rel"= 1.0e-15,
                  "maxeval"= 160000,
                  "local_opts" = local_opts,
                  "print_level" = 0 )
    
    
    res <- nloptr ( x0 = x0,
                    eval_f = eval_f,
                    lb = lb,
                    ub = ub,
                    eval_g_ineq = eval_g_ineq,
                    eval_g_eq = eval_g_eq,
                    opts = opts)
    
    cat("Result:\n")
    print(res)
  }
  ) 
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

You have a few issues here.

1. Functions need to be defined inside the server as you are not passing reactive variables.
2. Need to parse and evaluate the formulas obtained from textInput
3. Run the analysis only after clicking on the action button Submit. This way you can modify all your inputs prior to calculating.

Try this

library(shiny)
library(shinythemes)
library(nloptr)

ui <- fluidPage(theme = shinytheme("united"),
                navbarPage(" Optimization",
                           tabPanel("Nonlinear programming",
                                    sidebarLayout(
                                      sidebarPanel(
                                        h3('Please enter nonlinear problem for solving'),
                                        textInput('obj', 'Objective  function ', "x[1]*x[4]*(x[1] +x[2] + x[3]) + x[3]"),
                                        textInput('eq', 'Equality constraints ', "x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 - 40"),
                                        textInput('ineq', 'Inequality constraints', "25 - x[1]*x[2]*x[3]*x[4]"),
                                        textInput('lb', 'Lower bounds (comma separated)', "1,1,1,1"),
                                        textInput('ub', 'Upper bounds (comma separated)', "5,5,5,5"),
                                        textInput('x0', 'Initial values (comma separated)', "1,5,5,1"),
                                        actionButton('submit',"Submit")
                                      ),
                                      
                                      mainPanel(
                                        h4('The result is:'),
                                        verbatimTextOutput("res")
                                      )
                                    )
                           )
                )
)

server <- function(input, output, session) {

  eval_f <- function( x ) {
    req(input$obj)
    return( list( "objective" = rlang::eval_tidy(rlang::parse_expr(as.character(input$obj))), 
                  "gradient" = c( x[1] * x[4] + x[4] * (x[1] + x[2] + x[3]),
                                  x[1] * x[4],
                                  x[1] * x[4] + 1.0,
                                  x[1] * (x[1] + x[2] + x[3]) )
    ) )
  }
  
  # constraint functions
  # inequalities
  eval_g_ineq <- function( x ) {
    constr <- rlang::eval_tidy(rlang::parse_expr(as.character(input$ineq))) # c( 25 - x[1] * x[2] * x[3] * x[4] )
    grad <- c( -x[2]*x[3]*x[4],
               -x[1]*x[3]*x[4],
               -x[1]*x[2]*x[4],
               -x[1]*x[2]*x[3] )
    return( list( "constraints"=constr, "jacobian"=grad ) )
  }
  
  # equalities
  eval_g_eq <- function( x ) {
    constr <- rlang::eval_tidy(rlang::parse_expr(as.character(input$eq)))  # c( x[1]^2 + x[2]^2 + x[3]^2 + x[4]^2 - 40 )
    grad <- c( 2.0*x[1],
               2.0*x[2],
               2.0*x[3],
               2.0*x[4] )
    return( list( "constraints"=constr, "jacobian"=grad ) )
  }
  
  res <- eventReactive(input$submit, {
    req(input$obj,input$ineq,input$eq,input$lb,input$ub,input$x0)
    lb <<- as.numeric(unlist(strsplit(input$lb,",")))
    ub <<- as.numeric(unlist(strsplit(input$ub,",")))
    x0 <<- as.numeric(unlist(strsplit(input$x0,",")))
    
    local_opts <- list( "algorithm" = "NLOPT_GN_ISRES", "xtol_rel" = 1.0e-15 )
    opts <- list( "algorithm"= "NLOPT_GN_ISRES",
                  "xtol_rel"= 1.0e-15,
                  "maxeval"= 16000,
                  "local_opts" = local_opts,
                  "print_level" = 0 )
    
    
    res <- nloptr ( x0 = x0,
                    eval_f = eval_f,
                    lb = lb,
                    ub = ub,
                    eval_g_ineq = eval_g_ineq,
                    eval_g_eq = eval_g_eq,
                    opts = opts)
    res
    
  })
  
  output$res<-renderPrint({
    cat("Result:\n")
    print(res())
  })
}

# Run the application 
shinyApp(ui = ui, server = server)