1

我之前问过类似的问题，但没有任何运气。

我整理了一个简单的完整应用程序，希望这可以帮助人们解决我的问题/问题。

在这个应用程序中，我想在一个模块中动态创建 UI，并且每组动态生成的 UI 都应该对同一命名空间中的其他组件做出反应。

在此示例中，我希望每个列值输入都对同一命名空间中的列选择器的值作出反应。

为简单起见，列值输入应更新为列选择器输入的当前值。

这是我遇到问题的地方。我无法让动态生成的 UI 元素更新


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)
4

2 回答 2

1

除了ns()在innerUiTemplate通话中您需要data[[input$columnSelector]]在updatePickerInput选择中使用。

#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]]
        )
      })

    }
  )
}
于 2020-10-26T11:31:55.217 回答
0

基本上，调用插入 UI 函数的细微差别

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)
    
    ```
    
    
    
    
    
    
于 2020-10-26T09:17:38.877 回答