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 shiny - last clicked button id。

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

以下是使用该解决方案修改的代码。请注意，因为我们需要区分动态生成的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，则可以将event和selector从change和select更改为{{1} }和click。

闪亮 - 由动态生成的输入

1 个答案: