Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Shiny - observe() triggered by dynamicaly generated inputs

Tags:

r

shiny

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)
like image 736
user3116408 Avatar asked Nov 16 '16 12:11

user3116408


1 Answers

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

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.

like image 142
Geovany Avatar answered Dec 09 '22 00:12

Geovany