简体   繁体   中英

Calculation Order ObserveEvent and Reactive

I have a R-Shiny-App where I'm trying to visualize Data.

The problem I'm encountering is that the order in which a observeEvent and reactive -values get executed seems to be off (or I'm doing something wrong).

Whenever the first two selectInput are changed I need to read from a database. The checkboxes get updated according to the values of the dataset I retrieved from the database. This works fine, but when I change the first selectInput the old value of the second selectInput is used and the query is empty, which causes an error.

I have however an observeEvent tracking the first selectInput which should update the other input fields to acceptable values.

I'm using the following code:

ui <- fluidPage(
    tags$head(
        tags$style(HTML("hr {border-top: 1px solid #000000;}")),
        tags$head(tags$style(HTML("
                                 .multicol { 
                                   height: 150px;
                                   -webkit-column-count: 3; /* Chrome, Safari, Opera */ 
                                   -moz-column-count: 3;    /* Firefox */ 
                                   column-count: 3; 
                                   -moz-column-fill: auto;
                                   -column-fill: auto;
                                 } 
                                 ")) 
        )
    ),
    # Application title
    titlePanel("Title"),

    # Sidebar
    sidebarLayout(
        sidebarPanel(
            selectInput("idRT", "Select ***:", choices = listRT, selected = listRT[1], multiple = FALSE ),
            selectInput("idSzn", "Select Szenario:", choices = sznList[listRT[1]], multiple = FALSE ),
            hr(),
            checkboxGroupInput("cbTB", "TB:", choices = tbList[listRT[1]], selected = tbList[listRT[1]]),
            tags$div(align = 'left', 
                     class = 'multicol', 
                     checkboxGroupInput("cbRZ", 
                                        "RZ:", 
                                        choices = rzList[rtList[1]], 
                                        selected = rzList[rtList[1]], 
                                        inline = FALSE)),
            checkboxGroupInput("cbVa", "Va:", choices = vaList[rtList[1]], selected = vaList[rtList[1]]),
            width = 3
        ),

        mainPanel(
            fluidRow(
                column(6, plotOutput(outputId="plot1")),
                column(6, plotOutput(outputId="plot2"))
            ),
            fluidRow(
                column(6, plotOutput(outputId="plot3")),
                column(6, plotOutput(outputId="plot4"))
            ),
            width = 9
        )
    )
)

# Define server logic
server <- function(input, output, session) {
    
    
    observeEvent(input$idRT,{
        updateSelectInput(session, 
                          inputId = "idSzn", 
                          choices = get(input$idRT,sznList), 
                          selected = get(input$idRT,sznList)[1])
        updateCheckboxGroupInput(session, 
                                 inputId = "cbTb", 
                                 choices = sort(get(input$idRT,tbList)), 
                                 selected = get(input$idRT,tbList))
        updateCheckboxGroupInput(session, 
                                 inputId = "cbRZ", 
                                 choices = sort(get(input$idRT,rzList)), 
                                 selected = get(input$idRT,rzList))
        updateCheckboxGroupInput(session, 
                                 inputId = "cbVa", 
                                 choices = sort(get(input$idRT,vaList)), 
                                 selected = get(input$idRT,vaList))
    })
    
    basisData <- reactive({
        id <- getID(input$idRT,"Base",conn)
        query <- sqlInterpolate(conn, stSQL, id = id)
        dataRawSzn <- dbGetQuery(conn, query)
    })
    
    sznData <- reactive({
        id <- getID(input$idRT,input$idSzn,conn)
        query <- sqlInterpolate(conn, stSQL, id = id)
        dataRawSzn <- dbGetQuery(conn, query)
    })
    
    fltData <- reactive({
        union_all(sznData(), basisData()) %>% filter(rz %in% input$cbRZ)%>% filter(va %in% input$cbVa)%>% filter(tb %in% input$cbTb) %>% summarise_all(sum)
    }) %>% debounce(750)
    
    output$plot1<- renderPlot({
        ...
    })
    
    output$plot2<- renderPlot({
        ...
    })
    
    output$plot3<- renderPlot({
        ...
    })
    
    output$plot4<- renderPlot({
        ...
    })
    
    session$onSessionEnded(function() {
        stopApp()
        dbDisconnect(conn)
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

I get the following error message:

Warnung: Error in vapply: Werte müssen die Länge 1 haben,
Ergebnis von FUN(X[[1]]) hat aber Länge 0
  85: vapply
  84: sqlInterpolate
  82: <reactive:sznData> [C:/Users/.../app_v3.R#204]
  66: sznData
  61: <reactive:fltData> [C:/Users/.../app_v3.R#214]
  45: r
  44: <observer>
   1: runApp

It appears that eventReactive might resolve your issue. I cannot test it as I don't know how listRT or rtList is set-up. Try this

  basisData <- eventReactive(input$idRT, {
    id <- getID(input$idRT,"Base",conn)
    query <- sqlInterpolate(conn, stSQL, id = id)
    dataRawSzn <- dbGetQuery(conn, query)
  })
  
  sznData <- eventReactive(input$idSzn, {
    id <- getID(input$idRT,input$idSzn,conn)
    query <- sqlInterpolate(conn, stSQL, id = id)
    dataRawSzn <- dbGetQuery(conn, query)
  })

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM