Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
317 views
in Technique[技术] by (71.8m points)

r - Shiny - observe() triggered by dynamicaly generated inputs

I have a shiny code that generates selectInputs and each of those selectInput generate the plot title. The problem is that I don't know how to trigger an observe() with dynamically generated buttons. The workaround I used was to write on the code the input[[]] trigger for each selectInput to start the observe. Is it possible to trigger the observe() from all generated inputs?

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)
See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

I'm not an expert in Shiny, but It seems that it's not possible to trigger one observer with dynamically generated inputs. My workaround is based on this answer: R shiny - last clicked button id.

The idea is to keep track of the last selection on all the dynamicallygenerated selectInput's using a JavaScript function. That function will update a shiny input variable with the id of the last selectedInput used.

Below is you code modified with the solution. Please note that because we need to distinguish between the dynamically generated selectInput's and others selectInput's, I wrapped those selectInput's in a div with a dummy class. The JavaScript function will only react to those that are inside that div. Also, the functions will generate a random number inside the JavaScript function to make the observer react to changes in the same 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, "
")
      cat("Selection:", input[[input$lastSelectId]], "

")
    }

    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)

Finally, you can extend this approach to any other Shiny widget just by modifying the selector on the JavaScript function. For instance, if you want to have actionButton's you can change the event and the selector from change and select to click and button.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...