闪亮 - 由动态生成的输入触发的observe()

Question

我有一个闪亮的代码生成selectInputs,每个selectInput生成图标题.问题是我不知道如何用动态生成的按钮触发observe().我使用的解决方法是在代码上写入每个selectInput的输入[[]]触发器以启动观察.是否可以从所有生成的输入中触发observe()？

library(shiny)
library(shinydashboard)


ui <- dashboardPage(
  dashboardHeader(title = "Dynamic selectInput"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody(
    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) {
  output$menuitem <- renderMenu({
    menuItem("Menu item", icon = icon("calendar"))
  })


  #elements of graphic titles  
  output$graph_title <- renderUI({
    buttons <- as.list(1:input$graph_tytle_num)
    buttons <- lapply(buttons, function(i)

      column(3,
        selectInput(inputId = paste0("title_element",i),
                    label = paste("Title element",i),
                    choices = paste0(LETTERS[i],seq(1,i*2)),
                    selected = 1)
      )
    )
  })


  observe({

    #Can this observe be triggerd by the dynamicaly generate selectInput?
    #In this the observe is only triggered with the first 3 selectInput
    input[[paste0("title_element",1)]]
    input[[paste0("title_element",2)]]
    input[[paste0("title_element",3)]]


    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("title_element",i)]])
      }

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

shinyApp(ui, server)

Answer 1

我不是 Shiny 方面的专家，但似乎不可能用动态生成的输入触发一个观察者。我的解决方法基于这个答案： R闪亮 - 最后单击的按钮 id。

selectInput这个想法是使用 JavaScript 函数跟踪所有动态生成的最后一个选择。该函数将使用上次使用的 id 更新闪亮的输入变量selectedInput。

下面是使用解决方案修改的代码。请注意，因为我们需要区分动态生成的selectInput和其他selectInput的，所以我将它们包装selectInput在一个div虚拟类中。JavaScript 函数只会对其内部的函数做出反应div。此外，这些函数将在 JavaScript 函数内生成一个随机数，以使观察者对同一selectInput.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic selectInput"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody(
    # keep track of the last selection on all selectInput created dynamically
    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) {
  output$menuitem <- renderMenu({
    menuItem("Menu item", icon = icon("calendar"))
  })

  #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("title_element",i),
                      label = paste("Title element",i),
                      choices = paste0(LETTERS[i],seq(1,i*2)),
                      selected = 1)
        )
      )
    )
  })

  # 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("title_element",i)]])
      }

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

  })  

}

shinyApp(ui, server)

最后，您只需修改 JavaScript 函数上的选择器即可将此方法扩展到任何其他 Shiny 小部件。例如，如果您想要actionButton's，您可以更改event和selectorfromchange和selecttoclick和button。