How to trigger R Shiny observeEvent when one specified choice among various user choices is selected-CodePudding

In the below example code, I'd like each click of the "Add" button to add 1 to the value presented in the little "data" table underneath. Instead of the "Add" button, the code below has the "Test add" button working this way for demo purpose. I'd like to have "Add" do what "Test add" currently does, and then remove "Test add".

The "Show table" button works as it should: each click renders a larger table (unrelated, this is all a simple example) underneath. And the "Add" button works correctly in hiding the rendered larger table each time it is clicked; but I'd also like a click of "Add" to add 1 as described above.

In the below code I commented out observeEvent("input.show == 'Add'",{x(x() 1)}), which was my attempt to have a click of "Add" cause the addition of 1. How do I correct this, so the observeEvent() is essentially triggered by input.show == 'Add'?

This image helps explain:

Code:

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  br(),actionButton("add","Test add"), br(),br(),
  radioGroupButtons(
    inputId = "show",
    label = NULL, 
    choices = c("Add","Show table"),
    status = "primary",
    selected = "Add"
  ),
  br(),
  fluidRow(tableOutput("data")),
  fluidRow(
    conditionalPanel(
      "input.show == 'Show table'",
      column(10,
             column(4, h5(textOutput("text"))),
             column(6, tableOutput("table")),
             style = "border: 2px solid grey; margin-left: 15px;"
      ),
      style = "display: none;"
    )
  )
)

server <- function(input, output, session) {
  
  x = reactiveVal(0)
  
  output$data <- renderTable(x())
  output$table <- renderTable(iris[1:5, 1:3])
  output$text <- renderText("Test show/hide in JS")
  
  observeEvent(input$add,{x(x() 1)})
  # observeEvent("input.show == 'Add'",{x(x() 1)})
  
}

shinyApp(ui, server)

CodePudding user response：

One can easily watch show to create make the value increase by 1 every other time the "add" in show is clicked.

    observeEvent(input$show, {
        req(input$show == "Add")
        x(x() 1)
    })

The problem is that you have to click Show table once and then click Add, then the value will increase. If you continuously click Add, the value will only increase one time. To solve the problem, we can bind a new JS event to the Add button and send the value to R.

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
    br(), br(), br(), br(),
    radioGroupButtons(
        inputId = "show",
        label = NULL, 
        choices = c("Add","Show table"),
        status = "primary",
        selected = "Add"
    ),
    tags$script(HTML(
        "
        $(()=>{
            var clicks = 0;
            $('#show button').first().on('click', ()=> {
                clicks   ;
                Shiny.setInputValue('add_button', clicks);
            });
        })
        "
    )),
    br(),
    fluidRow(tableOutput("data")),
    fluidRow(
        conditionalPanel(
            "input.show == 'Show table'",
            column(10,
                   column(4, h5(textOutput("text"))),
                   column(6, tableOutput("table")),
                   style = "border: 2px solid grey; margin-left: 15px;"
            ),
            style = "display: none;"
        )
    )
)

server <- function(input, output, session) {
    
    x <- reactiveVal(0)
    
    output$data <- renderTable(x())
    output$table <- renderTable(iris[1:5, 1:3])
    output$text <- renderText("Test show/hide in JS")
    
    observeEvent(input$add_button, {
        x(input$add_button)
    })
    
}

shinyApp(ui, server)

Alternative

If this value is only used to display how many times the button is clicked, or if you care about the performance, we can handle this job purely in JS, meaning no server interaction is required. If you have a great number of users, the following will help to decrease your server burden.

library(shiny)
library(shinyWidgets)
ui <- fluidPage(
    br(), br(), br(), br(),
    radioGroupButtons(
        inputId = "show",
        label = NULL, 
        choices = c("Add","Show table"),
        status = "primary",
        selected = "Add"
    ),
    tags$script(HTML(
        "
        $(()=>{
            var clicks = 0;
            $('#show button').first().on('click', ()=> {
                clicks   ;
                $('#data td').text(`   ${clicks} `);
            });
        })
        "
    )),
    br(),
    fluidRow(tableOutput("data")),
    fluidRow(
        conditionalPanel(
            "input.show == 'Show table'",
            column(10,
                   column(4, h5(textOutput("text"))),
                   column(6, tableOutput("table")),
                   style = "border: 2px solid grey; margin-left: 15px;"
            ),
            style = "display: none;"
        )
    )
)
server <- function(input, output, session) {
    output$data <- renderTable(0)
    output$table <- renderTable(iris[1:5, 1:3])
    output$text <- renderText("Test show/hide in JS")
}
shinyApp(ui, server)