r - 如何抑制在 lapply 中触发的 Shiny observeEvent

Question

我正在寻找关于过度敏感的 R Shiny reactiveValues 对象的一些帮助。提前致谢。

我的目标是开发一个简单的表单，通过在 lapply 中调用 renderUI 返回 3 个闪亮的流体行。每行有两个按钮和一个从 0 开始的值。通过分别单击“加号”或“减号”按钮，该值应增加或减少 1。

当任一按钮被点击时，虽然 observeEvent 一直在触发，正如调用打印更新值时所看到的那样。我在前面放置了一个隔离，但它否定了前端值的更新。

library(shiny)
library(dplyr)

ui <- fluidPage(
  uiOutput('oupt_q11')
)

server <- function(input, output, session) {
  
  tbl_vals <- reactiveValues(
    pos_1    = 0
    , pos_2  = 0
    , pos_3  = 0
  )  
  
  output$oupt_q11 <- renderUI({
    
    lapply(seq_along(1:3), function(x){
      
      # tbl_vals_x <- isolate(as.character(tbl_vals[[paste0('pos_', x)]]))
      tbl_vals_x <- as.character(tbl_vals[[paste0('pos_', x)]])
      
      hold_rtrn <- fluidRow(
        column(12,
               style = 'background-color: #b8c2d1'
               , column(3, actionButton(paste0('btn_less_', x), label = ' - '))
               , column(3, tbl_vals_x)
               , column(3, actionButton(paste0('btn_more_', x), label = ' + '))
        ))
      
      observeEvent(input[[paste0('btn_less_', x)]], {
        
        pass_value <- as.numeric(tbl_vals[[paste0('pos_', x)]])
        tbl_vals[[paste0('pos_', x)]] <- pass_value - 1
        print(tbl_vals[[paste0('pos_', x)]])
        
      })
      
      observeEvent(input[[paste0('btn_more_', x)]], {
        
        pass_value <- as.numeric(tbl_vals[[paste0('pos_', x)]])
        tbl_vals[[paste0('pos_', x)]] <- pass_value + 1
        print(tbl_vals[[paste0('pos_', x)]])
        
      })
      return(hold_rtrn)
    })
  })
  
}

shinyApp(ui, server)

标签： rdplyrshinytidyverse

Answer 1

只是把observeEvent()外面的renderUI。有用。尝试这个。

library(shiny)
library(dplyr)

ui <- fluidPage(
  uiOutput('oupt_q11')
)

server <- function(input, output, session) {
  
  tbl_vals <- reactiveValues(
    pos_1    = 0
    , pos_2  = 0
    , pos_3  = 0
  )  
  
  output$oupt_q11 <- renderUI({
    hold_rtrn <- list()
    
    lapply(seq_along(1:3), function(x){
      #tbl_vals_x <- as.character(tbl_vals[[paste0('pos_', x)]])
      
      hold_rtrn[[x]] <<- fluidRow(
        column(12,
               style = 'background-color: #b8c2d1'
               , column(3, actionButton(paste0('btn_less_', x), label = ' - '))
               , column(3, as.character(tbl_vals[[paste0('pos_', x)]]))
               , column(3, actionButton(paste0('btn_more_', x), label = ' + '))
        ))
      
    })
    hold_rtrn
  })
  
  lapply(1:3, function(x) {
    observeEvent(input[[paste0('btn_less_', x)]], {
      pass_value <- as.numeric(tbl_vals[[paste0('pos_', x)]])
      tbl_vals[[paste0('pos_', x)]] <- pass_value - 1
      print(tbl_vals[[paste0('pos_', x)]])
      
    })
    
    observeEvent(input[[paste0('btn_more_', x)]], {
      pass_value <- as.numeric(tbl_vals[[paste0('pos_', x)]])
      tbl_vals[[paste0('pos_', x)]] <- pass_value + 1
      print(tbl_vals[[paste0('pos_', x)]])
      
    })
  })
  
}

shinyApp(ui, server)