Getting inner module server to update innerServerUI - Rshiny Modules

398 views Asked by At

its my first time using Shiny Modules and having some issues getting an inner server module to work correctly.

Essentially, in the outer UI the user can click an action button which results in a bunch of UI inputs being inserted into the UI via an inner UI module (can be created multiple times)

However I want two of the four inputs created in the inner module to be reactive to the other two, hence the inner server code. However the observeEvents in the inner module don't seem to fire despite being the same namespace



#UI elements
specificTransactionOuterUI<-function(id,data){
  useShinyjs()

  ns <- NS(id)
  
  tagList(
  actionButton(inputId=ns("createSpecificFlow"), "Add New Specific Transaction Column"),

  uiOutput(ns("specificTransactionUI"))
  )
}




#####sever code inner UI

specificTransactionInnerUiTemplate<-function(id, data){
  useShinyjs()
  ns=NS(id)
  
  div(id =ns("specifcTransactionInnerUiDiv"),
  
    fluidRow(
      
      column(4,
             
             
             
             textInput("newColSpecificTransaction", "Give new column a name", value = ""),
             br(),
             
             pickerInput(  inputId=ns("creditLevelSelector"),
                           label = "Select level",
                           choices=colnames(data),
                           selected = NULL,
                           multiple = FALSE 
                           
             ),
             br(),
             
             pickerInput(  inputId=ns("debitLevelSelector"),
                           label = "Select Level",
                           choices= colnames(data),
                           selected = NULL,
                           multiple = FALSE
             )
             
      ),
      
      
      column(4,
             br(),
             br(),br(),
             br(),
             pickerInput(  inputId=ns("creditValues"),
                           label = "Select credit side",
                           choices=NULL,
                           selected = NULL,
                           multiple = TRUE,
                           options = pickerOptions(
                             actionsBox = TRUE, 
                             selectedTextFormat = "count", 
                             liveSearch = TRUE
                           )
             ),
             
             br(),
             
             pickerInput(  inputId=ns("debitValues"),
                           label = "Select debit side",
                           choices=NULL,
                           selected = NULL,
                           multiple = TRUE,
                           options = pickerOptions(
                             actionsBox = TRUE, 
                             selectedTextFormat = "count", 
                             liveSearch = TRUE
                           )
             )
             
      ),
      
      
      
      column(4,
             br(),br(),
             br(),br(),br(),br(),
             actionButton( inputId=ns("RemoveSpecificTransaction"), "Remove Specific Flow Column")
             
      )
      
    )
  
  
  
  )
  }
  
#updates
specificTransactionInnerServer<-function(id,data){
  moduleServer(
    id,
    function(input, output, session) {


      ns <- session$ns
  #

observeEvent(input$creditLevelSelector,{
  


  updatePickerInput(
    session,
    inputId="creditValues",
   choices = unique(data[[input$creditLevelSelector]])

     )
})

#updateValuesDebits

observeEvent(input$debitLevelSelector,{


  updatePickerInput(
    session,
    inputId="debitValues",
    choices = unique(data[[input$debitLevelSelector]])

  )


})

# ###remove button server side

observeEvent(input$RemoveSpecificTransaction, {

  removeUI(selector =paste0("#", ns("specifcTransactionInnerUiDiv")))
  remove_shiny_inputs(id, input)
  # session$specificFlow$removeFlow$destroy()
  # session$specificFlow$debitLevel$destroy()
  # session$specificFlow$creditLevel$destroy()
})



    }
)
}
  




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

specificTransactionOuterServer<-  function(id,data){
  moduleServer(
    id,
  function(input, output, session) {
 
    
     counter<-reactiveValues()

     counter$count=0
     
     ns <-session$ns
     
     
    
    
     observeEvent(input$createSpecificFlow, {
         
         counter$count=counter$count+1
        insertUI(selector=paste0("#",ns("specificTransactionUI")),where="afterEnd", specificTransactionInnerUiTemplate(id=paste0("specificFlow", counter$count ), data) )
        specificTransactionInnerServer(id=paste0("specificFlow", counter$count ), data)
         
         
         
     }
     
    
)
        


  }

)
}





If it helps input$creditLevelSelector evalautes to NULL in the inner sever.

However it should be the colnames of the data as this is what it displays.

1

There are 1 answers

0
Tiger_Stripes On

I have managed to get it to work. When inserting the UI you have to wrap the id in the namespace but not not the innerServer

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,{
            
            print(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, {
            print("boo")
            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)