Shiny Modules: how to access the input$ of a looped Shiny Module?

[Mark Edmondson]

Hello, me again, working my way through  Shiny modules :)

I have cross-posted to SO here: http://stackoverflow.com/questions/36841477/shiny-modules-how-to-access-the-input-of-a-looped-shiny-module

I'm wrapping my head around Shiny Module nesting and have this problem.

The code for an example Shiny app with the issue is available here.
https://gist.github.com/MarkEdmondson1234/7565787bb020b1c7cb691cf80e816d68

Copy-pasting into an .R file and running in RStudio should replicate it.

I'm trying to make a helper function that will filter/aggregate any data.frame.  I am as far as getting some dynamic selectInputs which is already useful, but I now want to put those selectInputs into a loop within server.R so I can subset a data.frame by their selected values.

The problem seems to be that the inputs that are generated within the Shiny server loop can not be accessed via normal Shiny modules means, and the syntax for finding their names eludes me.  The issue lies within these lines:

      new_data <- reactive({
        old_data <- the_data()
        for(i in seq_along(aggs)){
   
          str(i) ## debug to check its in loop
   
          agg <- aggs[i]
   
          ## How to access the dynamic_select inputs selected?
          inputA <- input[[agg]]  # is NULL?
          old_col <- old_data[[agg]] # is NULL?
   
          str(inputA) ## debug - NULL should hold values of dynamic inputs
   
          new_data <- old_data[inputA %in% old_col,]
   
          old_data <- new_data
   
        }
   
        new_data
   
      })

Does anyone have an idea on how to access the selected values that should be appearing in variable inputA ?

[Joe Cheng]

Hi Mark,

I don't understand the overall aim of the app, but I'll tell you the answer to your specific question and hopefully that will help.

The general rule for modules is that you can only access the value of a moduleUI's input, in the corresponding module server function. In this case, you can only access the value of dynamicSelectInput from within dynamicSelect. If you want to then make that value available to other modules, then you have to return it as a reactive from the module server function. In this case, that means that the dynamicSelect function should end with this line:

  return(reactive(input$dynamic_select))

("return" is optional but I think it helps make explicit the fact that reactive(input$dynamic_select) is the return value.)

Then, in outerTable, you could do something like this instead of your for-loop:

  selectResults <- lapply(setNames(aggs, aggs), function(agg) {

    callModule(module = dynamicSelect,

      id = agg,

      the_data = the_data,

      column = agg)

  })

Now selectResults is a named list, each element being a reactive expression (so selectResults[[agg]]() to retrieve a value).

That said, I made those changes to your code but could not figure out what the relationship between old_data, new_data, and the_data is supposed to be, so I can't provide you with a working example.

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/f8dc9ac4-6e94-48be-8d5d-af16eef0020c%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Mark Edmondson]

Thanks Joe again, this has indeed helped get to what I need.

It was a bit of a toy example, but I have several other Shiny apps with different dynamic dataframes from APIs that a user needs to aggregate/filter, and I was writing a lot of boilerplate code each time.  This module will help massively as I can pass it any dataframe, and it will give an interface and the result table to be passed to plots.

[Mark Edmondson]

I've updated the gist with a working version, thanks again
https://gist.github.com/MarkEdmondson1234/7565787bb020b1c7cb691cf80e816d68

[Xiushi Le]

I think I realized what Mark is trying to accomplish, i had similar idea prior to shiny module becoming available.

below are modified code based on the above gist that allows user to do filtering more freely.

library(shiny)

dynamicSelectInput <- function(id, label, multiple = FALSE){

  

  ns <- shiny::NS(id)

  

  shiny::selectInput(ns("dynamic_select"), label,

                     choices = NULL, multiple = multiple, width = "100%")

  

}

#' Dynamical Update of a selectInput

#' @param the_data data.frame containing column of choices

#' @param column The column to select from

#' @param default_select The choices to select on load

dynamicSelect <- function(input, output, session, the_data, column, default_select = NULL){

  

  ## update input$dynamic_select

  observe({

    shiny::validate(

      shiny::need(the_data(),"Fetching data")

    )

    dt <- the_data()

    

    testthat::expect_is(dt, "data.frame")

    testthat::expect_is(column, "character")

    

    choice <- unique(dt[[column]])

    

    updateSelectInput(session, "dynamic_select",

                      choices = choice,

                      selected = default_select)

    

  })

  

  return(reactive(input$dynamic_select))

  

}

#' Using Dynamic Input

#' @param id Shiny Id

#' @param aggs The Aggregation names

outerTableUI <- function(id, aggs){

  

  ns <- shiny::NS(id)

  

  tagList(

    fluidRow(

      lapply(seq_along(aggs), function(x) {

        column(width = 4,

               dynamicSelectInput(ns(aggs[[x]]), aggs[[x]], multiple = TRUE)

        )

        

      })

    ),

    fluidRow(

      ## if this works should be able to filter this table

      ## by the selected filters above

      tableOutput(ns("table"))

    )

    

  )

}

#' server side

#' @export

outerTable <- function(input, output, session, the_data, aggs){

  

  selectResults <- lapply(setNames(aggs, aggs), function(agg) {

    callModule(module = dynamicSelect,

               id = agg,

               the_data = the_data,

               column = agg)

  })

  

  

  new_data <- reactive({

    old_data <- the_data()

    new_data <- NULL

    for(i in seq_along(aggs)){

      

      agg <- aggs[i]

      

      if(is.null(inputA <- selectResults[[agg]]())){

        next  

      } else{

        old_col <- old_data[[agg]]

        

        new_data <- old_data[old_col %in% inputA,]

        

        old_data <- new_data

      }

      

    }

    

    new_data

    

  })

  

  output$table <- renderTable({

    # browser()

    new_data()

  })

  

  

}

### Call via:

the_data <- mtcars

the_filters = names(mtcars)

shinyApp(

  ui = fluidPage(

    outerTableUI("debug_dynamic",

                 aggs = the_filters)

  ),

  server = function(input, output, session){

    callModule(outerTable,

               "debug_dynamic",

               the_data = reactive(the_data),

               aggs = the_filters)

  }

)

[Mark Edmondson]

Thanks Xiushi, I have added your edits to the gist.

[Bob Tao]

very nice!

Could the drop-down lists be made to be dependent on selections made on other drop-down list?

[Mark Edmondson]

Yes Bob, my application was for authentication with an Account > Web Property > View hierarchy that I put in a Shiny module here:
https://github.com/MarkEdmondson1234/googleAnalyticsR/blob/master/R/shiny-modules.R