光沢のあるアプリで不必要な負荷を避ける

Question

私はeventReactiveという2つのデータセットで読み込む関数を持っています。各データセットは選択できますが、両方とも同じeventReactiveにロードされています。しかし、ユーザーが2つのデータセットのうちの1つだけを変更する場合は、両方をロードするのではなく、変更したものだけをロードするようにします。私はこれが2つのアクションボタンでもっと簡単になることを知っていますが、私はそれを1つにする必要があります。下記のサンプルコードをご覧ください。

この例では、変数が変更されたコードの部分だけを再度実行したいとします。 ui.r：あなたはその反応関数内で値を使用しているためか、if(datasetInput()$input1 != input$dataset){execute...} しかし、それは動作しません：

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) 

}) 

私はすでにこのような何かを試してみました同じ機能で作成されます...

Answer 1

eventReactiveに依存関係があるreactive式に2つのデータロードステップを分けることができます。このようにGoをクリックすると、入力値が変更された場合は2つの反応式が呼び出されますが、入力が更新されていない場合は反応しません。例：

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)