Каковы условия для блестящего :: наблюдайте события, чтобы работать или сломать, то есть, чтобы изолировать свои аргументы

Question

В моем понимании observeEvent обрабатывает все в handlerExpr, как если бы они были заключены в функцию isolate, поэтому его следует запускать только тогда, когда вход или reactiveValue в eventExpr признан недействительным ( изменено) (здесь совершенно не перефразируя @divibisan).

В этом блестящем приложении с кнопкой действий это иногда работает, а иногда нет. Может кто-нибудь объяснить, почему это так. (части кода были взяты с Веб-сайт RStudio при условии, что со мной все в порядке.

Это приложение построит два одинаковых столбца населения выбранной страны, когда Нажата кнопка Go. По моему опыту, после первого нажатия кнопки Go будут отображены обе диаграммы. В дальнейшем верхняя диаграмма будет обновляться мгновенно, игнорируя кнопку (# case 1 - кнопка действия не работает), в то время как 2-я диаграмма обновляет только событие кнопки, как предполагалось (# case 2 - действие только при нажатии кнопки Go).

1. Можно ли воспроизвести такое поведение?
2. Почему это так и какие правила?
3. Кажется, я не понимаю.

.

library(shiny)
library(DBI)
library(pool)
library(dplyr)
library(dbplyr)
library(forcats)
library(ggplot2)

pool <- dbPool(
  drv = RMySQL::MySQL(),
  dbname = "shinydemo",
  host = "shiny-demo.csa7qlmguqrf.us-east-1.rds.amazonaws.com",
  username = "guest",
  password = "guest"
)

query <- function(inp){
  pool %>%
    tbl("Country") %>%
    select(Code,Name) %>%
    rename(CountryName = Name) %>%
    filter(CountryName == !!inp) %>%
    left_join(.,pool %>%
                tbl("City"),by = c("Code" ="CountryCode")) %>%
    select(CountryName, Name,Population) %>% arrange(desc(Population)) %>%
    collect()
}

gplot <- function(x){
  ggplot2::ggplot(x %>% mutate(Name = fct_reorder(Name,Population,.desc=TRUE)),aes(x=Name,y=Population)) + 
  geom_bar(stat="identity") +     
  theme(axis.text.x = element_text(angle = 90)) 
}

ui <- fluidPage(
  selectInput("selectcountry", label = h3(""), 
              choices = as.list( pool %>% tbl("Country") %>% pull(Name))),
  actionButton("do", label ="Go" ),
  htmlOutput("actionbuttoncounter"),
  plotOutput("popPlot"),
  plotOutput("popPlot2")
)

server <- function(input, output, session) {
  session$onSessionEnded(function(){pool::poolClose(pool)})

  output$actionbuttoncounter <- renderText(input$do)
  observeEvent(input$do, {

    # case 1 - action button broken
    output$popPlot <- renderPlot({
      query(inp = input$selectcountry) %>% gplot()
    })
    # case 2 - action only when Go-button is pressed
     result <- query(inp = input$selectcountry)
     output$popPlot2<- renderPlot({
       gplot(result)
     })
  })
}
shinyApp(ui, server)

ОБНОВЛЕНИЕ

это не имеет ничего общего с dbplyr, поэтому минимальный пример будет следующим:

library(shiny)
library(dplyr)
gplot <- function(x){
  hist(x)
}

ui <- fluidPage(
  numericInput("num", label = h3("Numeric input"), value = 1),
  actionButton("do", label ="Go" ),
  htmlOutput("actionbuttoncounter"),
  plotOutput("popPlot"),
  plotOutput("popPlot2")
)

server <- function(input, output, session) {


  output$actionbuttoncounter <- renderText(input$do)
  observeEvent(input$do, {
    # case 1 - action button broken
    output$popPlot <- renderPlot({
      rnorm(input$num) %>% gplot()
    })
    # case 2 - propper action
    result <- rnorm(input$num)
    output$popPlot2<- renderPlot({
     result %>% gplot()
    })
  })
}
shinyApp(ui, server)

Дополнительная информация

R version 3.6.0 (2019-04-26)
Platform: x86_64-apple-darwin15.6.0 (64-bit)
Running under: macOS Mojave 10.14.6

locale:
[1] de_DE.UTF-8/de_DE.UTF-8/de_DE.UTF-8/C/de_DE.UTF-8/de_DE.UTF-8

other attached packages:
[1] ggplot2_3.2.0 forcats_0.4.0 dbplyr_1.4.2  dplyr_0.8.3   pool_0.1.4.2  DBI_1.1.0     shiny_1.4.0  

Answer 1

Согласен с @ user5249203. Советую не включать output рендеринг из observeEvent (это не нужно для работы).

Вот один из подходов, который обновляет значение reactive при каждом нажатии кнопки. Графики будут автоматически обновляться при изменении данных.

Имеет ли это поведение, которое вы искали?

server <- function(input, output, session) {

  rv <- reactiveVal()

  output$actionbuttoncounter <- renderText(input$do)

  observeEvent(input$do, {
    rv(rnorm(input$num))
  })

  output$popPlot <- renderPlot({
    if (is.null(rv())) return ()
    gplot(rv())
  })

  output$popPlot2 <- renderPlot({
    if (is.null(rv())) return ()
    gplot(rv())
  })

}