Shiny - динамически генерируемые входы

Question

В моем блестящем коде я генерирую входные данные динамически, и я пытаюсь сделать наблюдаем () вызванным любым изменением в этих входных данных.

Я нашел эту ссылку Блестящий - наблюдаем () запускается динамически генерируемыми входами , что было очень полезно, но не работало со всеми видами входов. Я добавил в код в ссылке дополнительные входы. Вот код:

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)

Если я заменим «.dynamicSI select» в части JS на «.dynamicSI: input», то я получу ошибку

Если я удалю dateInput из кода и внесу изменения в JS, то наблюдение будет вызвано selectInput и numericInput, но не radioButtons.

Как я могу заставить мое наблюдение сработать по всем им?

Спасибо

Answer 1

Способ получения inputId зависит от типа виджета.

Вы можете действовать следующим образом.

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")
        )
      )
    )
)

В JavaScript вы можете использовать Shiny.setInputValue с опцией {priority: 'event'}. Это заменяет Shiny.onInputChange без необходимости "трюка" на 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'});
});
"

Кроме того, в server вместо использования observe с isolate лучше использовать observeEvent.

Полное приложение:

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)