如何在 R Shiny 中執行 function 並單擊 Action？

Question

所以我的 function 從 selectInput 和 sliderInput 中獲取 arguments。 單擊按鈕 GO 后。 它啟動並生成 plot，在我使用 slider 更改它再次啟動的值之后。 即使沒有點擊按鈕？ 如何更改它，使其在沒有我單擊按鈕的情況下不會啟動。 我不希望它在我仍在使用 slider 時立即執行，如果這是一個愚蠢的問題，我很抱歉，我是一個閃亮的初學者！

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)})
  })
}

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的代碼，包含在幾行額外的行中，以使其成為一個完全工作的 shiny 應用程序：

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)