避免不必要的负载闪亮的应用程序

Question

我有一个eventReactive函数加载在两个数据集。每个数据集都可以选择，但它们都在相同的eventReactive内加载。但是，如果用户只更改两个数据集中的一个，我不希望它们都加载，但只有已更改的那个。我知道使用两个动作按钮会容易得多，但我需要把它放在一个。请在下面找到示例代码。

所以在这个例子中，我只想执行变量已经改变的那部分代码。 ui.r：

library(shiny) 

# Define UI for dataset viewer application 
shinyUI(fluidPage(

    # Application title 
    titlePanel("Reactivity"), 

    # Sidebar with controls to provide a caption, select a dataset, 
    # and specify the number of observations to view. Note that 
    # changes made to the caption in the textInput control are 
    # updated in the output area immediately as you type 
    sidebarLayout(
    sidebarPanel(
     textInput("caption", "Caption:", "Data Summary"), 
     actionButton('Go','Go'), 

     selectInput("dataset", "Choose a dataset:", 
        choices = c("rock", "pressure", "cars")), 
     selectInput("dataset2", "Choose a dataset:", 
        choices = c("rock", "pressure", "cars")), 

     numericInput("obs", "Number of observations to view:", 10) 
    ), 


    # Show the caption, a summary of the dataset and an HTML 
    # table with the requested number of observations 
    mainPanel(
     h3(textOutput("caption", container = span)), 
     verbatimTextOutput('one'), 
     verbatimTextOutput('two'), 
     verbatimTextOutput("summary"), 

     verbatimTextOutput("summary2")#, 

     # tableOutput("view"), 
     # tableOutput("view2") 
    ) 
) 
)) 

server.r

library(shiny) 
library(datasets) 

# Define server logic required to summarize and view the selected 
# dataset 
shinyServer(function(input, output) { 

    # By declaring datasetInput as a reactive expression we ensure 
    # that: 
    # 
    # 1) It is only called when the inputs it depends on changes 
    # 2) The computation and result are shared by all the callers 
    # (it only executes a single time) 
    # 
    datasetInput <- eventReactive(input$Go,{ 

    ##Only run if input$dataset has changed## 
    withProgress(message='Loading 1:This should take very long....',value=0,{ 
     for(i in 1:5){ 
     Sys.sleep(1) 
     incProgress(i/5) 
     } 
    x<-switch(input$dataset, 
      "rock" = rock, 
      "pressure" = pressure, 
      "cars" = cars) 

    }) 
###only run if input$dataset2 has changed 
    withProgress(message='Loading 2:This should take even longer....',value=0,{ 
     for(i in 1:5){ 
     Sys.sleep(1.5) 
     incProgress(i/5) 
     }  
     y<-switch(input$dataset2, 
         "rock" = rock, 
         "pressure" = pressure, 
         "cars" = cars) 
    }) 




    return(list(x=x,y=y,input1=input$dataset,input2=input$dataset2)) 
    }) 

    # The output$caption is computed based on a reactive expression 
    # that returns input$caption. When the user changes the 
    # "caption" field: 
    # 
    # 1) This function is automatically called to recompute the 
    #  output 
    # 2) The new caption is pushed back to the browser for 
    #  re-display 
    # 
    # Note that because the data-oriented reactive expressions 
    # below don't depend on input$caption, those expressions are 
    # NOT called when input$caption changes. 
    output$caption <- renderText({ 
    input$caption 
    }) 

    # The output$summary depends on the datasetInput reactive 
    # expression, so will be re-executed whenever datasetInput is 
    # invalidated 
    # (i.e. whenever the input$dataset changes) 
    output$summary <- renderPrint({ 
    dataset <- datasetInput()$x 
    summary(dataset) 
    }) 

    output$summary2 <- renderPrint({ 
    dataset <- datasetInput()$y 
    summary(dataset) 
    }) 

    # The output$view depends on both the databaseInput reactive 
    # expression and input$obs, so will be re-executed whenever 
    # input$dataset or input$obs is changed. 
    output$view <- renderTable({ 
    head(datasetInput()$x, n = input$obs) 
    }) 
    output$view2 <- renderTable({ 
    head(datasetInput()$y, n = input$obs) 
    }) 
    output$one<-renderText(datasetInput()$input1) 
    output$two<-renderText(datasetInput()$input2) 

}) 

我已经尝试过这样的事情：if(datasetInput()$input1 != input$dataset){execute...} 但它不工作，可能是因为你使用的是无功函数内的值被创建在相同的函数中...

Answer 1

您可以将两个数据加载步骤分成reactive表达式，其中eventReactive具有依赖关系。这样当你点击Go时，如果它们改变了输入值，则调用两个反应表达式，但如果输入没有更新，则不会。例如：

library(shiny) 
library(datasets) 

ui = fluidPage(
    # Application title 
    titlePanel("Reactivity"), 
    sidebarLayout(
    sidebarPanel(
     textInput("caption", "Caption:", "Data Summary"), 
     actionButton('Go','Go'), 
     selectInput("dataset", "Choose a dataset:", 
        choices = c("rock", "pressure", "cars")), 
     selectInput("dataset2", "Choose a dataset:", 
        choices = c("rock", "pressure", "cars")), 

     numericInput("obs", "Number of observations to view:", 10) 
    ), 

    mainPanel(
     h3(textOutput("caption", container = span)), 
     verbatimTextOutput('one'), 
     verbatimTextOutput('two'), 
     verbatimTextOutput("summary"), 
     verbatimTextOutput("summary2") 
    ) 
) 
) 

server = function(input, output) { 
    dat1 = reactive({ 
    withProgress(message='Loading 1:This should take very long....',value=0,{ 
     for(i in 1:5){ 
     Sys.sleep(1) 
     incProgress(i/5) 
     } 
     switch(input$dataset, 
      "rock" = rock, 
      "pressure" = pressure, 
      "cars" = cars) 
    }) 
    }) 

    dat2 = reactive({ 
    withProgress(message='Loading 2:This should take even longer....',value=0,{ 
     for(i in 1:5){ 
     Sys.sleep(1.5) 
     incProgress(i/5) 
     }  
     switch(input$dataset2, 
      "rock" = rock, 
      "pressure" = pressure, 
      "cars" = cars) 
    }) 
    }) 

    datasetInput <- eventReactive(input$Go,{ 
    x = dat1() 
    y = dat2() 
    return(list(x=x,y=y,input1=input$dataset,input2=input$dataset2)) 
    }) 

    output$caption <- renderText({ 
    input$caption 
    }) 

    output$summary <- renderPrint({ 
    dataset <- datasetInput()$x 
    summary(dataset) 
    }) 

    output$summary2 <- renderPrint({ 
    dataset <- datasetInput()$y 
    summary(dataset) 
    }) 

    output$view <- renderTable({ 
    head(datasetInput()$x, n = input$obs) 
    }) 

    output$view2 <- renderTable({ 
    head(datasetInput()$y, n = input$obs) 
    }) 

    output$one<-renderText(datasetInput()$input1) 

    output$two<-renderText(datasetInput()$input2) 
} 

shiny::shinyApp(ui,server)