非线性规划 R 闪亮的输入问题

Question

我有一个错误：STRING_ELT () 只能应用于 'character vector'，而不是 'NULL'。

如果我尝试将 objective 函数和约束添加到函数 eval_f、eval_g_eq 和 eval_g_ineq 的原始代码中，它会计算所有内容，但问题是根据输入计算。我不确定我是否对这些功能输入错误或出了什么问题。

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

你这里有一些问题。

函数需要在服务器内部定义，因为您不传递反应变量。
需要对textInput
运行仅在单击操作按钮 Submit 后进行分析。这样您就可以在计算之前修改所有输入。

试试这个

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)

非线性规划 R 闪亮的输入问题

Nonlinear programming R shiny problems with inputs

r

optimization

shiny

shinyapps

nonlinear-optimization