问题描述
这是我第一次使用Shiny Modules,但在使内部服务器模块正常工作时遇到一些问题。
本质上,用户可以在外部UI中单击一个操作按钮,从而导致通过内部UI模块(可以多次创建)将一堆UI输入插入到UI中
但是,我希望内部模块中创建的四个输入中的两个对其他两个响应,因此对内部服务器代码起作用。但是,尽管是相同的名称空间,但内部模块中的observeEvent似乎并未触发
#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
),pickerInput( inputId=ns("debitLevelSelector"),label = "Select Level",choices= colnames(data),multiple = FALSE
)
),column(4,pickerInput( inputId=ns("creditValues"),label = "Select credit side",choices=NULL,multiple = TRUE,options = pickerOptions(
actionsBox = TRUE,selectedtextformat = "count",liveSearch = TRUE
)
),pickerInput( inputId=ns("debitValues"),label = "Select debit side",liveSearch = TRUE
)
)
),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,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",data)
}
)
}
)
}
如果有助于输入,则内部服务器中的$ creditLevelSelector会变为NULL。
解决方法
我设法使其正常工作。插入UI时,您必须将ID包装在名称空间中,而不是将内部服务器包装
库(“发光”) 库(“ shinyWidgets”)
#UI元素 externalUI
ns <- NS(id)
tagList(
actionButton(inputId=ns("addItem"),"Add New Item"),div(id = ns('innerModulePlaceholder'))
)
}
##### sever代码内部用户界面
innerUiTemplate
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
ns <-session$ns
observeEvent(input$columnSelector,{
print(input$columnSelector)
updatePickerInput(
session,inputId="ValueSelector",choices = input$columnSelector
)
})
}
)
}
###########服务器代码-外部用户界面
outerServer
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
主服务器
服务器
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)