Shiny - 动态生成的输入

Question

在我闪亮的代码中，我正在动态生成输入，并且我试图让 observe() 被这些输入的任何变化触发。

我发现此链接Shiny - observe() triggered by dynamicaly generated inputs 非常有用，但不适用于所有类型的输入。 我在链接额外输入中添加了代码 代码如下：

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)

如果我将 JS 部分中的 '.dynamicSI select' 替换为 '.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)