r - 从 selectInput 或 sliderInput 获取参数并单击 ActionButton 后，如何在 R Shiny 中执行函数？

Question

所以我的函数从 selectInput 和 sliderInput 中获取参数。在我点击按钮 GO！它开始并生成情节。在我使用滑块更改值后，它再次启动，即使没有单击按钮。如何更改它，使其在没有我单击按钮的情况下不会启动？我不希望它在我仍在使用滑块时立即执行。如果这是一个愚蠢的问题，我很抱歉，我是一个闪亮的初学者！

pageWithSidebar(
  headerPanel('Algorytm genetyczny - optymalizacja funkcji Levy13'),
  sidebarPanel(
    selectInput('type_of', 'Typ algorytmu', choices = c("real-valued", "binary"), multiple = FALSE),
    sliderInput('pop', 'Wielkosc populacji', min = 50, max = 1000, value = 100, step = 50, round = TRUE,
                animate = TRUE, width = '400px'),
    sliderInput('epoch', 'Liczba iteracji', min = 100, max = 2000, value = 1000, step = 100, round = TRUE,
                animate = TRUE, width = '400px'),
    actionButton("goButton", "Go!", class = "btn-success"),
  ),
  mainPanel(
    plotOutput('plot1'),
    plotOutput('plot2'),
    plotOutput('plot3')
  )
)

library(GA)
library(tidyverse)
library(ranger)
library(caret)
library(tictoc)

function(input, output, session) {
  
  
  levy13 <- function(x1, x2)
  {
    term1 <- (sin(3*pi*x1))^2
    term2 <- (x1-1)^2 * (1+(sin(3*pi*x2))^2)
    term3 <- (x2-1)^2 * (1+(sin(2*pi*x2))^2)
    
    y <- term1 + term2 + term3
    return(y)
  }
  
  x1 <- x2 <- seq(-10, 10, by = 0.1)
  f <- outer(x1, x2, levy13)
  
  output$plot1 <- renderPlot(persp3D(x1, x2, f, theta = 50, phi = 20, col.palette = bl2gr.colors) )
  
  output$plot2 <- renderPlot(filled.contour(x1, x2, f, color.palette = bl2gr.colors))
  
  observeEvent(input$goButton, {
  
  output$plot3 <- renderPlot({
    GA <- ga(type = input$type_of, fitness =  function(x) - levy13(x[1], x[2]),
             lower = c(-10, -10), upper = c(10, 10), 
             popSize = input$pop, maxiter = input$epoch, run = 300)
    plot(GA)})
  })
}

标签： rshinyshiny-reactivity

Answer 1

当然，我们可以让我们的 Go 按钮控制图表何时重绘。并在滑块更改时停止图表重绘。

我们可以使用isolate来阻止图表自动链接到滑块。

下面的最小示例显示了这一点：

library(shiny)

ui <- fluidPage(

    sliderInput("slider_1", "Slider 1", min = 1, max = 10, value = 5),
    sliderInput("slider_2", "Slider 2", min = 1, max = 10, value = 5),
    
    actionButton("myactionbutton", "Go"),
    
    plotOutput("myplot")
    
)

server <- function(input, output, session) {
  
    #Runs when action button is pressed
    observeEvent(input$myactionbutton, {
      
        #Prepare chart output
        output$myplot <- renderPlot({
            
            #Get the input of the sliders, but isolate them so changing the sliders won't cause our chart to redraw
            numberofpoints <- isolate(input$slider_1) * isolate(input$slider_2)
            
            #Prepare chart
            hist(runif(numberofpoints))
            
        })
        
    })
    
}

shinyApp(ui, server)

这是您添加的代码isolate，包含在几行额外的行中，以使其成为一个完全正常工作的闪亮应用程序：

library(shiny)
library(GA)
library(tidyverse)
library(ranger)
library(caret)
library(tictoc)

ui <- fluidPage(
    pageWithSidebar(
        headerPanel('Algorytm genetyczny - optymalizacja funkcji Levy13'),
        sidebarPanel(
            selectInput('type_of', 'Typ algorytmu', choices = c("real-valued", "binary"), multiple = FALSE),
            sliderInput('pop', 'Wielkosc populacji', min = 50, max = 1000, value = 100, step = 50, round = TRUE, animate = TRUE, width = '400px'),
            sliderInput('epoch', 'Liczba iteracji', min = 100, max = 2000, value = 1000, step = 100, round = TRUE, animate = TRUE, width = '400px'),
            actionButton("goButton", "Go!", class = "btn-success"),
        ),
        mainPanel(
            plotOutput('plot1'),
            plotOutput('plot2'),
            plotOutput('plot3')
        )
    )
)

server <- function(input, output, session) {
    
    levy13 <- function(x1, x2)
    {
        term1 <- (sin(3*pi*x1))^2
        term2 <- (x1-1)^2 * (1+(sin(3*pi*x2))^2)
        term3 <- (x2-1)^2 * (1+(sin(2*pi*x2))^2)
        
        y <- term1 + term2 + term3
        return(y)
    }
    
    x1 <- x2 <- seq(-10, 10, by = 0.1)
    f <- outer(x1, x2, levy13)
    
    output$plot1 <- renderPlot(persp3D(x1, x2, f, theta = 50, phi = 20, col.palette = bl2gr.colors) )
    
    output$plot2 <- renderPlot(filled.contour(x1, x2, f, color.palette = bl2gr.colors))
    
    observeEvent(input$goButton, {
        
        output$plot3 <- renderPlot({
            GA <- ga(type = input$type_of, fitness =  function(x) - levy13(x[1], x[2]),
                     lower = c(-10, -10), upper = c(10, 10), 
                     popSize = isolate(input$pop), maxiter = isolate(input$epoch), run = 300)
            plot(GA)})
        
    })
}

shinyApp(ui, server)