r-基于同一模块内的输入，在Shiny模块内呈现条件UI组件

Question

我有一个模块，它有条件地呈现同一模块中的ui组件。这些条件也包含在同一模块中。此条件呈现不起作用。可能与范围界定有关。我添加了ns <- session$ns，并用ns()封装了renderUI中的输入和输出。这里是一个最小的例子。我错过了什么？除了代码更正，我们还将非常感谢您为更好地理解而进行的一些详细说明！

ui.R

#Define header
header <- dashboardHeader(title = "Demo")
#Define sidebar
sidebar <- dashboardSidebar(sidebarMenu(menuItem("Menu Item", tabName = "menu_item")))
#Define body
body <- dashboardBody(tabItems(tabItem(
tabName = "menu_item",
tabBox(
width = 12,
title = "",
id = "tabset1",
tabPanel(title = "Panel1",
panel1_ui("panel1")),
tabPanel(title = "Panel 2")
)
)))
#Create ui
ui <- dashboardPage(header, sidebar, body)

服务器.R

# Define server logic
server <- function(input, output, session) {

#Server code for module
callModule(panel1_server, "panel1")

}

模块.R

#Define ui
panel1_ui <- function(id) {
ns <- NS(id)

tagList(fluidRow(
#Input box
box(
title = "Input box",
status = "primary",
solidHeader = TRUE,
width = 4,

sliderInput(
inputId = "amount",
label = "Amount:",
min = 0,
max = 5,
value = 0,
step = 1
)
),

conditionalPanel("input.amount > 0",
uiOutput(outputId = "output1"))
))
}
#Define server
panel1_server <- function(input, output, session) {
ns <- session$ns

fluidRow(column(width = 4,

output$output1 <- renderUI({
box(
title = "Output box",
status = "primary",
width = 4,
solidHeader = TRUE,
uiOutput(outputId = ns("output2"))
)
})))

output$output2 <- renderUI({
if (ns(input$amount) == 0) {

}
else {
lapply(c(1:input$amount), function(i) {
hr()
list(tags$u(strong(paste("Input ", i))),
br(),
column(
6,
dateInput(
inputId = paste0("date_", i),
label = paste0("Date:"),
value = Sys.Date()
)
),
column(
6,
selectInput(
inputId = paste0("yes_no", i),
label = "Yes or No:",
choices = c("Yes", "No"),
selected = "No"
)
))
})
}
})
}

Answer 1

感谢@Limey的建议，我能够分解并解决问题。以下是工作模块代码。我添加了一些修改的注释。

模块.R

#Define ui
panel1_ui <- function(id) {
ns <- NS(id)

tagList(fluidRow(
#Input box
box(
title = "Input box",
status = "primary",
solidHeader = TRUE,
width = 4,

sliderInput(

#Forgot to wrap amount in ns()
inputId = ns("amount"), 
label = "Amount:",
min = 0,
max = 5,
value = 0,
step = 1
)
),

#Removed conditionalPanel
#Forgot to wrap output1 in ns()
uiOutput(outputId = ns("output1")) 
))
}
#Define server
panel1_server <- function(input, output, session) {
ns <- session$ns

fluidRow(column(width = 4,

output$output1 <- renderUI({

#Removed ns() around input$amount
#If condition is not true, render nothing
#Otherwise, render box with content
if (input$amount == 0) {}
else {
box(
title = "Output box",
status = "primary",
width = 4,
solidHeader = TRUE,

#Removed ns() around input$amount
lapply(c(1:input$amount), function(i) { 
hr()
list(tags$u(strong(paste("Input ", i))),
br(),
column(
6,
dateInput(

#Forgot to wrap date_i in ns()
inputId = ns(paste0("date_", i)), 
label = paste0("Date:"),
value = Sys.Date()
)
),
column(
6,
selectInput(

#Forgot to wrap yes_no_i in ns()
inputId = ns(paste0("yes_no", i)), 
label = "Yes or No:",
choices = c("Yes", "No"),
selected = "No"
)
))
}))
}
})
))
}