Reputation: 525

Nested Modules and ObserveEvents - R Shiny

I previously asked a similar question but didn't have any luck.

I've put together a simple full app in hope that this may help people to solve my question/issue.

In this app, I want to dynamically create UI within a module and each set of dynamically generate UI should be reactive to other components within the same namespace.

In this example, I want each column value input to be reactive to the value of the column selector in the same namespace.

To make things simple, the column value input should be update to the current value of the column selector input.

This is where I am having issues. I can't get the dynamically generate UI elements to update


library("shiny")
library("shinyWidgets")



#UI elements
outerUI<-function(id){
 
    
    ns <- NS(id)
    
    tagList(
        actionButton(inputId=ns("addItem"), "Add New Item"),
        div(id = ns('innerModulePlaceholder'))
    )
}




#####sever code inner UI

innerUiTemplate<-function(id, data){
    
    ns=NS(id)
    
    
    
    
    fluidRow(
        
        
        
        
        pickerInput(  inputId=ns("columnSelector"),
                      label = "Select Column",
                      choices=colnames(data),
                      selected = NULL,
                      multiple = FALSE 
                      
        ),
        br(),
        
        pickerInput(  inputId=ns("ValueSelector"),
                      label = "Select Values",
                      choices= NULL,
                      selected = NULL,
                      multiple = FALSE
        )
        
    )
    
    
    
}

#updates
innerServer<-function(id,data){
    moduleServer(
        id,
        function(input, output, session) {
            
            ns <-session$ns
            
            
            observeEvent(input$columnSelector,{
                
                
                
                updatePickerInput(
                    session,
                    inputId="ValueSelector",
                    choices = input$columnSelector
                    
                )
            })
            
            
            
        }
    )
}









##########server code - outer UI

outerServer<-  function(id,data){
    moduleServer(
        id,
        function(input, output, session) {
            
            
            counter<-reactiveValues()
            
            counter$count=0
            
            ns <-session$ns
            
            
            
            
            observeEvent(input$addItem, {
                
                counter$count=counter$count+1
                insertUI(selector=paste0("#",ns("innerModulePlaceholder")),where="afterEnd", innerUiTemplate(id=paste0("innerModule", counter$count ), data) )
                innerServer(id=paste0("innerModule", counter$count ), data )
                
                
                
            }
            
            
            )
            
            
            
        }
        
    )
}






#mainUI

ui <- fluidPage(
    uiOutput("Module")
)

# main server
server <- function(input, output, session) {
    
    data<-reactive({
        
        column1<-c(1,2,3,4,5)
        column2<-c(5,6,7,4,2)
        data<-data.frame(column1, column2)
        
        return(data)
    })
    
    output$Module <-renderUI({
        outerUI(id="firstTime" ) 
        
    })
    outerServer(id="firstTime", data() )
}
    
    # run app
    shinyApp(ui, server)

Upvotes: 1

Answers (2)

YBS

Reputation: 21349

Apart from the ns() in the innerUiTemplate call you need to use data[[input$columnSelector]] in the updatePickerInput choices.

#updates
innerServer<-function(id,data, var){
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      observeEvent(eventExpr = input$columnSelector, handlerExpr = {
        #if (!is.null(input$columnSelector)) mychoices$col <- data[[input$columnSelector]]
        updatePickerInput(
          session,
          inputId="ValueSelector",
          choices = data[[input$columnSelector]]
        )
      })

    }
  )
}

Upvotes: 1

Tiger_Stripes

Reputation: 525

Basically, slight nuance in calling the insert UI function

library("shiny")
library("shinyWidgets")
 
 
#UI elements
outerUI<-function(id){
 
    
    ns <- NS(id)
    
    tagList(
        actionButton(inputId=ns("addItem"), "Add New Item"),
        div(id = ns('innerModulePlaceholder'))
    )
}
 
 

#####sever code inner UI
 
innerUiTemplate<-function(id, data){
    
    ns=NS(id)
    
    
    
    
    fluidRow(
        
        
        
        
        pickerInput(  inputId=ns("columnSelector"),
                      label = "Select Column",
                      choices=colnames(data),
                      selected = NULL,
                      multiple = FALSE 
                      
        ),
        br(),
        
        pickerInput(  inputId=ns("ValueSelector"),
                      label = "Select Values",
                      choices= NULL,
                      selected = NULL,
                      multiple = FALSE
        )
        
    )
    
    
    
}
 
#updates
innerServer<-function(id,data){
    moduleServer(
        id,
        function(input, output, session) {
            
            ns <-session$ns
            
            
            observeEvent(input$columnSelector,{
                
              
                
                updatePickerInput(
                    session,
                    inputId="ValueSelector",
                    choices = input$columnSelector
                    
                )
            })
            
            
            
        }
    )
}
 
 
 
 
 
##########server code - outer UI
 
outerServer<-  function(id,data){
    moduleServer(
        id,
        function(input, output, session) {
            
            
            counter<-reactiveValues()
            
            counter$count=0
            
            ns <-session$ns
            
            
            
            
            observeEvent(input$addItem, {
               
                counter$count=counter$count+1
                insertUI(selector=paste0("#",ns("innerModulePlaceholder")),where="afterEnd", innerUiTemplate(id=ns(paste0("innerModule", counter$count )), data) )
                innerServer(id=paste0("innerModule", counter$count ), data )
                
                
                
            }
            
            
            )
            
            
            
        }
        
    )
}
 
 
 

#mainUI
 
ui <- fluidPage(
    uiOutput("Module")
)
 
# main server
server <- function(input, output, session) {
    
    data<-reactive({
        
        column1<-c(1,2,3,4,5)
        column2<-c(5,6,7,4,2)
        data<-data.frame(column1, column2)
        
        return(data)
    })
    
    output$Module <-renderUI({
        outerUI(id="firstTime" ) 
        
    })
    outerServer(id="firstTime", data() )
}
    
    # run app
    shinyApp(ui, server)
    
    ```

Upvotes: 0

Nested Modules and ObserveEvents - R Shiny

Answers (2)

Related Questions