问题描述
我以前问过类似的问题，但是没有任何运气。
我整理了一个简单的完整应用程序，希望这可以帮助人们解决我的问题。
在此应用中，我想在模块内动态创建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,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,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",data )
}
)
}
)
}
#mainUI
ui <- fluidPage(
uIoUtput("Module")
)
# main server
server <- function(input,session) {
data<-reactive({
column1<-c(1,2,3,4,5)
column2<-c(5,6,7,2)
data<-data.frame(column1,column2)
return(data)
})
output$Module <-renderUI({
outerUI(id="firstTime" )
})
outerServer(id="firstTime",data() )
}
# run app
shinyApp(ui,server)
解决方法
除了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]]
)
})
}
)
}
基本上，在调用插入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, multiple = FALSE
)
)
}
#updates
innerServer<-function(id,data){
moduleServer(
id, function(input,session) {
ns <-session$ns
observeEvent(input$columnSelector,{
updatePickerInput(
session, inputId="ValueSelector", choices = input$columnSelector
)
})
}
)
}
##########server code - outer UI
outerServer<- function(id,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,session) {
data<-reactive({
column1<-c(1,2,3,4,5)
column2<-c(5,6,7,2)
data<-data.frame(column1,column2)
return(data)
})
output$Module <-renderUI({
outerUI(id="firstTime" )
})
outerServer(id="firstTime",data() )
}
# run app
shinyApp(ui,server)
```