Shiny - 动态生成的输入

Question

In my shiny code i am generating inputs dynamically and i am trying to make the observe() to be triggered by any change in those inputs.

I found this link Shiny - observe() triggered by dynamicaly generated inputs which was very useful but didn't work with all kind of inputs. I added to the code in the link extra inputs That's the code:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = ""),
  dashboardSidebar(
  ),
  dashboardBody(
    tags$script("$(document).on('change', '.dynamicSI select', function () {
                Shiny.onInputChange('lastSelectId',this.id);
                // to report changes on the same selectInput
                Shiny.onInputChange('lastSelect', Math.random());
                });"),       



    numericInput("graph_tytle_num","Number of Graph Title elements",value = 1,min = 1,max = 10),
    uiOutput("graph_title"),
    plotOutput("plot")
  )
)

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

  #elements of graphic titles  
  output$graph_title <- renderUI({
    buttons <- as.list(1:input$graph_tytle_num)
    # use a div with class = "dynamicSI" to distinguish from other selectInput's
    div( class = "dynamicSI",
         lapply(buttons, function(i)
           column(3,
                  selectInput(inputId = paste0("title1_element",i),
                              label = paste("Title element",i),
                              choices = paste0(LETTERS[i],seq(1,i*2)),
                              selected = 1),
                  radioButtons(inputId = paste0("title2_element",i),
                              label = paste("Title1 element",i),
                              choices = c("Yes","No"),
                              selected = "Yes"),
                  numericInput(inputId = paste0("title3_element",i),
                               label = paste("Title element",i),value=1),
                  dateInput(inputId = paste0("title4_element",i),
                              label = paste("Title element",i),
                              value="1900-01-01")
           )
         )
    )
  })

  # react to changes in dynamically generated selectInput's
  observe({
    input$lastSelect

    if (!is.null(input$lastSelectId)) {
      cat("lastSelectId:", input$lastSelectId, "\n")
      cat("Selection:", input[[input$lastSelectId]], "\n\n")
    }

    isolate({ #I dont want to have the numericInput input$graph_tytle_num to be a trigger
      #Create the graph title
      title <- c()
      for(i in 1:input[["graph_tytle_num"]]){
        title <- paste(title,input[[paste0("title1_element",i)]],input[[paste0("title2_element",i)]],
                       input[[paste0("title3_element",i)]],input[[paste0("title4_element",i)]])
      }

      output$plot <-renderPlot({hist(rnorm(100,4,1),
                                     breaks = 10,
                                     main = title)})
    })

  })  

}

shinyApp(ui, server)

If i replace '.dynamicSI select' in the JS part with '.dynamicSI:input' then i will get an error

If i remove the dateInput from the code and make the change in the JS then the observe will be triggered by selectInput and numericInput but not radioButtons.

How can i make my observe triggered by all of them?

Thanks

Answer 1

The way to get the inputId depends on the type of widget.

You can proceed as follows.

div(class = "dynamicSI",
    lapply(buttons, function(i)
      column(
        width = 3,
        div(class = "selector",
            selectInput(inputId = paste0("title1_element",i),
                        label = paste("Title element",i),
                        choices = paste0(LETTERS[i],seq(1,i*2)),
                        selected = 1)
        ),
        div(class = "radio",
            radioButtons(inputId = paste0("title2_element",i),
                         label = paste("Title1 element",i),
                         choices = c("Yes","No"),
                         selected = "Yes")
        ),
        div(class = "input",
            numericInput(inputId = paste0("title3_element",i),
                         label = paste("Title element",i),value=1)
        ),
        div(class = "date",
            dateInput(inputId = paste0("title4_element",i),
                      label = paste("Title element",i),
                      value = "1900-01-01")
        )
      )
    )
)

In JavaScript, you can use Shiny.setInputValue with the option {priority: 'event'} . This replaces Shiny.onInputChange without need of the "trick" with Math.random() .

js <- "
$(document).on('change', '.dynamicSI .selector select', function(){
  Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .radio input', function(){
  Shiny.setInputValue('lastSelectId', $(this).attr('name'), {priority: 'event'});
});
$(document).on('change', '.dynamicSI .input input', function(){
  Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .date input', function(){
  Shiny.setInputValue('lastSelectId', $(this).parent().attr('id'), {priority: 'event'});
});
"

In addition, in server , instead of using observe with isolate , it is better to use observeEvent .

The full app:

library(shiny)
library(shinydashboard)

js <- "
$(document).on('change', '.dynamicSI .selector select', function(){
  Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .radio input', function(){
  Shiny.setInputValue('lastSelectId', $(this).attr('name'), {priority: 'event'});
});
$(document).on('change', '.dynamicSI .input input', function(){
  Shiny.setInputValue('lastSelectId', this.id, {priority: 'event'});
});
$(document).on('change', '.dynamicSI .date input', function(){
  Shiny.setInputValue('lastSelectId', $(this).parent().attr('id'), {priority: 'event'});
});
"

ui <- dashboardPage(
  dashboardHeader(title = ""),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$script(HTML(js))),       

    numericInput("graph_tytle_num", "Number of Graph Title elements", 
                 value = 1, min = 1, max = 10),
    uiOutput("graph_title"),
    plotOutput("plot")
  )
)

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

  #elements of graphic titles  
  output$graph_title <- renderUI({
    buttons <- as.list(1:input$graph_tytle_num)
    div(class = "dynamicSI",
        lapply(buttons, function(i)
          column(
            width = 3,
            div(class = "selector",
                selectInput(inputId = paste0("title1_element",i),
                            label = paste("Title element",i),
                            choices = paste0(LETTERS[i],seq(1,i*2)),
                            selected = 1)
            ),
            div(class = "radio",
                radioButtons(inputId = paste0("title2_element",i),
                             label = paste("Title1 element",i),
                             choices = c("Yes","No"),
                             selected = "Yes")
            ),
            div(class = "input",
                numericInput(inputId = paste0("title3_element",i),
                             label = paste("Title element",i),value=1)
            ),
            div(class = "date",
                dateInput(inputId = paste0("title4_element",i),
                          label = paste("Title element",i),
                          value = "1900-01-01")
            )
          )
        )
    )
  })

  # react to changes in dynamically generated selectInput's
  observeEvent(input$lastSelectId, {

    cat("lastSelectId:", input$lastSelectId, "\n")
    cat("Selection:", input[[input$lastSelectId]], "\n\n")

    title <- c()
    for(i in 1:input[["graph_tytle_num"]]){
      title <- paste(title,input[[paste0("title1_element",i)]],input[[paste0("title2_element",i)]],
                     input[[paste0("title3_element",i)]],input[[paste0("title4_element",i)]])
    }

    output$plot <-renderPlot({hist(rnorm(100,4,1),
                                   breaks = 10,
                                   main = title)})

  })  

}

shinyApp(ui, server)